├── collection ├── VERSION ├── 358.dat ├── 445.dat ├── 104.dat ├── 489.dat ├── 168.dat ├── 170.dat ├── 293.dat ├── 381.dat ├── 169.dat ├── 107.dat ├── 187.dat ├── 467.dat ├── 531.dat ├── 014.dat ├── 451.dat ├── 469.dat ├── 105.dat ├── 106.dat ├── 256.dat ├── 491.dat ├── 549.dat ├── 039.dat ├── 040.dat ├── 314.dat ├── 317.dat ├── 450.dat ├── 532.dat ├── 539.dat ├── 540.dat ├── 541.dat ├── 542.dat ├── 543.dat ├── 544.dat ├── 545.dat ├── 046.dat ├── 065.dat ├── 072.dat ├── 147.dat ├── 212.dat ├── 309.dat ├── 382.dat ├── 458.dat ├── 488.dat ├── 546.dat ├── 547.dat ├── 550.dat ├── 566.dat ├── 091.dat ├── 250.dat ├── 313.dat ├── 470.dat ├── 619.dat ├── 133.dat ├── 316.dat ├── 329.dat ├── 400.dat ├── 496.dat ├── 548.dat ├── 557.dat ├── 049.dat ├── 124.dat ├── 140.dat ├── 188.dat ├── 195.dat ├── 227.dat ├── 237.dat ├── 288.dat ├── 315.dat ├── 340.dat ├── 519.dat ├── 520.dat ├── 579.dat ├── 013.dat ├── 160.dat ├── 234.dat ├── 311.dat ├── 350.dat ├── 485.dat ├── 523.dat ├── 003.dat ├── 128.dat ├── 236.dat ├── 343.dat ├── 353.dat ├── 459.dat ├── 466.dat ├── 684.dat ├── 685.dat ├── 686.dat ├── 163.dat ├── 233.dat ├── 235.dat ├── 330.dat ├── 352.dat ├── 361.dat ├── 373.dat ├── 454.dat ├── 456.dat ├── 460.dat ├── 461.dat ├── 465.dat ├── 495.dat ├── 572.dat ├── 574.dat ├── 607.dat ├── 172.dat ├── 189.dat ├── 297.dat ├── 368.dat ├── 416.dat ├── 449.dat ├── 455.dat ├── 462.dat ├── 463.dat ├── 464.dat ├── 494.dat ├── 008.dat ├── 096.dat ├── 126.dat ├── 127.dat ├── 214.dat ├── 279.dat ├── 378.dat ├── 411.dat ├── 490.dat ├── 552.dat ├── 554.dat ├── 275.dat ├── 299.dat ├── 422.dat ├── 551.dat ├── 553.dat ├── 555.dat ├── 606.dat ├── 253.dat ├── 254.dat ├── 274.dat ├── 295.dat ├── 327.dat ├── 328.dat ├── 410.dat ├── 487.dat ├── 559.dat ├── 622.dat ├── 097.dat ├── 180.dat ├── 318.dat ├── 377.dat ├── 403.dat ├── 420.dat ├── 322.dat ├── 440.dat ├── 575.dat ├── 030.dat ├── 043.dat ├── 146.dat ├── 355.dat ├── 356.dat ├── 367.dat ├── 417.dat ├── 584.dat ├── 639.dat ├── 642.dat ├── 021.dat ├── 056.dat ├── 064.dat ├── 093.dat ├── 119.dat ├── 198.dat ├── 204.dat ├── 561.dat ├── 583.dat ├── 586.dat ├── 589.dat ├── 590.dat ├── 636.dat ├── 637.dat ├── 640.dat ├── 641.dat ├── 042.dat ├── 123.dat ├── 156.dat ├── 206.dat ├── 249.dat ├── 286.dat ├── 376.dat ├── 408.dat ├── 418.dat ├── 419.dat ├── 447.dat ├── 484.dat ├── 500.dat ├── 585.dat ├── 638.dat ├── TESTERS ├── 041.dat ├── 092.dat ├── 225.dat ├── 226.dat ├── 239.dat ├── 263.dat ├── 302.dat ├── 319.dat ├── 320.dat ├── 398.dat ├── 425.dat ├── 538.dat ├── 564.dat ├── 588.dat ├── 604.dat ├── 155.dat ├── 184.dat ├── 205.dat ├── 224.dat ├── 423.dat ├── 424.dat ├── 426.dat ├── 427.dat ├── 492.dat ├── 565.dat ├── 594.dat ├── 602.dat ├── 656.dat ├── 135.dat ├── 175.dat ├── 176.dat ├── 177.dat ├── 200.dat ├── 291.dat ├── 443.dat ├── 444.dat ├── 571.dat ├── 587.dat ├── 595.dat ├── 603.dat ├── 605.dat ├── 073.dat ├── 111.dat ├── 493.dat ├── 521.dat ├── 629.dat ├── 122.dat ├── 251.dat ├── 296.dat ├── 298.dat ├── 300.dat ├── 405.dat ├── 442.dat ├── 486.dat ├── 662.dat ├── 199.dat ├── 558.dat ├── 600.dat ├── 022.dat ├── 231.dat ├── 357.dat ├── 363.dat ├── 576.dat ├── 278.dat ├── 413.dat ├── 028.dat ├── 094.dat ├── 209.dat ├── LICENSE-INFO ├── 001.dat ├── 018.dat ├── 207.dat ├── 208.dat ├── 210.dat ├── 211.dat ├── 307.dat ├── 007.dat ├── 601.dat ├── 675.dat ├── 201.dat ├── 676.dat ├── 677.dat ├── 120.dat ├── 145.dat ├── 282.dat ├── 628.dat ├── 262.dat ├── 270.dat ├── 347.dat ├── 438.dat ├── 479.dat ├── 507.dat ├── 580.dat ├── 032.dat ├── 412.dat ├── 533.dat ├── 707.dat ├── 181.dat ├── 216.dat ├── 399.dat ├── 441.dat ├── 573.dat ├── 074.dat ├── 125.dat ├── 215.dat ├── 430.dat ├── 435.dat ├── 591.dat ├── 618.dat ├── 036.dat ├── 154.dat ├── 336.dat ├── 338.dat ├── 428.dat ├── 429.dat ├── 431.dat ├── 432.dat ├── 433.dat ├── 434.dat ├── 436.dat ├── 437.dat ├── 370.dat ├── 406.dat ├── 439.dat ├── 505.dat ├── 038.dat ├── 339.dat ├── 364.dat ├── 621.dat ├── 630.dat ├── 631.dat ├── 084.dat ├── 582.dat ├── 050.dat ├── 153.dat ├── 162.dat ├── 342.dat ├── 482.dat ├── 534.dat ├── 612.dat ├── 650.dat ├── 651.dat ├── 652.dat ├── 183.dat ├── 281.dat ├── 305.dat ├── 372.dat ├── 483.dat ├── 501.dat ├── 673.dat ├── 052.dat ├── 182.dat ├── 229.dat ├── 310.dat ├── 503.dat ├── 522.dat ├── 152.dat ├── 171.dat ├── 196.dat ├── 259.dat ├── 359.dat ├── 053.dat ├── 197.dat ├── 283.dat ├── 387.dat ├── 499.dat ├── 306.dat ├── 528.dat ├── 529.dat ├── 530.dat ├── 567.dat ├── 069.dat ├── 323.dat ├── 331.dat ├── 383.dat ├── 391.dat ├── 526.dat ├── 527.dat ├── 202.dat ├── 324.dat ├── 325.dat ├── 349.dat ├── 497.dat ├── 230.dat ├── 294.dat ├── 326.dat ├── 386.dat ├── 480.dat ├── 570.dat ├── 079.dat ├── 164.dat ├── 509.dat ├── 560.dat ├── 704.dat ├── 705.dat ├── 060.dat ├── 087.dat ├── 252.dat ├── 258.dat ├── 690.dat ├── 083.dat ├── 151.dat ├── 238.dat ├── 304.dat ├── 415.dat ├── 477.dat ├── 692.dat ├── 693.dat ├── 194.dat ├── 284.dat ├── 615.dat ├── 617.dat ├── 664.dat ├── 027.dat ├── 076.dat ├── 081.dat ├── 112.dat ├── 113.dat ├── 247.dat ├── 248.dat ├── 115.dat ├── 129.dat ├── 672.dat ├── 362.dat ├── 385.dat ├── 620.dat ├── 658.dat ├── 114.dat ├── 345.dat ├── 365.dat ├── 075.dat ├── 191.dat ├── 255.dat ├── 344.dat ├── 537.dat ├── 654.dat ├── 095.dat ├── 130.dat ├── 264.dat ├── 308.dat ├── 624.dat ├── 655.dat ├── 392.dat ├── 393.dat ├── 481.dat ├── 186.dat ├── 292.dat ├── 301.dat ├── 518.dat ├── 702.dat ├── 019.dat ├── 020.dat ├── 055.dat ├── 143.dat ├── 508.dat ├── 525.dat ├── 592.dat ├── 017.dat ├── 346.dat ├── 080.dat ├── 369.dat ├── 071.dat ├── 118.dat ├── 178.dat ├── 679.dat ├── 680.dat ├── 688.dat ├── 689.dat ├── 078.dat ├── 271.dat ├── 334.dat ├── 002.dat ├── 179.dat ├── 511.dat ├── 682.dat ├── 683.dat ├── 660.dat ├── 695.dat ├── 696.dat ├── 514.dat ├── 515.dat ├── 517.dat ├── 031.dat ├── 360.dat ├── 414.dat ├── 471.dat ├── 089.dat ├── 185.dat ├── 267.dat ├── 276.dat ├── 348.dat ├── 627.dat ├── 644.dat ├── 646.dat ├── 681.dat ├── 011.dat ├── 643.dat ├── 645.dat ├── CONTRIBUTORS ├── 502.dat ├── 632.dat ├── 506.dat ├── 663.dat ├── 099.dat ├── 100.dat ├── 266.dat ├── 512.dat ├── 596.dat ├── 009.dat ├── 157.dat ├── 265.dat ├── 380.dat ├── 384.dat ├── 396.dat ├── 478.dat ├── 513.dat ├── 647.dat ├── 649.dat ├── 061.dat ├── 213.dat ├── 341.dat ├── 504.dat ├── 535.dat ├── 577.dat ├── 277.dat ├── 648.dat ├── 045.dat ├── 166.dat ├── 192.dat ├── 070.dat ├── 366.dat ├── 626.dat ├── 193.dat ├── 395.dat └── 593.dat ├── tests ├── Cat-Date │ ├── TestDateCat.res │ └── TestDateCatXE.res ├── Cat-Hex │ ├── TestHexCat.res │ └── TestHexCatXE.res ├── Cat-Drive │ ├── TestDriveCat.res │ └── TestDriveCatXE.res ├── Cat-Maths │ ├── TestCatMaths.res │ ├── TestCatMathsXE.res │ └── UMathsCatSnippets.pas ├── Cat-String │ ├── TestCatString.res │ ├── TestCatStringXE.res │ ├── UStringCatSnippets.pas │ └── TestUStringCatSnippets.pas ├── Cat-WinSys │ ├── TestWinSysCat.res │ └── TestWinSysCatXE.res ├── Cat-Arrays │ ├── TestArraysCatXE.res │ └── UArraysCatSnippets.pas └── Cat-Structs │ ├── TestCatStructsXE.res │ └── UStructCatSnippets.pas └── .gitignore /collection/VERSION: -------------------------------------------------------------------------------- 1 | 2.3.0 2 | -------------------------------------------------------------------------------- /collection/358.dat: -------------------------------------------------------------------------------- 1 | {$IFNDEF UNICODE} 2 | type 3 | RawByteString = AnsiString; 4 | {$ENDIF} -------------------------------------------------------------------------------- /collection/445.dat: -------------------------------------------------------------------------------- 1 | type 2 | TGreyScaleMethod = (gsmLightness, gsmAverage, gsmLuminosity); -------------------------------------------------------------------------------- /collection/104.dat: -------------------------------------------------------------------------------- 1 | function ProgramFileSpec: string; 2 | begin 3 | Result := ParamStr(0); 4 | end; -------------------------------------------------------------------------------- /collection/489.dat: -------------------------------------------------------------------------------- 1 | type 2 | TPointF = record 3 | X, Y: Double; // x and y coordinates 4 | end; -------------------------------------------------------------------------------- /collection/168.dat: -------------------------------------------------------------------------------- 1 | function MakeLangID(P, S: Word): Word; 2 | begin 3 | Result := (S shl 10) or P; 4 | end; -------------------------------------------------------------------------------- /collection/170.dat: -------------------------------------------------------------------------------- 1 | function SubLangID(LangID: Word): Word; 2 | begin 3 | Result := LangID shr 10; 4 | end; -------------------------------------------------------------------------------- /collection/293.dat: -------------------------------------------------------------------------------- 1 | function EndianSwap(const Value: Cardinal): Cardinal; 2 | asm 3 | BSWAP EAX 4 | end; -------------------------------------------------------------------------------- /collection/381.dat: -------------------------------------------------------------------------------- 1 | function LastChar(const S: string): Char; 2 | begin 3 | Result := S[Length(S)]; 4 | end; -------------------------------------------------------------------------------- /collection/169.dat: -------------------------------------------------------------------------------- 1 | function PrimaryLangID(LangID: Word): Word; 2 | begin 3 | Result := LangID and $3FF; 4 | end; -------------------------------------------------------------------------------- /collection/107.dat: -------------------------------------------------------------------------------- 1 | function ProgramName: string; 2 | begin 3 | Result := RemoveFileExt(ProgramFileName); 4 | end; -------------------------------------------------------------------------------- /collection/187.dat: -------------------------------------------------------------------------------- 1 | function LangIDFromLCID(LCID: Windows.LCID): Word; 2 | begin 3 | Result := Word(LCID); 4 | end; -------------------------------------------------------------------------------- /collection/467.dat: -------------------------------------------------------------------------------- 1 | function LCD(A, B: Integer): Integer; 2 | begin 3 | Result := Abs((A * B)) div GCD(A, B); 4 | end; -------------------------------------------------------------------------------- /collection/531.dat: -------------------------------------------------------------------------------- 1 | function IsASCIIChar(const Ch: Char): Boolean; 2 | begin 3 | Result := Ord(Ch) <= $7F; 4 | end; -------------------------------------------------------------------------------- /collection/014.dat: -------------------------------------------------------------------------------- 1 | procedure ClearRecentDocs; 2 | begin 3 | ShlObj.SHAddToRecentDocs(ShlObj.SHARD_PATH, nil); 4 | end; -------------------------------------------------------------------------------- /collection/451.dat: -------------------------------------------------------------------------------- 1 | type 2 | TRGBQuadArray = packed array[Byte] of Windows.TRGBQuad; 3 | PRGBQuadArray = ^TRGBQuadArray; -------------------------------------------------------------------------------- /collection/469.dat: -------------------------------------------------------------------------------- 1 | function Percentage(A, B: Integer): Integer; 2 | begin 3 | Result := Round((A / B) * 100); 4 | end; -------------------------------------------------------------------------------- /tests/Cat-Date/TestDateCat.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Date/TestDateCat.res -------------------------------------------------------------------------------- /tests/Cat-Hex/TestHexCat.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Hex/TestHexCat.res -------------------------------------------------------------------------------- /tests/Cat-Hex/TestHexCatXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Hex/TestHexCatXE.res -------------------------------------------------------------------------------- /collection/105.dat: -------------------------------------------------------------------------------- 1 | function ProgramFileName: string; 2 | begin 3 | Result := SysUtils.ExtractFileName(ProgramFileSpec) 4 | end; -------------------------------------------------------------------------------- /collection/106.dat: -------------------------------------------------------------------------------- 1 | function ProgramPath: string; 2 | begin 3 | Result := SysUtils.ExtractFilePath(ProgramFileSpec); 4 | end; -------------------------------------------------------------------------------- /collection/256.dat: -------------------------------------------------------------------------------- 1 | function CheckBDEInstalled: Boolean; 2 | begin 3 | Result := (BDE.dbiInit(nil) = BDE.DBIERR_NONE); 4 | end; -------------------------------------------------------------------------------- /collection/491.dat: -------------------------------------------------------------------------------- 1 | function PointF(const AX, AY: Double): TPointF; 2 | begin 3 | Result.X := AX; 4 | Result.Y := AY; 5 | end; -------------------------------------------------------------------------------- /collection/549.dat: -------------------------------------------------------------------------------- 1 | function DiffDays(const DT1, DT2: TDateTime): Integer; 2 | begin 3 | Result := Trunc(DT1 - DT2); 4 | end; -------------------------------------------------------------------------------- /tests/Cat-Date/TestDateCatXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Date/TestDateCatXE.res -------------------------------------------------------------------------------- /tests/Cat-Drive/TestDriveCat.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Drive/TestDriveCat.res -------------------------------------------------------------------------------- /tests/Cat-Maths/TestCatMaths.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Maths/TestCatMaths.res -------------------------------------------------------------------------------- /collection/039.dat: -------------------------------------------------------------------------------- 1 | function ProgramFilesFolder: string; 2 | begin 3 | Result := GetCurrentVersionRegStr('ProgramFilesDir'); 4 | end; -------------------------------------------------------------------------------- /collection/040.dat: -------------------------------------------------------------------------------- 1 | function CommonFilesFolder: string; 2 | begin 3 | Result := GetCurrentVersionRegStr('CommonFilesDir'); 4 | end; -------------------------------------------------------------------------------- /collection/314.dat: -------------------------------------------------------------------------------- 1 | function ByteToHex(const B: Byte): string; 2 | begin 3 | Result := SysUtils.IntToHex(B, 2 * SizeOf(B)); 4 | end; -------------------------------------------------------------------------------- /collection/317.dat: -------------------------------------------------------------------------------- 1 | function WordToHex(const W: Word): string; 2 | begin 3 | Result := SysUtils.IntToHex(W, 2 * SizeOf(W)); 4 | end; -------------------------------------------------------------------------------- /collection/450.dat: -------------------------------------------------------------------------------- 1 | type 2 | TRGBTripleArray = packed array[Byte] of Windows.TRGBTriple; 3 | PRGBTripleArray = ^TRGBTripleArray; -------------------------------------------------------------------------------- /collection/532.dat: -------------------------------------------------------------------------------- 1 | function IsASCIIDigit(const Ch: Char): Boolean; 2 | begin 3 | Result := Ord(Ch) in [Ord('0')..Ord('9')]; 4 | end; -------------------------------------------------------------------------------- /collection/539.dat: -------------------------------------------------------------------------------- 1 | function IsFriday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 6; 4 | end; -------------------------------------------------------------------------------- /collection/540.dat: -------------------------------------------------------------------------------- 1 | function IsMonday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 2; 4 | end; -------------------------------------------------------------------------------- /collection/541.dat: -------------------------------------------------------------------------------- 1 | function IsSaturday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 7; 4 | end; -------------------------------------------------------------------------------- /collection/542.dat: -------------------------------------------------------------------------------- 1 | function IsSunday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 1; 4 | end; -------------------------------------------------------------------------------- /collection/543.dat: -------------------------------------------------------------------------------- 1 | function IsThursday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 5; 4 | end; -------------------------------------------------------------------------------- /collection/544.dat: -------------------------------------------------------------------------------- 1 | function IsTuesday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 3; 4 | end; -------------------------------------------------------------------------------- /collection/545.dat: -------------------------------------------------------------------------------- 1 | function IsWednesday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) = 4; 4 | end; -------------------------------------------------------------------------------- /tests/Cat-Drive/TestDriveCatXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Drive/TestDriveCatXE.res -------------------------------------------------------------------------------- /tests/Cat-Maths/TestCatMathsXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Maths/TestCatMathsXE.res -------------------------------------------------------------------------------- /tests/Cat-String/TestCatString.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-String/TestCatString.res -------------------------------------------------------------------------------- /tests/Cat-WinSys/TestWinSysCat.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-WinSys/TestWinSysCat.res -------------------------------------------------------------------------------- /collection/046.dat: -------------------------------------------------------------------------------- 1 | function TaskbarHandle: Windows.THandle; 2 | begin 3 | Result := Windows.FindWindow('Shell_TrayWnd', nil); 4 | end; -------------------------------------------------------------------------------- /collection/065.dat: -------------------------------------------------------------------------------- 1 | function IsWinNT: Boolean; 2 | begin 3 | Result := (SysUtils.Win32Platform = Windows.VER_PLATFORM_WIN32_NT); 4 | end; -------------------------------------------------------------------------------- /collection/072.dat: -------------------------------------------------------------------------------- 1 | function IsValidDrive(const Drive: string): Boolean; 2 | begin 3 | Result := DriveTypeFromPath(Drive) <> 1; 4 | end; -------------------------------------------------------------------------------- /collection/147.dat: -------------------------------------------------------------------------------- 1 | function CreateDisplayDC: Windows.HDC; 2 | begin 3 | Result := Windows.CreateDC('DISPLAY', nil, nil, nil); 4 | end; -------------------------------------------------------------------------------- /collection/212.dat: -------------------------------------------------------------------------------- 1 | function IsFlagSet(const Flags, Mask: Integer): Boolean; 2 | begin 3 | Result := Mask = (Flags and Mask); 4 | end; -------------------------------------------------------------------------------- /collection/309.dat: -------------------------------------------------------------------------------- 1 | type 2 | {$IFDEF UNICODE} 3 | TBytes = SysUtils.TBytes; 4 | {$ELSE} 5 | TBytes = array of Byte; 6 | {$ENDIF} -------------------------------------------------------------------------------- /collection/382.dat: -------------------------------------------------------------------------------- 1 | procedure StripLastChar(var S: string); 2 | begin 3 | if Length(S) > 0 then 4 | Delete(S, Length(S), 1); 5 | end; -------------------------------------------------------------------------------- /collection/458.dat: -------------------------------------------------------------------------------- 1 | function MSecToDateTime(const MSecs: Int64): TDateTime; 2 | begin 3 | Result := MSecs / SysUtils.MSecsPerDay; 4 | end; -------------------------------------------------------------------------------- /collection/488.dat: -------------------------------------------------------------------------------- 1 | function Size(const ACX, ACY: Integer): Types.TSize; 2 | begin 3 | Result.cx := ACX; 4 | Result.cy := ACY; 5 | end; -------------------------------------------------------------------------------- /collection/546.dat: -------------------------------------------------------------------------------- 1 | function IsWeekday(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) in [2..6]; 4 | end; -------------------------------------------------------------------------------- /collection/547.dat: -------------------------------------------------------------------------------- 1 | function IsWeekend(const DT: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.DayOfWeek(DT) in [1, 7]; 4 | end; -------------------------------------------------------------------------------- /collection/550.dat: -------------------------------------------------------------------------------- 1 | function DayOfYear(const DT: TDateTime): Integer; 2 | begin 3 | Result := Trunc(DT - DateYearStart(DT)) + 1; 4 | end; -------------------------------------------------------------------------------- /collection/566.dat: -------------------------------------------------------------------------------- 1 | function IsIEInstalled: Boolean; 2 | begin 3 | Result := ProgIDInstalled('InternetExplorer.Application'); 4 | end; -------------------------------------------------------------------------------- /tests/Cat-Arrays/TestArraysCatXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Arrays/TestArraysCatXE.res -------------------------------------------------------------------------------- /tests/Cat-Maths/UMathsCatSnippets.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Maths/UMathsCatSnippets.pas -------------------------------------------------------------------------------- /tests/Cat-String/TestCatStringXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-String/TestCatStringXE.res -------------------------------------------------------------------------------- /tests/Cat-WinSys/TestWinSysCatXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-WinSys/TestWinSysCatXE.res -------------------------------------------------------------------------------- /collection/091.dat: -------------------------------------------------------------------------------- 1 | function IsWin9x: Boolean; 2 | begin 3 | Result := SysUtils.Win32Platform = Windows.VER_PLATFORM_WIN32_WINDOWS; 4 | end; -------------------------------------------------------------------------------- /collection/250.dat: -------------------------------------------------------------------------------- 1 | type 2 | {$IFDEF UNICODE} 3 | TCharSet = SysUtils.TSysCharSet; 4 | {$ELSE} 5 | TCharSet = set of Char; 6 | {$ENDIF} -------------------------------------------------------------------------------- /collection/313.dat: -------------------------------------------------------------------------------- 1 | function BytesToHex(const Bytes: array of Byte): string; 2 | begin 3 | Result := BufToHex(Bytes, Length(Bytes)); 4 | end; -------------------------------------------------------------------------------- /collection/470.dat: -------------------------------------------------------------------------------- 1 | function PercentageStr(A, B: Integer): string; 2 | begin 3 | Result := SysUtils.IntToStr(Percentage(A, B)) + '%'; 4 | end; -------------------------------------------------------------------------------- /collection/619.dat: -------------------------------------------------------------------------------- 1 | function FocusedControl: Controls.TWinControl; 2 | begin 3 | Result := Controls.FindControl(Windows.GetFocus); 4 | end; -------------------------------------------------------------------------------- /tests/Cat-Arrays/UArraysCatSnippets.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Arrays/UArraysCatSnippets.pas -------------------------------------------------------------------------------- /tests/Cat-String/UStringCatSnippets.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-String/UStringCatSnippets.pas -------------------------------------------------------------------------------- /tests/Cat-Structs/TestCatStructsXE.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Structs/TestCatStructsXE.res -------------------------------------------------------------------------------- /tests/Cat-Structs/UStructCatSnippets.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-Structs/UStructCatSnippets.pas -------------------------------------------------------------------------------- /collection/133.dat: -------------------------------------------------------------------------------- 1 | function IsWhiteSpace(const Ch: Char): Boolean; 2 | begin 3 | Result := IsCharInSet(Ch, [' ', #9, #10, #11, #12, #13]); 4 | end; -------------------------------------------------------------------------------- /collection/316.dat: -------------------------------------------------------------------------------- 1 | function QuadWordToHex(const QW: UInt64): string; 2 | begin 3 | Result := SysUtils.IntToHex(Int64(QW), 2 * SizeOf(QW)); 4 | end; -------------------------------------------------------------------------------- /collection/329.dat: -------------------------------------------------------------------------------- 1 | function DeleteVolumeName(ADrive: string): Boolean; 2 | begin 3 | Result := Windows.SetVolumeLabel(PChar(ADrive), ''); 4 | end; -------------------------------------------------------------------------------- /collection/400.dat: -------------------------------------------------------------------------------- 1 | function HasFileExt(const FileName: string): Boolean; 2 | begin 3 | Result := SysUtils.ExtractFileExt(FileName) <> ''; 4 | end; -------------------------------------------------------------------------------- /collection/496.dat: -------------------------------------------------------------------------------- 1 | function RectArea(const R: Windows.TRect): Int64; 2 | begin 3 | Result := Abs((R.Right - R.Left) * (R.Bottom - R.Top)); 4 | end; -------------------------------------------------------------------------------- /collection/548.dat: -------------------------------------------------------------------------------- 1 | function AddDays(const DateTime: TDateTime; const Days: Integer): TDateTime; 2 | begin 3 | Result := DateTime + Days; 4 | end; -------------------------------------------------------------------------------- /collection/557.dat: -------------------------------------------------------------------------------- 1 | function FractionToStr(Num, Denom: Integer): string; 2 | begin 3 | Result := SysUtils.Format('%d/%d', [Num, Denom]); 4 | end; -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Database release folder 2 | 3 | _release 4 | 5 | # Delphi test code 6 | *.local 7 | *.identcache 8 | _build 9 | __history 10 | -------------------------------------------------------------------------------- /collection/049.dat: -------------------------------------------------------------------------------- 1 | function IsIntResource(const ResID: PChar): Boolean; 2 | begin 3 | Result := (Windows.HiWord(Windows.DWORD(ResID)) = 0); 4 | end; -------------------------------------------------------------------------------- /collection/124.dat: -------------------------------------------------------------------------------- 1 | function IsRectNormal(const R: Windows.TRect): Boolean; 2 | begin 3 | Result := (R.Left <= R.Right) and (R.Top <= R.Bottom); 4 | end; -------------------------------------------------------------------------------- /collection/140.dat: -------------------------------------------------------------------------------- 1 | function TrayHandle: Windows.THandle; 2 | begin 3 | Result := Windows.FindWindowEx(TaskbarHandle, 0, 'TrayNotifyWnd', nil); 4 | end; -------------------------------------------------------------------------------- /collection/188.dat: -------------------------------------------------------------------------------- 1 | function SortIDFromLCID(LCID: Windows.LCID): Word; 2 | begin 3 | Result := Word((Windows.DWORD(LCID) shr 16) and $000F); 4 | end; -------------------------------------------------------------------------------- /collection/195.dat: -------------------------------------------------------------------------------- 1 | function TrimChar(const S: string; const C: Char): string; 2 | begin 3 | Result := TrimLeftChar(TrimRightChar(S, C), C); 4 | end; -------------------------------------------------------------------------------- /collection/227.dat: -------------------------------------------------------------------------------- 1 | function IsLeapYear(const ADateTime: TDateTime): Boolean; 2 | begin 3 | Result := SysUtils.IsLeapYear(DateYear(ADateTime)); 4 | end; -------------------------------------------------------------------------------- /collection/237.dat: -------------------------------------------------------------------------------- 1 | function SQLDate(const Date: TDateTime): string; 2 | begin 3 | Result := SysUtils.FormatDateTime('yyyy"-"mm"-"dd', Date); 4 | end; -------------------------------------------------------------------------------- /collection/288.dat: -------------------------------------------------------------------------------- 1 | function ColorToHSB(const Color: Graphics.TColor): THSBColor; 2 | begin 3 | Result := RGBToHSB(ColorToRGBTriple(Color)); 4 | end; -------------------------------------------------------------------------------- /collection/315.dat: -------------------------------------------------------------------------------- 1 | function LongWordToHex(const LW: LongWord): string; 2 | begin 3 | Result := SysUtils.IntToHex(Integer(LW), 2 * SizeOf(LW)); 4 | end; -------------------------------------------------------------------------------- /collection/340.dat: -------------------------------------------------------------------------------- 1 | function FontExists(const FontName: string): Boolean; 2 | begin 3 | Result := Forms.Screen.Fonts.IndexOf(FontName) >= 0; 4 | end; -------------------------------------------------------------------------------- /collection/519.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16BEStream(const Stm: Classes.TStream): Boolean; 2 | begin 3 | Result := StreamHasWatermark(Stm, [$FE, $FF]); 4 | end; -------------------------------------------------------------------------------- /collection/520.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16LEStream(const Stm: Classes.TStream): Boolean; 2 | begin 3 | Result := StreamHasWatermark(Stm, [$FF, $FE]); 4 | end; -------------------------------------------------------------------------------- /collection/579.dat: -------------------------------------------------------------------------------- 1 | type 2 | TRange = record 3 | Lower: Integer; // lower bound of range 4 | Upper: Integer; // upper bound of range 5 | end; -------------------------------------------------------------------------------- /tests/Cat-String/TestUStringCatSnippets.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/code-snippets/HEAD/tests/Cat-String/TestUStringCatSnippets.pas -------------------------------------------------------------------------------- /collection/013.dat: -------------------------------------------------------------------------------- 1 | procedure AddToRecentDocs(const FileName: string); 2 | begin 3 | ShlObj.SHAddToRecentDocs(ShlObj.SHARD_PATH, PChar(FileName)); 4 | end; -------------------------------------------------------------------------------- /collection/160.dat: -------------------------------------------------------------------------------- 1 | function GetWindowProcessName(const Wnd: Windows.HWND): string; 2 | begin 3 | Result := GetProcessName(GetWindowProcessID(Wnd)); 4 | end; -------------------------------------------------------------------------------- /collection/234.dat: -------------------------------------------------------------------------------- 1 | function LongMonthName(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.LongMonthNames[DateMonth(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/311.dat: -------------------------------------------------------------------------------- 1 | function AddHexPrefix(const HexStr: string): string; 2 | begin 3 | Result := SysUtils.HexDisplayPrefix + StripHexPrefix(HexStr); 4 | end; -------------------------------------------------------------------------------- /collection/350.dat: -------------------------------------------------------------------------------- 1 | function ReduceStr(const Str: string; ReduceBy: Integer): string; 2 | begin 3 | Result := Copy(Str, 1, Length(Str) - ReduceBy); 4 | end; -------------------------------------------------------------------------------- /collection/485.dat: -------------------------------------------------------------------------------- 1 | procedure PushByteArray(const B: Byte; var A: TBytes); 2 | begin 3 | SetLength(A, Length(A) + 1); 4 | A[Pred(Length(A))] := B; 5 | end; -------------------------------------------------------------------------------- /collection/523.dat: -------------------------------------------------------------------------------- 1 | function IsUTF8Stream(const Stm: Classes.TStream): Boolean; 2 | begin 3 | Result := StreamHasWatermark(Stm, [$EF, $BB, $BF]); 4 | end; -------------------------------------------------------------------------------- /collection/003.dat: -------------------------------------------------------------------------------- 1 | function WinFileTimeToStr(FT: Windows.TFileTime): string; 2 | begin 3 | Result := SysUtils.DateTimeToStr(WinFileTimeToDateTime(FT)); 4 | end; -------------------------------------------------------------------------------- /collection/128.dat: -------------------------------------------------------------------------------- 1 | function RectSize(const R: Windows.TRect): Windows.TSize; 2 | begin 3 | Result.cx := RectWidth(R); 4 | Result.cy := RectHeight(R); 5 | end; -------------------------------------------------------------------------------- /collection/236.dat: -------------------------------------------------------------------------------- 1 | function ShortMonthName(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.ShortMonthNames[DateMonth(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/343.dat: -------------------------------------------------------------------------------- 1 | procedure SetDefaultFont(const AFont: Graphics.TFont); 2 | begin 3 | AFont.Handle := Windows.GetStockObject(Windows.DEFAULT_GUI_FONT); 4 | end; -------------------------------------------------------------------------------- /collection/353.dat: -------------------------------------------------------------------------------- 1 | function GetParentDirectory(const APath: string): string; 2 | begin 3 | Result := SysUtils.ExpandFileName(DirToPath(APath) + '..'); 4 | end; -------------------------------------------------------------------------------- /collection/459.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Byte); overload; 2 | var 3 | Temp: Byte; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/466.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Word); overload; 2 | var 3 | Temp: Word; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/684.dat: -------------------------------------------------------------------------------- 1 | function HarmonicMean(const A: array of Double): Double; overload; 2 | begin 3 | Result := System.Length(A) / SumOfReciprocals(A); 4 | end; -------------------------------------------------------------------------------- /collection/685.dat: -------------------------------------------------------------------------------- 1 | function HarmonicMean(const A: array of Cardinal): Double; overload; 2 | begin 3 | Result := System.Length(A) / SumOfReciprocals(A); 4 | end; -------------------------------------------------------------------------------- /collection/686.dat: -------------------------------------------------------------------------------- 1 | function HarmonicMean(const A: array of Integer): Double; overload; 2 | begin 3 | Result := System.Length(A) / SumOfReciprocals(A); 4 | end; -------------------------------------------------------------------------------- /collection/163.dat: -------------------------------------------------------------------------------- 1 | function AddDefThousandSeparator(const S: string): string; 2 | begin 3 | Result := AddThousandSeparator(S, SysUtils.ThousandSeparator); 4 | end; -------------------------------------------------------------------------------- /collection/233.dat: -------------------------------------------------------------------------------- 1 | function LongDayName(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.LongDayNames[SysUtils.DayOfWeek(ADateTime)]; 4 | end; -------------------------------------------------------------------------------- /collection/235.dat: -------------------------------------------------------------------------------- 1 | function ShortDayName(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.ShortDayNames[SysUtils.DayOfWeek(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/330.dat: -------------------------------------------------------------------------------- 1 | function SetVolumeName(const ADrive, AName: string): Boolean; 2 | begin 3 | Result := Windows.SetVolumeLabel(PChar(ADrive), PChar(AName)); 4 | end; -------------------------------------------------------------------------------- /collection/352.dat: -------------------------------------------------------------------------------- 1 | function CurentDrive: Char; 2 | var 3 | Dir: string; // current drive as string 4 | begin 5 | GetDir(0, Dir); 6 | Result := Dir[1]; 7 | end; -------------------------------------------------------------------------------- /collection/361.dat: -------------------------------------------------------------------------------- 1 | function IsASCIIText(const Text: UnicodeString): Boolean; 2 | begin 3 | Result := EncodingSupportsString(Text, SysUtils.TEncoding.ASCII); 4 | end; -------------------------------------------------------------------------------- /collection/373.dat: -------------------------------------------------------------------------------- 1 | function MoveRectToOrigin(const R: Types.TRect): Types.TRect; 2 | begin 3 | Result := R; 4 | Types.OffsetRect(Result, -R.Left, -R.Top); 5 | end; -------------------------------------------------------------------------------- /collection/454.dat: -------------------------------------------------------------------------------- 1 | function IsValidDouble(const S: string): Boolean; 2 | var 3 | Dummy: Double; 4 | begin 5 | Result := SysUtils.TryStrToFloat(S, Dummy); 6 | end; -------------------------------------------------------------------------------- /collection/456.dat: -------------------------------------------------------------------------------- 1 | function IsValidSingle(const S: string): Boolean; 2 | var 3 | Dummy: Single; 4 | begin 5 | Result := SysUtils.TryStrToFloat(S, Dummy); 6 | end; -------------------------------------------------------------------------------- /collection/460.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Int64); overload; 2 | var 3 | Temp: Int64; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/461.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Longint); overload; 2 | var 3 | Temp: Longint; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/465.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: UInt64); overload; 2 | var 3 | Temp: UInt64; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/495.dat: -------------------------------------------------------------------------------- 1 | function DistanceBetweenPoints(const P1, P2: TPointF): Extended; overload; 2 | begin 3 | Result := Math.Hypot(P1.X - P2.X, P1.Y - P2.Y); 4 | end; -------------------------------------------------------------------------------- /collection/572.dat: -------------------------------------------------------------------------------- 1 | function WBIsDOMLoaded(WB: SHDocVw.TWebBrowser): Boolean; 2 | begin 3 | Result := SysUtils.Supports(WB.Document, MSHTML.IHTMLDocument2); 4 | end; -------------------------------------------------------------------------------- /collection/574.dat: -------------------------------------------------------------------------------- 1 | procedure WBNavigate(WB: SHDocVw.TWebBrowser; const URL: string); overload; 2 | begin 3 | WB.Navigate(URL); 4 | WBWaitForDocToLoad(WB); 5 | end; -------------------------------------------------------------------------------- /collection/607.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowFindDlg(WB: SHDocVw.TWebbrowser); 2 | const 3 | HTMLID_FIND = 1; 4 | begin 5 | WBInvokeCmd(WB, True, HTMLID_FIND, 0); 6 | end; -------------------------------------------------------------------------------- /collection/172.dat: -------------------------------------------------------------------------------- 1 | function IsTopLevelWindow(const Wnd: Windows.HWND): Boolean; 2 | begin 3 | Result := Windows.IsWindow(Wnd) and (Windows.GetParent(Wnd) = 0); 4 | end; -------------------------------------------------------------------------------- /collection/189.dat: -------------------------------------------------------------------------------- 1 | function MakeLCID(LanguageID, SortID: Word): Windows.LCID; 2 | begin 3 | Result := (Windows.DWORD(SortID) shl 16) or Windows.DWORD(LanguageID); 4 | end; -------------------------------------------------------------------------------- /collection/297.dat: -------------------------------------------------------------------------------- 1 | function BytesToKB(const Bytes: Int64): Extended; 2 | const 3 | cOneKB = 1024; // a kilobyte in bytes 4 | begin 5 | Result := Bytes / cOneKB; 6 | end; -------------------------------------------------------------------------------- /collection/368.dat: -------------------------------------------------------------------------------- 1 | function ConcatByteArrays(const B1, B2: array of Byte): TBytes; 2 | begin 3 | Result := CloneByteArray(B1); 4 | AppendByteArray(Result, B2); 5 | end; -------------------------------------------------------------------------------- /collection/416.dat: -------------------------------------------------------------------------------- 1 | function GCD2(const A, B: Integer): Integer; 2 | begin 3 | if B = 0 then 4 | Result := Abs(A) 5 | else 6 | Result := GCD2(B, A mod B); 7 | end; -------------------------------------------------------------------------------- /collection/449.dat: -------------------------------------------------------------------------------- 1 | procedure InvertBitmap(const SrcBmp, DestBmp: Graphics.TBitmap); overload; 2 | begin 3 | DestBmp.Assign(SrcBmp); 4 | InvertBitmap(DestBmp); 5 | end; -------------------------------------------------------------------------------- /collection/455.dat: -------------------------------------------------------------------------------- 1 | function IsValidExtended(const S: string): Boolean; 2 | var 3 | Dummy: Extended; 4 | begin 5 | Result := SysUtils.TryStrToFloat(S, Dummy); 6 | end; -------------------------------------------------------------------------------- /collection/462.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Longword); overload; 2 | var 3 | Temp: Longword; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/463.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Shortint); overload; 2 | var 3 | Temp: Shortint; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/464.dat: -------------------------------------------------------------------------------- 1 | procedure Exchange(var I1, I2: Smallint); overload; 2 | var 3 | Temp: Smallint; 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/494.dat: -------------------------------------------------------------------------------- 1 | function DistanceBetweenPoints(const P1, P2: Types.TPoint): Extended; overload; 2 | begin 3 | Result := Math.Hypot(P1.X - P2.X, P1.Y - P2.Y); 4 | end; -------------------------------------------------------------------------------- /collection/008.dat: -------------------------------------------------------------------------------- 1 | function DOSToUnixPath(const PathName: string): string; 2 | begin 3 | Result := SysUtils.StringReplace(PathName, '\', '/', [SysUtils.rfReplaceAll]); 4 | end; -------------------------------------------------------------------------------- /collection/096.dat: -------------------------------------------------------------------------------- 1 | function RGBTripleToColor(const C: Windows.TRGBTriple): Graphics.TColor; 2 | begin 3 | Result := Windows.RGB(C.rgbtRed, C.rgbtGreen, C.rgbtBlue); 4 | end; -------------------------------------------------------------------------------- /collection/126.dat: -------------------------------------------------------------------------------- 1 | function RectWidth(const R: Windows.TRect): Integer; 2 | begin 3 | Result := R.Right - R.Left; 4 | if Result < 0 then 5 | Result := -Result; 6 | end; -------------------------------------------------------------------------------- /collection/127.dat: -------------------------------------------------------------------------------- 1 | function RectHeight(const R: Windows.TRect): Integer; 2 | begin 3 | Result := R.Bottom - R.Top; 4 | if Result < 0 then 5 | Result := -Result; 6 | end; -------------------------------------------------------------------------------- /collection/214.dat: -------------------------------------------------------------------------------- 1 | function WinControlScrollbars(const Ctrl: Controls.TWinControl): 2 | StdCtrls.TScrollStyle; 3 | begin 4 | Result := WindowScrollbars(Ctrl.Handle); 5 | end; -------------------------------------------------------------------------------- /collection/279.dat: -------------------------------------------------------------------------------- 1 | function CloneJPEGAsBitmap(const Jpg: JPEG.TJPEGImage): Graphics.TBitmap; 2 | begin 3 | Result := Graphics.TBitmap.Create; 4 | Result.Assign(Jpg); 5 | end; -------------------------------------------------------------------------------- /collection/378.dat: -------------------------------------------------------------------------------- 1 | function ZoomRatio(const DestRect, SrcRect: Types.TRect): Double; overload; 2 | begin 3 | Result := ZoomRatio(RectSize(DestRect), RectSize(SrcRect)); 4 | end; -------------------------------------------------------------------------------- /collection/411.dat: -------------------------------------------------------------------------------- 1 | function SplitPathList(const PathList: string): Types.TStringDynArray; overload; 2 | begin 3 | Result := ExplodeStrArray(PathList, ';', False, True); 4 | end; -------------------------------------------------------------------------------- /collection/490.dat: -------------------------------------------------------------------------------- 1 | type 2 | TRectF = record 3 | case Integer of 4 | 0: (Left, Top, Right, Bottom: Double); 5 | 1: (TopLeft, BottomRight: TPointF); 6 | end; -------------------------------------------------------------------------------- /collection/552.dat: -------------------------------------------------------------------------------- 1 | function LongMonthNameXE(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.FormatSettings.LongMonthNames[DateMonth(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/554.dat: -------------------------------------------------------------------------------- 1 | function ShortMonthNameXE(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.FormatSettings.ShortMonthNames[DateMonth(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/275.dat: -------------------------------------------------------------------------------- 1 | function CloneCursorAsIcon(const Cursor: Controls.TCursor): Graphics.TIcon; 2 | begin 3 | Result := CloneCursorHandleAsIcon(Forms.Screen.Cursors[Cursor]); 4 | end; -------------------------------------------------------------------------------- /collection/299.dat: -------------------------------------------------------------------------------- 1 | function BytesToMB(const Bytes: Int64): Extended; 2 | const 3 | cOneMB = 1024 * 1024; // a megabyte in bytes 4 | begin 5 | Result := Bytes / cOneMB; 6 | end; -------------------------------------------------------------------------------- /collection/422.dat: -------------------------------------------------------------------------------- 1 | function StretchRect(const R: Types.TRect; const Scaling: Double): 2 | Types.TRect; overload; 3 | begin 4 | Result := StretchRect(R, Scaling, Scaling); 5 | end; -------------------------------------------------------------------------------- /collection/551.dat: -------------------------------------------------------------------------------- 1 | function LongDayNameXE(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.FormatSettings.LongDayNames[SysUtils.DayOfWeek(ADateTime)]; 4 | end; -------------------------------------------------------------------------------- /collection/553.dat: -------------------------------------------------------------------------------- 1 | function ShortDayNameXE(const ADateTime: TDateTime): string; 2 | begin 3 | Result := SysUtils.FormatSettings.ShortDayNames[SysUtils.DayOfWeek(ADateTime)] 4 | end; -------------------------------------------------------------------------------- /collection/555.dat: -------------------------------------------------------------------------------- 1 | function AddDefThousandSeparatorXE(const S: string): string; 2 | begin 3 | Result := AddThousandSeparator(S, SysUtils.FormatSettings.ThousandSeparator); 4 | end; -------------------------------------------------------------------------------- /collection/606.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowSourceCode(WB: SHDocVw.TWebBrowser); 2 | const 3 | HTMLID_VIEWSOURCE = 2; 4 | begin 5 | WBInvokeCmd(WB, True, HTMLID_VIEWSOURCE, 0); 6 | end; -------------------------------------------------------------------------------- /collection/253.dat: -------------------------------------------------------------------------------- 1 | function IntToFixed(const Value: Integer; 2 | const SeparateThousands: Boolean): string; 3 | begin 4 | Result := FloatToFixed(Value, 0, SeparateThousands); 5 | end; -------------------------------------------------------------------------------- /collection/254.dat: -------------------------------------------------------------------------------- 1 | function Int64ToFixed(const Value: Int64; 2 | const SeparateThousands: Boolean): string; 3 | begin 4 | Result := FloatToFixed(Value, 0, SeparateThousands); 5 | end; -------------------------------------------------------------------------------- /collection/274.dat: -------------------------------------------------------------------------------- 1 | function CloneCursorHandleAsIcon(const Handle: Windows.HCURSOR): Graphics.TIcon; 2 | begin 3 | Result := Graphics.TIcon.Create; 4 | Result.Handle := Handle; 5 | end; -------------------------------------------------------------------------------- /collection/295.dat: -------------------------------------------------------------------------------- 1 | function BytesToGB(const Bytes: Int64): Extended; 2 | const 3 | cOneGB = 1024 * 1024 * 1024; // a gigabyte in bytes 4 | begin 5 | Result := Bytes / cOneGB; 6 | end; -------------------------------------------------------------------------------- /collection/327.dat: -------------------------------------------------------------------------------- 1 | function HexToIntDef(const HexStr: string; const Default: Integer): Integer; 2 | begin 3 | if not TryHexToInt(HexStr, Result) then 4 | Result := Default; 5 | end; -------------------------------------------------------------------------------- /collection/328.dat: -------------------------------------------------------------------------------- 1 | function HexToInt64Def(const HexStr: string; const Default: Int64): Int64; 2 | begin 3 | if not TryHexToInt64(HexStr, Result) then 4 | Result := Default; 5 | end; -------------------------------------------------------------------------------- /collection/410.dat: -------------------------------------------------------------------------------- 1 | procedure SplitPathList(const PathList: string; const Paths: Classes.TStrings); 2 | overload; 3 | begin 4 | ExplodeStr(PathList, ';', Paths, False, True); 5 | end; -------------------------------------------------------------------------------- /collection/487.dat: -------------------------------------------------------------------------------- 1 | procedure UnShiftByteArray(const B: Byte; var A: TBytes); 2 | begin 3 | SetLength(A, Length(A) + 1); 4 | Move(A[0], A[1], Length(A) - 1); 5 | A[0] := B; 6 | end; -------------------------------------------------------------------------------- /collection/559.dat: -------------------------------------------------------------------------------- 1 | procedure NormaliseFractionSign(var Num, Denom: Integer); 2 | begin 3 | if Denom < 0 then 4 | begin 5 | Num := -Num; 6 | Denom := -Denom; 7 | end; 8 | end; -------------------------------------------------------------------------------- /collection/622.dat: -------------------------------------------------------------------------------- 1 | function VariantIsObject(const V: Variant): Boolean; 2 | begin 3 | Result := Variants.VarIsType(V, varDispatch) 4 | or Variants.VarIsType(V, varUnknown); 5 | end; -------------------------------------------------------------------------------- /collection/097.dat: -------------------------------------------------------------------------------- 1 | function ColorToRGBTriple(const Color: Graphics.TColor): Windows.TRGBTriple; 2 | begin 3 | ExtractRGB(Color, Result.rgbtRed, Result.rgbtGreen, Result.rgbtBlue); 4 | end; -------------------------------------------------------------------------------- /collection/180.dat: -------------------------------------------------------------------------------- 1 | function ExplodeWords(const S: string; const Words: Classes.TStrings): Integer; 2 | begin 3 | Result := ExplodeStr(CompressWhiteSpace(S), ' ', Words, False, True); 4 | end; -------------------------------------------------------------------------------- /collection/318.dat: -------------------------------------------------------------------------------- 1 | function HexByteSize(HexStr: string): Cardinal; 2 | begin 3 | HexStr := StripHexPrefix(HexStr); 4 | Result := (Length(HexStr) div 2) + (Length(HexStr) mod 2); 5 | end; -------------------------------------------------------------------------------- /collection/377.dat: -------------------------------------------------------------------------------- 1 | function ZoomRatio(const DestSize, SrcSize: Types.TSize): Double; overload; 2 | begin 3 | Result := ZoomRatio(DestSize.cx, DestSize.cy, SrcSize.cx, SrcSize.cy); 4 | end; -------------------------------------------------------------------------------- /collection/403.dat: -------------------------------------------------------------------------------- 1 | procedure PlaySound(const AFilename: string); 2 | begin 3 | MMSystem.SndPlaySound( 4 | PChar(AFilename), MMSystem.SND_ASYNC or MMSystem.SND_NODEFAULT 5 | ); 6 | end; -------------------------------------------------------------------------------- /collection/420.dat: -------------------------------------------------------------------------------- 1 | function ResizeRect(const R: Types.TRect; const NewSize: Types.TSize): 2 | Types.TRect; overload; 3 | begin 4 | Result := ResizeRect(R, NewSize.CX, NewSize.CY); 5 | end; -------------------------------------------------------------------------------- /collection/322.dat: -------------------------------------------------------------------------------- 1 | function TryHexToBytes(HexStr: string; out Bytes: TBytes): Boolean; 2 | begin 3 | SetLength(Bytes, HexByteSize(HexStr)); 4 | Result := TryHexToBuf(HexStr, Bytes[0]); 5 | end; -------------------------------------------------------------------------------- /collection/440.dat: -------------------------------------------------------------------------------- 1 | function StripAccelChars(const S: string): string; 2 | begin 3 | Result := SysUtils.StringReplace( 4 | S, '&', SysUtils.EmptyStr, [SysUtils.rfReplaceAll] 5 | ); 6 | end; -------------------------------------------------------------------------------- /collection/575.dat: -------------------------------------------------------------------------------- 1 | procedure WBNavigate(WB: SHDocVw.TWebBrowser; const URL: string; 2 | Flags: OleVariant); overload; 3 | begin 4 | WB.Navigate(URL, Flags); 5 | WBWaitForDocToLoad(WB); 6 | end; -------------------------------------------------------------------------------- /collection/030.dat: -------------------------------------------------------------------------------- 1 | function DirToPath(const Dir: string): string; 2 | begin 3 | if (Dir <> '') and (Dir[Length(Dir)] <> '\') then 4 | Result := Dir + '\' 5 | else 6 | Result := Dir; 7 | end; -------------------------------------------------------------------------------- /collection/043.dat: -------------------------------------------------------------------------------- 1 | function TempFolder: string; 2 | begin 3 | SetLength(Result, Windows.MAX_PATH); 4 | SetLength( 5 | Result, Windows.GetTempPath(Windows.MAX_PATH, PChar(Result)) 6 | ); 7 | end; -------------------------------------------------------------------------------- /collection/146.dat: -------------------------------------------------------------------------------- 1 | function IsRunningOnBattery: Boolean; 2 | var 3 | Stat: Windows.TSystemPowerStatus; 4 | begin 5 | Windows.GetSystemPowerStatus(Stat); 6 | Result := Stat.ACLineStatus = 0; 7 | end; -------------------------------------------------------------------------------- /collection/355.dat: -------------------------------------------------------------------------------- 1 | function IsValidDate(const DateString: string): Boolean; 2 | var 3 | DT: TDateTime; // unused date time value 4 | begin 5 | Result := SysUtils.TryStrToDate(DateString, DT); 6 | end; -------------------------------------------------------------------------------- /collection/356.dat: -------------------------------------------------------------------------------- 1 | function IsValidTime(const TimeString: string): Boolean; 2 | var 3 | DT: TDateTime; // unused date time value 4 | begin 5 | Result := SysUtils.TryStrToTime(TimeString, DT); 6 | end; -------------------------------------------------------------------------------- /collection/367.dat: -------------------------------------------------------------------------------- 1 | function CloneByteArray(const B: array of Byte): TBytes; 2 | begin 3 | SetLength(Result, Length(B)); 4 | if Length(B) > 0 then 5 | Move(B[0], Result[0], Length(B)); 6 | end; -------------------------------------------------------------------------------- /collection/417.dat: -------------------------------------------------------------------------------- 1 | function DigitCountR(AValue: Int64): Integer; 2 | begin 3 | if AValue mod 10 = AValue then 4 | Result := 1 5 | else 6 | Result := 1 + DigitCountR(AValue div 10) 7 | end; -------------------------------------------------------------------------------- /collection/584.dat: -------------------------------------------------------------------------------- 1 | procedure WBCut(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_CUT, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/639.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Int64): Int64; overload; 2 | var 3 | Elem: Int64; 4 | begin 5 | Result := 0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/642.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of UInt64): UInt64; overload; 2 | var 3 | Elem: UInt64; 4 | begin 5 | Result := 0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/021.dat: -------------------------------------------------------------------------------- 1 | function ShowFindFilesDlg(const Folder: string): Boolean; 2 | begin 3 | Result := ShellAPI.ShellExecute( 4 | 0, 'find', PChar(Folder), '', '', Windows.SW_SHOW 5 | ) > 32; 6 | end; -------------------------------------------------------------------------------- /collection/056.dat: -------------------------------------------------------------------------------- 1 | function PathToDir(const Path: string): string; 2 | begin 3 | Result := Path; 4 | if (Path <> '') and (Path[Length(Path)] = '\') then 5 | Delete(Result, Length(Result), 1); 6 | end; -------------------------------------------------------------------------------- /collection/064.dat: -------------------------------------------------------------------------------- 1 | function DriveRootPath(const DriveNum: Byte): string; 2 | begin 3 | if DriveNum in [0..25] then 4 | Result := Char(DriveNum + Ord('A')) + ':\' 5 | else 6 | Result := ''; 7 | end; -------------------------------------------------------------------------------- /collection/093.dat: -------------------------------------------------------------------------------- 1 | function IsTabletOS: Boolean; 2 | const 3 | SM_TABLETPC = 86; // metrics flag not defined in Windows unit 4 | begin 5 | Result := Windows.GetSystemMetrics(SM_TABLETPC) <> 0; 6 | end; -------------------------------------------------------------------------------- /collection/119.dat: -------------------------------------------------------------------------------- 1 | function IsGDIPlusInstalled: Boolean; 2 | const 3 | cGDIPlus = 'gdiplus.dll'; // GDI+ library (should be found on path) 4 | begin 5 | Result := IsLibraryInstalled(cGDIPlus); 6 | end; -------------------------------------------------------------------------------- /collection/198.dat: -------------------------------------------------------------------------------- 1 | function ResourceExists(const Module: Windows.HMODULE; 2 | const ResName, ResType: PChar): Boolean; 3 | begin 4 | Result := Windows.FindResource(Module, ResName, ResType) <> 0; 5 | end; -------------------------------------------------------------------------------- /collection/204.dat: -------------------------------------------------------------------------------- 1 | function DigitCount2(const AValue: Int64): Integer; 2 | begin 3 | if AValue <> 0 then 4 | Result := Math.Floor(Math.Log10(Abs(AValue))) + 1 5 | else 6 | Result := 1; 7 | end; -------------------------------------------------------------------------------- /collection/561.dat: -------------------------------------------------------------------------------- 1 | function Pow(const Base: Int64; const Exponent: Byte): Int64; 2 | var 3 | I: Byte; 4 | begin 5 | Result := 1; 6 | for I := 1 to Exponent do 7 | Result := Result * Base; 8 | end; -------------------------------------------------------------------------------- /collection/583.dat: -------------------------------------------------------------------------------- 1 | procedure WBCopy(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_COPY, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/586.dat: -------------------------------------------------------------------------------- 1 | procedure WBPaste(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_PASTE, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/589.dat: -------------------------------------------------------------------------------- 1 | procedure WBRedo(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_REDO, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/590.dat: -------------------------------------------------------------------------------- 1 | procedure WBUndo(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_UNDO, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/636.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Cardinal): Cardinal; overload; 2 | var 3 | Elem: Cardinal; 4 | begin 5 | Result := 0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/637.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Double): Double; overload; 2 | var 3 | Elem: Double; 4 | begin 5 | Result := 0.0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/640.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Integer): Integer; overload; 2 | var 3 | Elem: Integer; 4 | begin 5 | Result := 0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/641.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Single): Single; overload; 2 | var 3 | Elem: Single; 4 | begin 5 | Result := 0.0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/042.dat: -------------------------------------------------------------------------------- 1 | function SystemFolder: string; 2 | begin 3 | SetLength(Result, Windows.MAX_PATH); 4 | SetLength( 5 | Result, Windows.GetSystemDirectory(PChar(Result), Windows.MAX_PATH) 6 | ); 7 | end; -------------------------------------------------------------------------------- /collection/123.dat: -------------------------------------------------------------------------------- 1 | procedure ExchangeInt(var I1, I2: Integer); 2 | var 3 | Temp: Integer; // temporary value used when exchanging values 4 | begin 5 | Temp := I1; 6 | I1 := I2; 7 | I2 := Temp; 8 | end; -------------------------------------------------------------------------------- /collection/156.dat: -------------------------------------------------------------------------------- 1 | function UnixDateToDateTime(const USec: Longint): TDateTime; 2 | const 3 | cUnixStartDate: TDateTime = 25569.0; // 1970/01/01 4 | begin 5 | Result := (Usec / 86400) + cUnixStartDate; 6 | end; -------------------------------------------------------------------------------- /collection/206.dat: -------------------------------------------------------------------------------- 1 | function SignOfInt(const Value: Int64): Integer; 2 | begin 3 | if Value < 0 then 4 | Result := -1 5 | else if Value = 0 then 6 | Result := 0 7 | else 8 | Result := 1; 9 | end; -------------------------------------------------------------------------------- /collection/249.dat: -------------------------------------------------------------------------------- 1 | function QuoteSpacedString(const S: string; const Quote: Char): string; 2 | begin 3 | if ContainsWhiteSpace(S) then 4 | Result := Quote + S + Quote 5 | else 6 | Result := S; 7 | end; -------------------------------------------------------------------------------- /collection/286.dat: -------------------------------------------------------------------------------- 1 | type 2 | THSBColor = record 3 | Hue, // hue (degrees) 4 | Saturation, // saturation (percentage) 5 | Brightness: Double; // brightness (percentage) 6 | end; -------------------------------------------------------------------------------- /collection/376.dat: -------------------------------------------------------------------------------- 1 | function ZoomRatio(const DestWidth, DestHeight, SrcWidth, SrcHeight: Integer): 2 | Double; overload; 3 | begin 4 | Result := Math.Min(DestWidth / SrcWidth, DestHeight / SrcHeight); 5 | end; -------------------------------------------------------------------------------- /collection/408.dat: -------------------------------------------------------------------------------- 1 | function GetLastDirectory(APath: string): string; 2 | begin 3 | if IsDirectory(APath) then 4 | Result := SysUtils.ExtractFileName(PathToDir(APath)) 5 | else 6 | Result := ''; 7 | end; -------------------------------------------------------------------------------- /collection/418.dat: -------------------------------------------------------------------------------- 1 | function DigitSum(AValue: Int64): Integer; 2 | begin 3 | if AValue mod 10 = AValue then 4 | Result := AValue 5 | else 6 | Result := (AValue mod 10) + DigitSum(AValue div 10) 7 | end; -------------------------------------------------------------------------------- /collection/419.dat: -------------------------------------------------------------------------------- 1 | function ResizeRect(const R: Types.TRect; const NewWidth, NewHeight: LongInt): 2 | Types.TRect; overload; 3 | begin 4 | Result := Types.Bounds(R.Left, R.Top, NewWidth, NewHeight); 5 | end; -------------------------------------------------------------------------------- /collection/447.dat: -------------------------------------------------------------------------------- 1 | procedure GreyScale(const SrcBmp, DestBmp: Graphics.TBitmap; 2 | const Method: TGreyScaleMethod); overload; 3 | begin 4 | DestBmp.Assign(SrcBmp); 5 | GreyScale(DestBmp, Method); 6 | end; -------------------------------------------------------------------------------- /collection/484.dat: -------------------------------------------------------------------------------- 1 | function PopByteArray(var A: TBytes): Byte; 2 | begin 3 | Assert(Length(A) > 0, 'A must be a non-empty array'); 4 | Result := A[Pred(Length(A))]; 5 | SetLength(A, Length(A) - 1); 6 | end; -------------------------------------------------------------------------------- /collection/500.dat: -------------------------------------------------------------------------------- 1 | function GetWindowTitle(Wnd: Windows.HWND): string; 2 | var 3 | Title: array[0..255] of Char; 4 | begin 5 | Windows.GetWindowText(Wnd, Title, Length(Title)); 6 | Result := Title; 7 | end; -------------------------------------------------------------------------------- /collection/585.dat: -------------------------------------------------------------------------------- 1 | procedure WBDelete(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_DELETE, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/638.dat: -------------------------------------------------------------------------------- 1 | function ArraySum(const A: array of Extended): Extended; overload; 2 | var 3 | Elem: Extended; 4 | begin 5 | Result := 0.0; 6 | for Elem in A do 7 | Result := Result + Elem; 8 | end; -------------------------------------------------------------------------------- /collection/TESTERS: -------------------------------------------------------------------------------- 1 | Peter Johnson (DelphiDabbler) 2 | Nigel Thomas 3 | Laurent Pierre 4 | Jan Roza 5 | Malcolm Cheyne 6 | Bill Miller 7 | Michael Rockett 8 | Montor 9 | Thierry Bothorel 10 | Cirec 11 | -------------------------------------------------------------------------------- /collection/041.dat: -------------------------------------------------------------------------------- 1 | function WindowsFolder: string; 2 | begin 3 | SetLength(Result, Windows.MAX_PATH); 4 | SetLength( 5 | Result, Windows.GetWindowsDirectory(PChar(Result), Windows.MAX_PATH) 6 | ); 7 | end; -------------------------------------------------------------------------------- /collection/092.dat: -------------------------------------------------------------------------------- 1 | function IsMediaCenterOS: Boolean; 2 | const 3 | SM_MEDIACENTER = 87; // metrics flag not defined in Windows unit 4 | begin 5 | Result := Windows.GetSystemMetrics(SM_MEDIACENTER) <> 0; 6 | end; -------------------------------------------------------------------------------- /collection/225.dat: -------------------------------------------------------------------------------- 1 | function DateMonth(const ADate: TDateTime): Word; 2 | var 3 | Year, Day: Word; // unused dummy values required by DecodeDate 4 | begin 5 | SysUtils.DecodeDate(ADate, Year, Result, Day); 6 | end; -------------------------------------------------------------------------------- /collection/226.dat: -------------------------------------------------------------------------------- 1 | function DateYear(const ADate: TDateTime): Word; 2 | var 3 | Month, Day: Word; // unused dummy values required by DecodeDate 4 | begin 5 | SysUtils.DecodeDate(ADate, Result, Month, Day); 6 | end; -------------------------------------------------------------------------------- /collection/239.dat: -------------------------------------------------------------------------------- 1 | function ContainsWhiteSpace(const S: string): Boolean; 2 | const 3 | cWhiteSpace = ' '#9#10#11#12#13; // white space characters 4 | begin 5 | Result := ContainsDelims(S, cWhiteSpace); 6 | end; -------------------------------------------------------------------------------- /collection/263.dat: -------------------------------------------------------------------------------- 1 | function CtrlBoundsToScreen(const Ctrl: Controls.TControl): Windows.TRect; 2 | begin 3 | Result := ClientRectToScreen( 4 | Ctrl, Classes.Rect(0, 0, Ctrl.Width, Ctrl.Height) 5 | ); 6 | end; -------------------------------------------------------------------------------- /collection/302.dat: -------------------------------------------------------------------------------- 1 | function IsRemoteSession: Boolean; 2 | const 3 | SM_REMOTESESSION = $1000; // value to pass to GetSystemMetrics 4 | begin 5 | Result := Windows.GetSystemMetrics(SM_REMOTESESSION) <> 0; 6 | end; -------------------------------------------------------------------------------- /collection/319.dat: -------------------------------------------------------------------------------- 1 | function TryHexToInt(const HexStr: string; out Value: Integer): Boolean; 2 | var 3 | E: Integer; // error code 4 | begin 5 | Val(AddHexPrefix(HexStr), Value, E); 6 | Result := E = 0; 7 | end; -------------------------------------------------------------------------------- /collection/320.dat: -------------------------------------------------------------------------------- 1 | function TryHexToInt64(const HexStr: string; out Value: Int64): Boolean; 2 | var 3 | E: Integer; // error code 4 | begin 5 | Val(AddHexPrefix(HexStr), Value, E); 6 | Result := E = 0; 7 | end; -------------------------------------------------------------------------------- /collection/398.dat: -------------------------------------------------------------------------------- 1 | function DefaultFileExt(const FileName, Ext: string): string; 2 | begin 3 | if HasFileExt(FileName) then 4 | Result := FileName 5 | else 6 | Result := ForceFileExt(FileName, Ext); 7 | end; -------------------------------------------------------------------------------- /collection/425.dat: -------------------------------------------------------------------------------- 1 | function Mid(const A, B, C: Int64): Int64; overload; 2 | begin 3 | Result := Math.Min( 4 | Math.Min( 5 | Math.Max(A, B), Math.Max(B, C) 6 | ), 7 | Math.Max(A, C) 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/538.dat: -------------------------------------------------------------------------------- 1 | function StrTokenCount(S: string; Seperator: Char): Integer; 2 | begin 3 | Result := 0; 4 | while S <> '' do 5 | begin 6 | StrToken(S, Seperator); 7 | Inc(Result); 8 | end; 9 | end; -------------------------------------------------------------------------------- /collection/564.dat: -------------------------------------------------------------------------------- 1 | function FileInProgramDir(FileName: string): string; 2 | begin 3 | Assert(FileName <> '', 'FileName must be provided'); 4 | Result := ProgramPath + SysUtils.ExtractFileName(FileName); 5 | end; -------------------------------------------------------------------------------- /collection/588.dat: -------------------------------------------------------------------------------- 1 | procedure WBSelectAll(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_SELECTALL, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/604.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowPrintDlg(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_PRINT, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/155.dat: -------------------------------------------------------------------------------- 1 | function DateTimeToUnixDate(const ADate: TDateTime): Longint; 2 | const 3 | cUnixStartDate: TDateTime = 25569.0; // 1970/01/01 4 | begin 5 | Result := Round((ADate - cUnixStartDate) * 86400); 6 | end; -------------------------------------------------------------------------------- /collection/184.dat: -------------------------------------------------------------------------------- 1 | function WordCount(S: string): Integer; 2 | begin 3 | S := SysUtils.Trim(S); 4 | if S <> '' then 5 | Result := CountDelims(CompressWhiteSpace(S), ' ') + 1 6 | else 7 | Result := 0; 8 | end; -------------------------------------------------------------------------------- /collection/205.dat: -------------------------------------------------------------------------------- 1 | function SignOfFloat(const Value: Extended): Integer; 2 | begin 3 | if Value < 0.0 then 4 | Result := -1 5 | else if Value = 0.0 then 6 | Result := 0 7 | else 8 | Result := 1; 9 | end; -------------------------------------------------------------------------------- /collection/224.dat: -------------------------------------------------------------------------------- 1 | function DateDay(const ADate: TDateTime): Word; 2 | var 3 | Year, Month: Word; // unused dummy values required by DecodeDate 4 | begin 5 | SysUtils.DecodeDate(ADate, Year, Month, Result); 6 | end; -------------------------------------------------------------------------------- /collection/423.dat: -------------------------------------------------------------------------------- 1 | function Mid(const A, B, C: Double): Double; overload; 2 | begin 3 | Result := Math.Min( 4 | Math.Min( 5 | Math.Max(A, B), Math.Max(B, C) 6 | ), 7 | Math.Max(A, C) 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/424.dat: -------------------------------------------------------------------------------- 1 | function Mid(const A, B, C: Extended): Extended; overload; 2 | begin 3 | Result := Math.Min( 4 | Math.Min( 5 | Math.Max(A, B), Math.Max(B, C) 6 | ), 7 | Math.Max(A, C) 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/426.dat: -------------------------------------------------------------------------------- 1 | function Mid(const A, B, C: Integer): Integer; overload; 2 | begin 3 | Result := Math.Min( 4 | Math.Min( 5 | Math.Max(A, B), Math.Max(B, C) 6 | ), 7 | Math.Max(A, C) 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/427.dat: -------------------------------------------------------------------------------- 1 | function Mid(const A, B, C: Single): Single; overload; 2 | begin 3 | Result := Math.Min( 4 | Math.Min( 5 | Math.Max(A, B), Math.Max(B, C) 6 | ), 7 | Math.Max(A, C) 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/492.dat: -------------------------------------------------------------------------------- 1 | function RectF(const ALeft, ATop, ARight, ABottom: Double): TRectF; 2 | begin 3 | Result.Left := ALeft; 4 | Result.Top := ATop; 5 | Result.Right := ARight; 6 | Result.Bottom := ABottom; 7 | end; -------------------------------------------------------------------------------- /collection/565.dat: -------------------------------------------------------------------------------- 1 | function SafeFreeEncoding(const Enc: SysUtils.TEncoding): Boolean; 2 | begin 3 | if SysUtils.TEncoding.IsStandardEncoding(Enc) then 4 | Exit(False); 5 | Enc.Free; 6 | Result := True; 7 | end; -------------------------------------------------------------------------------- /collection/594.dat: -------------------------------------------------------------------------------- 1 | function GetErrorMessageWithId(const OSErrorCode: Cardinal): string; 2 | begin 3 | if OSErrorCode <> 0 then 4 | Result := SysUserErrorMessage(OSErrorCode) 5 | else 6 | Result := ''; 7 | end; -------------------------------------------------------------------------------- /collection/602.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowPageSetupDlg(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_PAGESETUP, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/656.dat: -------------------------------------------------------------------------------- 1 | function ReverseByteArray(const A: array of Byte): TBytes; 2 | var 3 | I: Integer; 4 | begin 5 | SetLength(Result, Length(A)); 6 | for I := 0 to High(A) do 7 | Result[High(A)-I] := A[I]; 8 | end; -------------------------------------------------------------------------------- /collection/135.dat: -------------------------------------------------------------------------------- 1 | function IsKeyPressed(const VirtKeyCode: Integer): Boolean; 2 | begin 3 | // High bit set when key is pressed => GetKeyState returns -ve value 4 | Result := Windows.GetKeyState(VirtKeyCode) < 0; 5 | end; -------------------------------------------------------------------------------- /collection/175.dat: -------------------------------------------------------------------------------- 1 | function TimeHour(const Time: TDateTime): Word; 2 | var 3 | Min, Sec, Sec100: Word; // unused dummy values required by DecodeTime 4 | begin 5 | SysUtils.DecodeTime(Time, Result, Min, Sec, Sec100); 6 | end; -------------------------------------------------------------------------------- /collection/176.dat: -------------------------------------------------------------------------------- 1 | function TimeMin(const Time: TDateTime): Word; 2 | var 3 | Hour, Sec, Sec100: Word; // unused dummy values required by DecodeTime 4 | begin 5 | SysUtils.DecodeTime(Time, Hour, Result, Sec, Sec100); 6 | end; -------------------------------------------------------------------------------- /collection/177.dat: -------------------------------------------------------------------------------- 1 | function TimeSec(const Time: TDateTime): Word; 2 | var 3 | Hour, Min, Sec100: Word; // unused dummy values required by DecodeTime 4 | begin 5 | SysUtils.DecodeTime(Time, Hour, Min, Result, Sec100); 6 | end; -------------------------------------------------------------------------------- /collection/200.dat: -------------------------------------------------------------------------------- 1 | function ResourceIDToStr(const ResID: PChar): string; 2 | begin 3 | if IsIntResource(ResID) then 4 | Result := '#' + SysUtils.IntToStr(Integer(ResID)) 5 | else 6 | Result := string(ResID); 7 | end; -------------------------------------------------------------------------------- /collection/291.dat: -------------------------------------------------------------------------------- 1 | function IsInternetConnected: Boolean; 2 | var 3 | Flags: Windows.DWORD; // flags to pass to API function 4 | begin 5 | Flags := 0; 6 | Result := WinInet.InternetGetConnectedState(@Flags, 0); 7 | end; -------------------------------------------------------------------------------- /collection/443.dat: -------------------------------------------------------------------------------- 1 | function DateYearEnd(const DT: TDateTime): TDateTime; 2 | var 3 | Year, Month, Day: Word; 4 | begin 5 | SysUtils.DecodeDate(DT, Year, Month, Day); 6 | Result := SysUtils.EncodeDate(Year, 12, 31); 7 | end; -------------------------------------------------------------------------------- /collection/444.dat: -------------------------------------------------------------------------------- 1 | function DateYearStart(const DT: TDateTime): TDateTime; 2 | var 3 | Year, Month, Day: Word; 4 | begin 5 | SysUtils.DecodeDate(DT, Year, Month, Day); 6 | Result := SysUtils.EncodeDate(Year, 1, 1); 7 | end; -------------------------------------------------------------------------------- /collection/571.dat: -------------------------------------------------------------------------------- 1 | procedure WBWaitForDocToLoad(WB: SHDocVw.TWebbrowser); 2 | begin 3 | while (WB.ReadyState <> SHDocVw.READYSTATE_COMPLETE) do 4 | begin 5 | ProcessMessages; 6 | Windows.Sleep(0); 7 | end; 8 | end; -------------------------------------------------------------------------------- /collection/587.dat: -------------------------------------------------------------------------------- 1 | procedure WBClearSelection(WB: SHDocVw.TWebBrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_CLEARSELECTION, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/595.dat: -------------------------------------------------------------------------------- 1 | function DeleteEnvVar(const VarName: string): Integer; 2 | begin 3 | if Windows.SetEnvironmentVariable(PChar(VarName), nil) then 4 | Result := 0 5 | else 6 | Result := Windows.GetLastError; 7 | end; -------------------------------------------------------------------------------- /collection/603.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowPrintPreviewDlg(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_PRINTPREVIEW, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/605.dat: -------------------------------------------------------------------------------- 1 | procedure WBShowPropertiesDlg(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBInvokeCmd( 4 | WB, 5 | False, 6 | SHDocVw.OLECMDID_PROPERTIES, 7 | SHDocVw.OLECMDEXECOPT_DODEFAULT 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/073.dat: -------------------------------------------------------------------------------- 1 | function IsValidDriveNum(const DriveNum: Byte): Boolean; 2 | begin 3 | if DriveNum in [0..25] then 4 | Result := Windows.GetLogicalDrives and (1 shl DriveNum) <> 0 5 | else 6 | Result := False; 7 | end; -------------------------------------------------------------------------------- /collection/111.dat: -------------------------------------------------------------------------------- 1 | function IsEqualRGBTriple(const T1, T2: Windows.TRGBTriple): Boolean; 2 | begin 3 | Result := (T1.rgbtBlue = T2.rgbtBlue) and 4 | (T1.rgbtGreen = T2.rgbtGreen) and 5 | (T1.rgbtRed = T2.rgbtRed); 6 | end; -------------------------------------------------------------------------------- /collection/493.dat: -------------------------------------------------------------------------------- 1 | function BoundsF(ALeft, ATop, AWidth, AHeight: Double): TRectF; 2 | begin 3 | Result.Left := ALeft; 4 | Result.Top := ATop; 5 | Result.Right := ALeft + AWidth; 6 | Result.Bottom := ATop + AHeight; 7 | end; -------------------------------------------------------------------------------- /collection/521.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16Stream(const Stm: Classes.TStream): Boolean; 2 | begin 3 | Result := StreamHasWatermark(Stm, [$FF, $FE]) // UTF-16 LE 4 | or StreamHasWatermark(Stm, [$FE, $FF]) // UTF-16 BE 5 | end; -------------------------------------------------------------------------------- /collection/629.dat: -------------------------------------------------------------------------------- 1 | function RFC1123DateGMT(const DT: TDateTime): string; 2 | const 3 | RFC1123Pattern = 'ddd, dd mmm yyyy HH'':''nn'':''ss ''GMT'''; 4 | begin 5 | Result := SysUtils.FormatDateTime(RFC1123Pattern, DT); 6 | end; -------------------------------------------------------------------------------- /collection/122.dat: -------------------------------------------------------------------------------- 1 | function RemoveFileExt(const FileName: string): string; 2 | begin 3 | if SysUtils.AnsiPos('.', FileName) > 0 then 4 | Result := SysUtils.ChangeFileExt(FileName, '') 5 | else 6 | Result := FileName; 7 | end; -------------------------------------------------------------------------------- /collection/251.dat: -------------------------------------------------------------------------------- 1 | function IsCharInSet(const Ch: Char; const Chars: TCharSet): Boolean; 2 | begin 3 | {$IFDEF UNICODE} 4 | Result := SysUtils.CharInSet(Ch, Chars); 5 | {$ELSE} 6 | Result := Ch in Chars; 7 | {$ENDIF} 8 | end; -------------------------------------------------------------------------------- /collection/296.dat: -------------------------------------------------------------------------------- 1 | function BytesToGBStr(const Bytes: Int64; const DecimalPlaces: Byte; 2 | const SeparateThousands: Boolean): string; 3 | begin 4 | Result := FloatToFixed(BytesToGB(Bytes), DecimalPlaces, SeparateThousands); 5 | end; -------------------------------------------------------------------------------- /collection/298.dat: -------------------------------------------------------------------------------- 1 | function BytesToKBStr(const Bytes: Int64; const DecimalPlaces: Byte; 2 | const SeparateThousands: Boolean): string; 3 | begin 4 | Result := FloatToFixed(BytesToKB(Bytes), DecimalPlaces, SeparateThousands); 5 | end; -------------------------------------------------------------------------------- /collection/300.dat: -------------------------------------------------------------------------------- 1 | function BytesToMBStr(const Bytes: Int64; const DecimalPlaces: Byte; 2 | const SeparateThousands: Boolean): string; 3 | begin 4 | Result := FloatToFixed(BytesToMB(Bytes), DecimalPlaces, SeparateThousands); 5 | end; -------------------------------------------------------------------------------- /collection/405.dat: -------------------------------------------------------------------------------- 1 | function ReverseNumber(AValue: Int64): Int64; 2 | begin 3 | Result := 0; 4 | while AValue > 0 do 5 | begin 6 | Result := (Result * 10) + (AValue mod 10); 7 | AValue := AValue div 10; 8 | end; 9 | end; -------------------------------------------------------------------------------- /collection/442.dat: -------------------------------------------------------------------------------- 1 | function DateMonthStart(const DT: TDateTime): TDateTime; 2 | var 3 | Day, Month, Year: Word; 4 | begin 5 | SysUtils.DecodeDate(DT, Year, Month, Day); 6 | Result := SysUtils.EncodeDate(Year, Month, 1); 7 | end; -------------------------------------------------------------------------------- /collection/486.dat: -------------------------------------------------------------------------------- 1 | function ShiftByteArray(var A: TBytes): Byte; 2 | begin 3 | Assert(Length(A) > 0, 'A must be a non-empty array'); 4 | Result := A[0]; 5 | Move(A[1], A[0], Length(A) - 1); 6 | SetLength(A, Length(A) - 1); 7 | end; -------------------------------------------------------------------------------- /collection/662.dat: -------------------------------------------------------------------------------- 1 | function IsNarcissistic(N: Integer; const Base: Byte = 10): Boolean; 2 | var 3 | Sum: Int64; 4 | begin 5 | N := Abs(N); 6 | Sum := DigitPowerSum(N, Base, DigitCountBase(N, Base)); 7 | Result := N = Sum; 8 | end; -------------------------------------------------------------------------------- /collection/199.dat: -------------------------------------------------------------------------------- 1 | function ResourceExistsEx(const Module: Windows.HMODULE; 2 | const ResType, ResName: PChar; const Language: Word): Boolean; 3 | begin 4 | Result := Windows.FindResourceEx(Module, ResName, ResType, Language) <> 0; 5 | end; -------------------------------------------------------------------------------- /collection/558.dat: -------------------------------------------------------------------------------- 1 | function FractionToStrEx(Num, Denom: Integer; Normalise: Boolean = False): string; 2 | begin 3 | if Normalise then 4 | NormaliseFractionSign(Num, Denom); 5 | Result := SysUtils.Format('%d/%d', [Num, Denom]); 6 | end; -------------------------------------------------------------------------------- /collection/600.dat: -------------------------------------------------------------------------------- 1 | function SetEnvVar(const VarName, VarValue: string): Integer; 2 | begin 3 | if Windows.SetEnvironmentVariable(PChar(VarName), PChar(VarValue)) then 4 | Result := 0 5 | else 6 | Result := GetLastError; 7 | end; -------------------------------------------------------------------------------- /collection/022.dat: -------------------------------------------------------------------------------- 1 | function BrowseURL(const URL: string): Boolean; 2 | begin 3 | if not IsValidURLProtocol(URL) then 4 | raise SysUtils.Exception.CreateFmt('"%s" is not a valid URL', [URL]); 5 | Result := ExecAssociatedApp(URL); 6 | end; -------------------------------------------------------------------------------- /collection/231.dat: -------------------------------------------------------------------------------- 1 | function Factorial(N: Byte): Int64; 2 | var 3 | K: Integer; // loop control 4 | begin 5 | Result := 1; 6 | if (N = 0) or (N = 1) then 7 | Exit; 8 | for K := 2 to N do 9 | Result := Result * K; 10 | end; -------------------------------------------------------------------------------- /collection/357.dat: -------------------------------------------------------------------------------- 1 | function SecondsToTime(const ASeconds: Cardinal): TDateTime; 2 | const 3 | MSecsPerSec = 1000; // ms per day: not defined in Delphi 6 and earlier 4 | begin 5 | Result := ASeconds / SysUtils.MSecsPerDay * MSecsPerSec; 6 | end; -------------------------------------------------------------------------------- /collection/363.dat: -------------------------------------------------------------------------------- 1 | function AnsiStringToCharSet(const S: RawByteString): TCharSet; 2 | var 3 | Idx: Integer; // indexes characters of S 4 | begin 5 | Result := []; 6 | for Idx := 1 to Length(S) do 7 | Include(Result, S[Idx]); 8 | end; -------------------------------------------------------------------------------- /collection/576.dat: -------------------------------------------------------------------------------- 1 | procedure WBBlankDocument(WB: SHDocVw.TWebbrowser); 2 | begin 3 | WBNavigate( 4 | WB, 5 | 'about:blank', 6 | SHDocVw.navNoHistory or SHDocVw.navNoReadFromCache 7 | or SHDocVw.navNoWriteToCache 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/278.dat: -------------------------------------------------------------------------------- 1 | procedure CursorToBitmap(const Cursor: Controls.TCursor; 2 | const Bmp: Graphics.TBitmap; const TransparentColor: Graphics.TColor); 3 | begin 4 | CursorHandleToBitmap(Forms.Screen.Cursors[Cursor], Bmp, TransparentColor); 5 | end; -------------------------------------------------------------------------------- /collection/413.dat: -------------------------------------------------------------------------------- 1 | function DateQuarter(const D: TDateTime): Byte; 2 | var 3 | Year, Month, Day: Word; // year, month and date components of D 4 | begin 5 | SysUtils.DecodeDate(D, Year, Month, Day); 6 | Result := 4 - ((12 - Month) div 3); 7 | end; -------------------------------------------------------------------------------- /collection/028.dat: -------------------------------------------------------------------------------- 1 | function DriveTypeFromPath(const Path: string): Integer; 2 | var 3 | Drive: string; // the drive name 4 | begin 5 | Drive := SysUtils.ExtractFileDrive(Path) + '\'; 6 | Result := Integer(Windows.GetDriveType(PChar(Drive))); 7 | end; -------------------------------------------------------------------------------- /collection/094.dat: -------------------------------------------------------------------------------- 1 | function DateTimeToWinFileTime(DT: TDateTime): Windows.TFileTime; 2 | var 3 | ST: Windows.TSystemTime; 4 | begin 5 | SysUtils.DateTimeToSystemTime(DT, ST); 6 | SysUtils.Win32Check(Windows.SystemTimeToFileTime(ST, Result)); 7 | end; -------------------------------------------------------------------------------- /collection/209.dat: -------------------------------------------------------------------------------- 1 | function IsHiddenFile(const FileSpec: string): Boolean; 2 | var 3 | Attr: Integer; // file's attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(FileSpec); 6 | Result := (Attr <> -1) and IsFlagSet(Attr, SysUtils.faHidden); 7 | end; -------------------------------------------------------------------------------- /collection/LICENSE-INFO: -------------------------------------------------------------------------------- 1 | LicenseName=MIT License 2 | LicenseSPDX=MIT 3 | LicenseURL=https://opensource.org/licenses/MIT 4 | CopyrightDate=2005-2025 5 | CopyrightHolder=Peter Johnson & Contributors 6 | CopyrightHolderURL=http://gravatar.com/delphidabbler 7 | -------------------------------------------------------------------------------- /collection/001.dat: -------------------------------------------------------------------------------- 1 | function WinFileTimeToDOSFileTime(FT: Windows.TFileTime): Integer; 2 | begin 3 | SysUtils.Win32Check( 4 | Windows.FileTimeToDosDateTime( 5 | FT, SysUtils.LongRec(Result).Hi, SysUtils.LongRec(Result).Lo 6 | ) 7 | ); 8 | end; -------------------------------------------------------------------------------- /collection/018.dat: -------------------------------------------------------------------------------- 1 | function ExecAssociatedApp(const FileName: string): Boolean; 2 | begin 3 | Result := ShellAPI.ShellExecute( 4 | 0, 5 | nil, 6 | PChar(FileName), 7 | nil, 8 | nil, 9 | Windows.SW_SHOW 10 | ) > 32; 11 | end; -------------------------------------------------------------------------------- /collection/207.dat: -------------------------------------------------------------------------------- 1 | function IsArchiveFile(const FileSpec: string): Boolean; 2 | var 3 | Attr: Integer; // file's attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(FileSpec); 6 | Result := (Attr <> -1) and IsFlagSet(Attr, SysUtils.faArchive); 7 | end; -------------------------------------------------------------------------------- /collection/208.dat: -------------------------------------------------------------------------------- 1 | function IsFile(const FileSpec: string): Boolean; 2 | var 3 | Attr: Integer; // file's attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(FileSpec); 6 | Result := (Attr <> -1) and not IsFlagSet(Attr, SysUtils.faDirectory); 7 | end; -------------------------------------------------------------------------------- /collection/210.dat: -------------------------------------------------------------------------------- 1 | function IsReadOnlyFile(const FileSpec: string): Boolean; 2 | var 3 | Attr: Integer; // file's attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(FileSpec); 6 | Result := (Attr <> -1) and IsFlagSet(Attr, SysUtils.faReadOnly); 7 | end; -------------------------------------------------------------------------------- /collection/211.dat: -------------------------------------------------------------------------------- 1 | function IsSystemFile(const FileSpec: string): Boolean; 2 | var 3 | Attr: Integer; // file's attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(FileSpec); 6 | Result := (Attr <> -1) and IsFlagSet(Attr, SysUtils.faSysFile); 7 | end; -------------------------------------------------------------------------------- /collection/307.dat: -------------------------------------------------------------------------------- 1 | function PosByIndex(const N: Integer; const Str: string; 2 | const Delims: TCharSet): Integer; 3 | var 4 | En: integer; // index of end of word in AString: not used 5 | begin 6 | GetStartAndEndWord(N, Str, Delims, Result, En); 7 | end; -------------------------------------------------------------------------------- /collection/007.dat: -------------------------------------------------------------------------------- 1 | function IsDirectory(const DirName: string): Boolean; 2 | var 3 | Attr: Integer; // directory's file attributes 4 | begin 5 | Attr := SysUtils.FileGetAttr(DirName); 6 | Result := (Attr <> -1) and IsFlagSet(Attr, SysUtils.faDirectory); 7 | end; -------------------------------------------------------------------------------- /collection/601.dat: -------------------------------------------------------------------------------- 1 | function SetEnvVarValue(const VarName, VarValue: string): string; 2 | begin 3 | if Windows.SetEnvironmentVariable(PChar(VarName), PChar(VarValue)) then 4 | Result := '' 5 | else 6 | Result := GetErrorMessageWithId(GetLastError); 7 | end; -------------------------------------------------------------------------------- /collection/675.dat: -------------------------------------------------------------------------------- 1 | function GeometricMean(const A: array of Double): Double; overload; 2 | begin 3 | if System.Length(A) = 0 then 4 | raise SysUtils.EArgumentException.Create('Array is empty'); 5 | Result := System.Exp(SumOfLogs(A) / System.Length(A)); 6 | end; -------------------------------------------------------------------------------- /collection/201.dat: -------------------------------------------------------------------------------- 1 | function GCD(A, B: Integer): Integer; 2 | var 3 | Temp: Integer; // used in swapping A & B 4 | begin 5 | while B <> 0 do 6 | begin 7 | Temp := B; 8 | B := A mod Temp; 9 | A := Temp; 10 | end; 11 | Result := Abs(A); 12 | end; -------------------------------------------------------------------------------- /collection/676.dat: -------------------------------------------------------------------------------- 1 | function GeometricMean(const A: array of Cardinal): Double; overload; 2 | begin 3 | if System.Length(A) = 0 then 4 | raise SysUtils.EArgumentException.Create('Array is empty'); 5 | Result := System.Exp(SumOfLogs(A) / System.Length(A)); 6 | end; -------------------------------------------------------------------------------- /collection/677.dat: -------------------------------------------------------------------------------- 1 | function GeometricMean(const A: array of Integer): Double; overload; 2 | begin 3 | if System.Length(A) = 0 then 4 | raise SysUtils.EArgumentException.Create('Array is empty'); 5 | Result := System.Exp(SumOfLogs(A) / System.Length(A)); 6 | end; -------------------------------------------------------------------------------- /collection/120.dat: -------------------------------------------------------------------------------- 1 | procedure EmptyKeyQueue; 2 | var 3 | Msg: Windows.TMsg; // dummy value to receive each message from queue 4 | begin 5 | while Windows.PeekMessage( 6 | Msg, 0, Messages.WM_KEYFIRST, Messages.WM_KEYLAST, Windows.PM_REMOVE 7 | ) do {nothing}; 8 | end; -------------------------------------------------------------------------------- /collection/145.dat: -------------------------------------------------------------------------------- 1 | function RemainingBatteryPercent: Integer; 2 | var 3 | Stat: Windows.TSystemPowerStatus; 4 | begin 5 | Windows.GetSystemPowerStatus(Stat); 6 | Result := Stat.BatteryLifePercent; 7 | if (Result < 0) or (Result > 100) then 8 | Result := -1; 9 | end; -------------------------------------------------------------------------------- /collection/282.dat: -------------------------------------------------------------------------------- 1 | function WindowSupportsLayers(const HWnd: Windows.HWND): Boolean; 2 | const 3 | WS_EX_LAYERED = $00080000; // layered window style 4 | begin 5 | Result := IsFlagSet( 6 | Windows.GetWindowLong(HWnd, Windows.GWL_EXSTYLE), WS_EX_LAYERED 7 | ); 8 | end; -------------------------------------------------------------------------------- /collection/628.dat: -------------------------------------------------------------------------------- 1 | function NowGMT: TDateTime; 2 | var 3 | ST: Windows.TSystemTime; // current system time 4 | begin 5 | // This Windows API function gets system time in UTC/GMT 6 | Windows.GetSystemTime(ST); 7 | Result := SysUtils.SystemTimeToDateTime(ST); 8 | end; -------------------------------------------------------------------------------- /collection/262.dat: -------------------------------------------------------------------------------- 1 | function ClientRectToScreen(const Ctrl: Controls.TControl; 2 | const CliRect: Windows.TRect): Windows.TRect; 3 | begin 4 | Result.TopLeft := Ctrl.ClientToScreen(CliRect.TopLeft); 5 | Result.BottomRight := Ctrl.ClientToScreen(CliRect.BottomRight); 6 | end; -------------------------------------------------------------------------------- /collection/270.dat: -------------------------------------------------------------------------------- 1 | function TimeZoneBias: Integer; 2 | var 3 | TZI: Windows.TTimeZoneInformation; // info about time zone 4 | begin 5 | if Windows.GetTimeZoneInformation(TZI) = Windows.TIME_ZONE_ID_INVALID then 6 | SysUtils.RaiseLastOSError; 7 | Result := TZI.Bias 8 | end; -------------------------------------------------------------------------------- /collection/347.dat: -------------------------------------------------------------------------------- 1 | function StringListToArray(const SL: Classes.TStrings): Types.TStringDynArray; 2 | var 3 | Idx: Integer; // loops thru each string in SL 4 | begin 5 | SetLength(Result, SL.Count); 6 | for Idx := 0 to Pred(SL.Count) do 7 | Result[Idx] := SL[Idx]; 8 | end; -------------------------------------------------------------------------------- /collection/438.dat: -------------------------------------------------------------------------------- 1 | function ReverseStr(S: string): string; 2 | begin 3 | Result := SysUtils.EmptyStr; 4 | while System.Length(S) > 0 do 5 | begin 6 | Result := Result + StrUtils.RightStr(S, 1); 7 | S := StrUtils.LeftStr(S, Pred(System.Length(S))); 8 | end; 9 | end; -------------------------------------------------------------------------------- /collection/479.dat: -------------------------------------------------------------------------------- 1 | function DelStr(const Needle, Haystack: string): string; 2 | var 3 | StartIdx: Integer; 4 | begin 5 | Result := Haystack; 6 | StartIdx := SysUtils.AnsiPos(Needle, Result); 7 | if StartIdx > 0 then 8 | Delete(Result, StartIdx, Length(Needle)); 9 | end; -------------------------------------------------------------------------------- /collection/507.dat: -------------------------------------------------------------------------------- 1 | procedure DisableTreeViewToolTips(const TV: ComCtrls.TTreeView); 2 | begin 3 | Windows.SetWindowLong( 4 | TV.Handle, 5 | Windows.GWL_STYLE, 6 | Windows.GetWindowLong(TV.Handle, Windows.GWL_STYLE) 7 | or CommCtrl.TVS_NOTOOLTIPS 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/580.dat: -------------------------------------------------------------------------------- 1 | function Range(const A, B: Integer): TRange; 2 | begin 3 | if A <= B then 4 | begin 5 | Result.Lower := A; 6 | Result.Upper := B; 7 | end 8 | else 9 | begin 10 | Result.Lower := B; 11 | Result.Upper := A; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/032.dat: -------------------------------------------------------------------------------- 1 | function CountDelims(const S, Delims: string): Integer; 2 | var 3 | Idx: Integer; //loops thru all characters in string 4 | begin 5 | Result := 0; 6 | for Idx := 1 to Length(S) do 7 | if SysUtils.IsDelimiter(Delims, S, Idx) then 8 | Inc(Result); 9 | end; -------------------------------------------------------------------------------- /collection/412.dat: -------------------------------------------------------------------------------- 1 | function SQLDateToDateTime(const SQLDate: string): TDateTime; 2 | begin 3 | Result := SysUtils.EncodeDate( 4 | SysUtils.StrToInt(Copy(SQLDate, 1, 4)), 5 | SysUtils.StrToInt(Copy(SQLDate, 6, 2)), 6 | SysUtils.StrToInt(Copy(SQLDate, 9, 2)) 7 | ); 8 | end; -------------------------------------------------------------------------------- /collection/533.dat: -------------------------------------------------------------------------------- 1 | procedure ArrayToStringList(const Strings: array of string; 2 | const SL: Classes.TStrings); 3 | var 4 | Idx: Integer; // loops thru each string in array 5 | begin 6 | SL.Clear; 7 | for Idx := 0 to Pred(Length(Strings)) do 8 | SL.Add(Strings[Idx]); 9 | end; -------------------------------------------------------------------------------- /collection/707.dat: -------------------------------------------------------------------------------- 1 | function RandomString(const SL: Classes.TStrings): string; overload; 2 | begin 3 | if SL.Count = 0 then 4 | raise SysUtils.EArgumentException.Create( 5 | 'RandomString called with empty string list' 6 | ); 7 | Result := SL[Random(SL.Count)]; 8 | end; -------------------------------------------------------------------------------- /collection/181.dat: -------------------------------------------------------------------------------- 1 | function ExplodeUnquotedWords(const S: string; const List: Classes.TStrings; 2 | const AQuote: Char = '"'): Integer; 3 | begin 4 | List.Clear; 5 | List.QuoteChar := AQuote; 6 | List.Delimiter := ' '; 7 | List.DelimitedText := S; 8 | Result := List.Count; 9 | end; -------------------------------------------------------------------------------- /collection/216.dat: -------------------------------------------------------------------------------- 1 | function VScrollbarWidth(const Ctrl: Controls.TWinControl): Integer; 2 | begin 3 | if WinControlScrollbars(Ctrl) 4 | in [StdCtrls.ssVertical, StdCtrls.ssBoth] then 5 | Result := Windows.GetSystemMetrics(Windows.SM_CYVSCROLL) 6 | else 7 | Result := 0; 8 | end; -------------------------------------------------------------------------------- /collection/399.dat: -------------------------------------------------------------------------------- 1 | function ForceFileExt(const FileName, Ext: string): string; 2 | begin 3 | Result := RemoveFileExt(FileName); 4 | if Ext = '' then 5 | Exit; 6 | if Ext[1] = '.' then 7 | Result := Result + Ext 8 | else 9 | Result := Result + '.' + Ext; 10 | end; -------------------------------------------------------------------------------- /collection/441.dat: -------------------------------------------------------------------------------- 1 | function DateMonthEnd(const DT: TDateTime): TDateTime; 2 | var 3 | Day, Month, Year: Word; 4 | LastDay: Byte; 5 | begin 6 | SysUtils.DecodeDate(DT, Year, Month, Day); 7 | LastDay := DaysInMonth(DT); 8 | Result := SysUtils.EncodeDate(Year, Month, LastDay); 9 | end; -------------------------------------------------------------------------------- /collection/573.dat: -------------------------------------------------------------------------------- 1 | procedure WBWaitForDOMToLoad(WB: SHDocVw.TWebBrowser); 2 | resourcestring 3 | sNoDOMError = 'No DOM available in the browser control'; 4 | begin 5 | WBWaitForDocToLoad(WB); 6 | if not WBIsDOMLoaded(WB) then 7 | raise SysUtils.Exception.Create(sNoDOMError); 8 | end; -------------------------------------------------------------------------------- /collection/074.dat: -------------------------------------------------------------------------------- 1 | function LongToShortFilePath(const LongName: string): string; 2 | begin 3 | SetLength(Result, Windows.MAX_PATH); 4 | SetLength( 5 | Result, 6 | Windows.GetShortPathName( 7 | PChar(LongName), PChar(Result), Windows.MAX_PATH 8 | ) 9 | ); 10 | end; -------------------------------------------------------------------------------- /collection/125.dat: -------------------------------------------------------------------------------- 1 | function NormalizeRect(const R: Windows.TRect): Windows.TRect; 2 | begin 3 | Result := R; 4 | if Result.Left > Result.Right then 5 | ExchangeInt(Result.Left, Result.Right); 6 | if Result.Top > Result.Bottom then 7 | ExchangeInt(Result.Top, Result.Bottom); 8 | end; -------------------------------------------------------------------------------- /collection/215.dat: -------------------------------------------------------------------------------- 1 | function HScrollbarHeight(const Ctrl: Controls.TWinControl): Integer; 2 | begin 3 | if WinControlScrollbars(Ctrl) 4 | in [StdCtrls.ssHorizontal, StdCtrls.ssBoth] then 5 | Result := Windows.GetSystemMetrics(Windows.SM_CXHSCROLL) 6 | else 7 | Result := 0; 8 | end; -------------------------------------------------------------------------------- /collection/430.dat: -------------------------------------------------------------------------------- 1 | function MaxOfArray(const A: array of Int64): Int64; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] > Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/435.dat: -------------------------------------------------------------------------------- 1 | function MinOfArray(const A: array of Int64): Int64; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] < Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/591.dat: -------------------------------------------------------------------------------- 1 | function GetTotalPhysMemory: Int64; 2 | var 3 | MemoryEx: Windows.TMemoryStatusEx; 4 | begin 5 | begin 6 | MemoryEx.dwLength := SizeOf(TMemoryStatusEx); 7 | Windows.GlobalMemoryStatusEx(MemoryEx); 8 | Result := MemoryEx.ullTotalPhys; 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/618.dat: -------------------------------------------------------------------------------- 1 | function ContainsFocus(Control: Controls.TWinControl): Boolean; 2 | var 3 | FC: Controls.TWinControl; 4 | begin 5 | FC := FocusedControl; 6 | if Assigned(FC) then 7 | Result := Control.ContainsControl(FocusedControl) 8 | else 9 | Result := False 10 | end; -------------------------------------------------------------------------------- /collection/036.dat: -------------------------------------------------------------------------------- 1 | function HasVerInfo(const FileName: string): Boolean; 2 | var 3 | Dummy: Cardinal; // dummy variable required by API function 4 | begin 5 | // API function returns size of ver info: 0 if none 6 | Result := Windows.GetFileVersionInfoSize(PChar(FileName), Dummy) > 0; 7 | end; -------------------------------------------------------------------------------- /collection/154.dat: -------------------------------------------------------------------------------- 1 | function TryStrToByte(const S: string; out B: Byte): Boolean; 2 | var 3 | Value: Word; // receives word value of conversion 4 | begin 5 | Result := TryStrToWord(S, Value) and (SysUtils.WordRec(Value).Hi = 0); 6 | if Result then 7 | B := SysUtils.WordRec(Value).Lo; 8 | end; -------------------------------------------------------------------------------- /collection/336.dat: -------------------------------------------------------------------------------- 1 | function Clamp(const Value, RangeLo, RangeHi: Integer ): Integer; 2 | begin 3 | Assert(RangeLo <= RangeHi); 4 | if Value < RangeLo then 5 | Result := RangeLo 6 | else if Value > RangeHi then 7 | Result := RangeHi 8 | else 9 | Result := Value; 10 | end; -------------------------------------------------------------------------------- /collection/338.dat: -------------------------------------------------------------------------------- 1 | function FormInstanceCount(AFormClass: Forms.TFormClass): Integer; overload; 2 | var 3 | I: Integer; // loops through all forms 4 | begin 5 | Result := 0; 6 | for I := 0 to Forms.Screen.FormCount - 1 do 7 | Inc(Result, Ord(Forms.Screen.Forms[I] is AFormClass)); 8 | end; -------------------------------------------------------------------------------- /collection/428.dat: -------------------------------------------------------------------------------- 1 | function MaxOfArray(const A: array of Double): Double; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] > Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/429.dat: -------------------------------------------------------------------------------- 1 | function MaxOfArray(const A: array of Extended): Extended; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] > Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/431.dat: -------------------------------------------------------------------------------- 1 | function MaxOfArray(const A: array of Integer): Integer; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] > Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/432.dat: -------------------------------------------------------------------------------- 1 | function MaxOfArray(const A: array of Single): Single; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] > Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/433.dat: -------------------------------------------------------------------------------- 1 | function MinOfArray(const A: array of Double): Double; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] < Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/434.dat: -------------------------------------------------------------------------------- 1 | function MinOfArray(const A: array of Extended): Extended; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] < Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/436.dat: -------------------------------------------------------------------------------- 1 | function MinOfArray(const A: array of Integer): Integer; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] < Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/437.dat: -------------------------------------------------------------------------------- 1 | function MinOfArray(const A: array of Single): Single; overload; 2 | var 3 | Idx: Integer; 4 | begin 5 | Assert(Length(A) > 0); 6 | Result := A[Low(A)]; 7 | for Idx := Succ(Low(A)) to High(A) do 8 | if A[Idx] < Result then 9 | Result := A[Idx]; 10 | end; -------------------------------------------------------------------------------- /collection/370.dat: -------------------------------------------------------------------------------- 1 | function CheckInternetConnection(AHost: PAnsiChar): Boolean; 2 | var 3 | PHE: PHostEnt; 4 | GInitData: TWSAData; 5 | begin 6 | WinSock.WSAStartup($101, GInitData); 7 | PHE := WinSock.GetHostByName(AHost); 8 | WinSock.WSACleanup; 9 | Result := (PHE <> nil); 10 | end; -------------------------------------------------------------------------------- /collection/406.dat: -------------------------------------------------------------------------------- 1 | function ReverseNumberR(AValue: Int64): Int64; 2 | begin 3 | Assert(AValue >= 0); 4 | if AValue mod 10 = AValue then 5 | Result := AValue 6 | else 7 | Result := ((AValue mod 10) * Trunc(IntPower(10, Trunc(Log10(AValue))))) 8 | + ReverseNumberR(AValue div 10) 9 | end; -------------------------------------------------------------------------------- /collection/439.dat: -------------------------------------------------------------------------------- 1 | function ReverseStrR(const S: string): string; 2 | begin 3 | if SysUtils.AnsiSameText(S, SysUtils.EmptyStr) or (System.Length(S) = 1) then 4 | Result := S 5 | else 6 | Result := StrUtils.RightStr(S, 1) 7 | + ReverseStrR(StrUtils.LeftStr(S, System.Length(S) - 1)) 8 | end; -------------------------------------------------------------------------------- /collection/505.dat: -------------------------------------------------------------------------------- 1 | function RemoveURIFragment(const URI: string): string; 2 | var 3 | FragmentStart: Integer; 4 | begin 5 | FragmentStart := SysUtils.AnsiPos('#', URI); 6 | if FragmentStart > 0 then 7 | Result := Copy(URI, 1, FragmentStart - 1) 8 | else 9 | Result := URI; 10 | end; -------------------------------------------------------------------------------- /collection/038.dat: -------------------------------------------------------------------------------- 1 | function GetCurrentVersionRegStr(const ValName: string): string; 2 | const 3 | cWdwCurrentVer = '\Software\Microsoft\Windows\CurrentVersion'; 4 | begin 5 | Result := GetRegistryString( 6 | Windows.HKEY_LOCAL_MACHINE, 7 | cWdwCurrentVer, 8 | ValName 9 | ); 10 | end; -------------------------------------------------------------------------------- /collection/339.dat: -------------------------------------------------------------------------------- 1 | function FormInstanceCount(const AFormClassName: string): Integer; overload; 2 | var 3 | I: Integer; // loops through all forms 4 | begin 5 | Result := 0; 6 | for I := 0 to Forms.Screen.FormCount - 1 do 7 | Inc(Result, Ord(Forms.Screen.Forms[I].ClassNameIs(AFormClassName))); 8 | end; -------------------------------------------------------------------------------- /collection/364.dat: -------------------------------------------------------------------------------- 1 | procedure AppendByteArray(var B1: TBytes; const B2: array of Byte); 2 | var 3 | OldB1Len: Integer; 4 | begin 5 | if Length(B2) = 0 then 6 | Exit; 7 | OldB1Len := Length(B1); 8 | SetLength(B1, OldB1Len + Length(B2)); 9 | Move(B2[0], B1[OldB1Len], Length(B2)); 10 | end; -------------------------------------------------------------------------------- /collection/621.dat: -------------------------------------------------------------------------------- 1 | procedure SimplifyFraction(var Num, Denom: Int64); 2 | var 3 | CommonFactor: Int64; // greatest common factor of Num and Denom 4 | begin 5 | Assert(Denom <> 0); 6 | CommonFactor := Abs(GCD(Num, Denom)); 7 | Num := Num div CommonFactor; 8 | Denom := Denom div CommonFactor; 9 | end; -------------------------------------------------------------------------------- /collection/630.dat: -------------------------------------------------------------------------------- 1 | function GetAvailablePhysMemory: Int64; 2 | var 3 | MemoryEx: Windows.TMemoryStatusEx; 4 | begin 5 | begin 6 | MemoryEx.dwLength := SizeOf(Windows.TMemoryStatusEx); 7 | Windows.GlobalMemoryStatusEx(MemoryEx); 8 | Result := MemoryEx.ullAvailPhys; 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/631.dat: -------------------------------------------------------------------------------- 1 | function GetPercentMemoryUsed: Byte; 2 | var 3 | MemoryEx: Windows.TMemoryStatusEx; 4 | begin 5 | begin 6 | MemoryEx.dwLength := SizeOf(Windows.TMemoryStatusEx); 7 | Windows.GlobalMemoryStatusEx(MemoryEx); 8 | Result := Byte(MemoryEx.dwMemoryLoad); 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/084.dat: -------------------------------------------------------------------------------- 1 | procedure WideStringToUnicodeStream(const Str: WideString; 2 | const Stm: Classes.TStream); 3 | var 4 | BOM: Word; // Unicode byte order mark 5 | begin 6 | BOM := $FEFF; 7 | Stm.WriteBuffer(BOM, SizeOf(BOM)); 8 | Stm.WriteBuffer(Pointer(Str)^, SizeOf(WideChar) * Length(Str)); 9 | end; -------------------------------------------------------------------------------- /collection/582.dat: -------------------------------------------------------------------------------- 1 | function WBInvokeCmd(WB: SHDocVw.TWebbrowser; InvokeIE: Boolean; 2 | CmdId, CmdExecOpt: Cardinal): Boolean; overload; 3 | var 4 | DummyInParam, DummyOutParam: OleVariant; 5 | begin 6 | Result := WBInvokeCmd( 7 | WB, InvokeIE, CmdId, CmdExecOpt, DummyInParam, DummyOutParam 8 | ); 9 | end; -------------------------------------------------------------------------------- /collection/050.dat: -------------------------------------------------------------------------------- 1 | function IsLockKeyOn(const KeyCode: Integer): Boolean; 2 | begin 3 | if not ( 4 | KeyCode in [Windows.VK_CAPITAL, Windows.VK_NUMLOCK, Windows.VK_SCROLL] 5 | ) then 6 | raise SysUtils.Exception.Create('Invalid lock key specified.'); 7 | Result := Odd(Windows.GetKeyState(KeyCode)); 8 | end; -------------------------------------------------------------------------------- /collection/153.dat: -------------------------------------------------------------------------------- 1 | function TryStrToWord(const S: string; out W: Word): Boolean; 2 | var 3 | Value: Integer; // receives integer value of conversion 4 | begin 5 | Result := SysUtils.TryStrToInt(S, Value) 6 | and (SysUtils.LongRec(Value).Hi = 0); 7 | if Result then 8 | W := SysUtils.LongRec(Value).Lo; 9 | end; -------------------------------------------------------------------------------- /collection/162.dat: -------------------------------------------------------------------------------- 1 | function AddThousandSeparator(const S: string; const C: Char): string; 2 | var 3 | I: Integer; // loops through separator position 4 | begin 5 | Result := S; 6 | I := Length(S) - 2; 7 | while I > 1 do 8 | begin 9 | Insert(C, Result, I); 10 | I := I - 3; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/342.dat: -------------------------------------------------------------------------------- 1 | function IsTrueTypeFont(const FontName: string): Boolean; overload; 2 | var 3 | Font: Graphics.TFont; 4 | begin 5 | Font := Graphics.TFont.Create; 6 | try 7 | Font.Name := FontName; 8 | Result := IsTrueTypeFont(Font); 9 | finally 10 | Font.Free; 11 | end; 12 | end; 13 | -------------------------------------------------------------------------------- /collection/482.dat: -------------------------------------------------------------------------------- 1 | function IndexOfByte(const B: Byte; const A: array of Byte): Integer; 2 | var 3 | I: Integer; 4 | begin 5 | Result := -1; 6 | for I := 0 to Pred(Length(A)) do 7 | begin 8 | if A[I] = B then 9 | begin 10 | Result := I; 11 | Exit; 12 | end; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/534.dat: -------------------------------------------------------------------------------- 1 | procedure FreeStringsObjects(const Strings: Classes.TStrings); 2 | var 3 | Idx: Integer; 4 | Temp: TObject; 5 | begin 6 | for Idx := 0 to Pred(Strings.Count) do 7 | begin 8 | Temp := Strings.Objects[Idx]; 9 | Strings.Objects[Idx] := nil; 10 | Temp.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/612.dat: -------------------------------------------------------------------------------- 1 | function InString(Haystack, Needle: string; IgnoreCase: Boolean): Boolean; 2 | begin 3 | if IgnoreCase then 4 | begin 5 | Needle := SysUtils.AnsiLowerCase(Needle); 6 | Haystack := SysUtils.AnsiLowerCase(Haystack); 7 | end; 8 | Result := SysUtils.AnsiPos(Needle, Haystack) > 0; 9 | end; -------------------------------------------------------------------------------- /collection/650.dat: -------------------------------------------------------------------------------- 1 | function ArithmeticMean(const A: array of Double): Double; overload; 2 | var 3 | X: Double; 4 | begin 5 | if Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for X in A do 9 | Result := Result + X / Length(A); 10 | end; -------------------------------------------------------------------------------- /collection/651.dat: -------------------------------------------------------------------------------- 1 | function ArithmeticMean(const A: array of Integer): Double; overload; 2 | var 3 | X: Integer; 4 | begin 5 | if Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for X in A do 9 | Result := Result + X / Length(A); 10 | end; -------------------------------------------------------------------------------- /collection/652.dat: -------------------------------------------------------------------------------- 1 | function ArithmeticMean(const A: array of Cardinal): Double; overload; 2 | var 3 | X: Cardinal; 4 | begin 5 | if Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for X in A do 9 | Result := Result + X / Length(A); 10 | end; -------------------------------------------------------------------------------- /collection/183.dat: -------------------------------------------------------------------------------- 1 | function CountUnquotedWords(const S: string; const AQuote: Char = '"'): Integer; 2 | begin 3 | with Classes.TStringList.Create do 4 | try 5 | QuoteChar := AQuote; 6 | Delimiter := ' '; 7 | DelimitedText := S; 8 | Result := Count; 9 | finally 10 | Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/281.dat: -------------------------------------------------------------------------------- 1 | function CloneCursorAsBitmap(const Cursor: Controls.TCursor; 2 | const PixelFmt: Graphics.TPixelFormat; 3 | const TransparentColor: Graphics.TColor): Graphics.TBitmap; 4 | begin 5 | Result := CloneCursorHandleAsBitmap( 6 | Forms.Screen.Cursors[Cursor], PixelFmt, TransparentColor 7 | ); 8 | end; -------------------------------------------------------------------------------- /collection/305.dat: -------------------------------------------------------------------------------- 1 | function DeleteWordByIndex(const N: Integer; var Str: string; 2 | const Delims: TCharSet): Boolean; 3 | var 4 | St, En: Integer; // start and end of string to delete 5 | begin 6 | Result := GetStartAndEndWord(N, Str, Delims, St, En); 7 | if Result then 8 | Delete(Str, St, En - St + 1); 9 | end; -------------------------------------------------------------------------------- /collection/372.dat: -------------------------------------------------------------------------------- 1 | function IsSubClassOf(AnInstance: TObject; AClass: TClass): boolean; 2 | var 3 | ClassRef: TClass; 4 | begin 5 | ClassRef := AnInstance.ClassType; 6 | repeat 7 | Result := (ClassRef = AClass); 8 | ClassRef := ClassRef.ClassParent; 9 | until Result or not Assigned(ClassRef); 10 | end; -------------------------------------------------------------------------------- /collection/483.dat: -------------------------------------------------------------------------------- 1 | function LastIndexOfByte(const B: Byte; const A: array of Byte): Integer; 2 | var 3 | I: Integer; 4 | begin 5 | Result := -1; 6 | for I := Pred(Length(A)) downto 0 do 7 | begin 8 | if A[I] = B then 9 | begin 10 | Result := I; 11 | Exit; 12 | end; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/501.dat: -------------------------------------------------------------------------------- 1 | function GetDesktopFolder: string; 2 | resourcestring 3 | sErrorMsg = 'Could not find Desktop folder location.'; 4 | begin 5 | if not IsSpecialFolderSupported(ShlObj.CSIDL_DESKTOP) then 6 | raise SysUtils.Exception.Create(sErrorMsg); 7 | Result := SpecialFolderPath(ShlObj.CSIDL_DESKTOP) 8 | end; -------------------------------------------------------------------------------- /collection/673.dat: -------------------------------------------------------------------------------- 1 | function RangeOf(const A: array of Integer): Cardinal; overload; 2 | var 3 | MinValue, MaxValue: Integer; 4 | begin 5 | MinMaxOfArray(A, MinValue, MaxValue); // exception raised if A is empty 6 | // MaxValue >= MinValue is guaranteed => Result >= 0 7 | Result := Cardinal(MaxValue - MinValue); 8 | end; -------------------------------------------------------------------------------- /collection/052.dat: -------------------------------------------------------------------------------- 1 | procedure FreePIDL(PIDL: ShlObj.PItemIDList); 2 | var 3 | Malloc: ActiveX.IMalloc; // shell's allocator 4 | begin 5 | // Try to get shell allocator 6 | if Windows.Succeeded(ShlObj.SHGetMalloc(Malloc)) then 7 | // Use allocator to free PIDL: Malloc is freed by Delphi 8 | Malloc.Free(PIDL); 9 | end; -------------------------------------------------------------------------------- /collection/182.dat: -------------------------------------------------------------------------------- 1 | function CountWords(const Str: string): Integer; 2 | var 3 | Words: Classes.TStringList; // list of words in string 4 | begin 5 | Words := Classes.TStringList.Create; 6 | try 7 | ExplodeWords(Str, Words); 8 | Result := Words.Count; 9 | finally 10 | Words.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/229.dat: -------------------------------------------------------------------------------- 1 | function Is24HourTimeFormat: Boolean; 2 | var 3 | DefaultLCID: Windows.LCID; // thread's default locale 4 | begin 5 | DefaultLCID := Windows.GetThreadLocale; 6 | Result := 0 <> SysUtils.StrToIntDef( 7 | SysUtils.GetLocaleStr(DefaultLCID, Windows.LOCALE_ITIME, '0'), 8 | 0 9 | ); 10 | end; -------------------------------------------------------------------------------- /collection/310.dat: -------------------------------------------------------------------------------- 1 | function StripHexPrefix(const HexStr: string): string; 2 | begin 3 | if Pos('$', HexStr) = 1 then 4 | Result := Copy(HexStr, 2, Length(HexStr) - 1) 5 | else if Pos('0x', SysUtils.LowerCase(HexStr)) = 1 then 6 | Result := Copy(HexStr, 3, Length(HexStr) - 2) 7 | else 8 | Result := HexStr; 9 | end; -------------------------------------------------------------------------------- /collection/503.dat: -------------------------------------------------------------------------------- 1 | function ExtractURIFragment(const URI: string): string; 2 | var 3 | FragmentStart: Integer; 4 | begin 5 | FragmentStart := SysUtils.AnsiPos('#', URI); 6 | if FragmentStart > 0 then 7 | Result := Copy(URI, FragmentStart + 1, Length(URI) - FragmentStart) 8 | else 9 | Result := ''; 10 | end; -------------------------------------------------------------------------------- /collection/522.dat: -------------------------------------------------------------------------------- 1 | function IsUTF7Stream(const Stm: Classes.TStream): Boolean; 2 | begin 3 | Result := StreamHasWatermark(Stm, [$2B, $2F, $76, $38]) 4 | or StreamHasWatermark(Stm, [$2B, $2F, $76, $39]) 5 | or StreamHasWatermark(Stm, [$2B, $2F, $76, $2B]) 6 | or StreamHasWatermark(Stm, [$2B, $2F, $76, $2F]); 7 | end; -------------------------------------------------------------------------------- /collection/152.dat: -------------------------------------------------------------------------------- 1 | function TryStrToLongWord(const S: string; out LW: LongWord): Boolean; 2 | var 3 | Value: Int64; // receives 64 bit value of conversion 4 | begin 5 | Result := SysUtils.TryStrToInt64(S, Value) 6 | and (SysUtils.Int64Rec(Value).Hi = 0); 7 | if Result then 8 | LW := SysUtils.Int64Rec(Value).Lo; 9 | end; -------------------------------------------------------------------------------- /collection/171.dat: -------------------------------------------------------------------------------- 1 | function GetTopLevelWindow(const Wnd: Windows.HWND): Windows.HWND; 2 | begin 3 | if Windows.IsWindow(Wnd) then 4 | begin 5 | Result := Wnd; 6 | while not IsTopLevelWindow(Result) and (Result <> 0) do 7 | Result := Windows.GetParent(Result); 8 | end 9 | else 10 | Result := 0; 11 | end; -------------------------------------------------------------------------------- /collection/196.dat: -------------------------------------------------------------------------------- 1 | function TrimLeftChar(const S: string; const C: Char): string; 2 | var 3 | Idx: Integer; // index into string 4 | begin 5 | Idx := 1; 6 | while (Idx <= Length(S)) and (S[Idx] = C) do 7 | Inc(Idx); 8 | if Idx > 1 then 9 | Result := Copy(S, Idx, MaxInt) 10 | else 11 | Result := S; 12 | end; -------------------------------------------------------------------------------- /collection/259.dat: -------------------------------------------------------------------------------- 1 | function IsHugeFile(const FileName: string): Boolean; 2 | var 3 | Size64: Int64; // file size 4 | const 5 | c2Gb: Int64 = 2147483648; // 2Gb in bytes 6 | begin 7 | Size64 := SizeOfFile64(FileName); 8 | if Size64 = -1 then 9 | Result := False 10 | else 11 | Result := Size64 >= c2Gb; 12 | end; -------------------------------------------------------------------------------- /collection/359.dat: -------------------------------------------------------------------------------- 1 | function BytesToAnsiString(const Bytes: SysUtils.TBytes; const CodePage: Word): 2 | RawByteString; 3 | begin 4 | SetLength(Result, Length(Bytes)); 5 | if Length(Bytes) > 0 then 6 | begin 7 | Move(Bytes[0], Result[1], Length(Bytes)); 8 | SetCodePage(Result, CodePage, False); 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/053.dat: -------------------------------------------------------------------------------- 1 | function PIDLToFolderPath(PIDL: ShlObj.PItemIDList): string; 2 | begin 3 | // Set max length of return string 4 | SetLength(Result, Windows.MAX_PATH); 5 | // Get the path 6 | if ShlObj.SHGetPathFromIDList(PIDL, PChar(Result)) then 7 | Result := PChar(Result) 8 | else 9 | Result := ''; 10 | end; -------------------------------------------------------------------------------- /collection/197.dat: -------------------------------------------------------------------------------- 1 | function TrimRightChar(const S: string; const C: Char): string; 2 | var 3 | Idx: Integer; // index into string 4 | begin 5 | Idx := Length(S); 6 | while (Idx >= 1) and (S[Idx] = C) do 7 | Dec(Idx); 8 | if Idx < Length(S) then 9 | Result := Copy(S, 1, Idx) 10 | else 11 | Result := S; 12 | end; -------------------------------------------------------------------------------- /collection/283.dat: -------------------------------------------------------------------------------- 1 | procedure DisableLayersSupport(const HWnd: Windows.HWND); 2 | const 3 | WS_EX_LAYERED = $00080000; // layered window style 4 | begin 5 | Windows.SetWindowLong( 6 | HWnd, 7 | Windows.GWL_EXSTYLE, 8 | Windows.GetWindowLong(HWnd, Windows.GWL_EXSTYLE) 9 | and not WS_EX_LAYERED 10 | ); 11 | end; -------------------------------------------------------------------------------- /collection/387.dat: -------------------------------------------------------------------------------- 1 | const 2 | AINulBrightness = 0; // "no change" brightness value 3 | AINulContrast = 0; // "no change" contrast value 4 | AINulTint = 0; // "no change" tint value 5 | AINulSaturation = 0; // "no change" saturation value 6 | AINulGamma = 10000; // "no change" gamma value -------------------------------------------------------------------------------- /collection/499.dat: -------------------------------------------------------------------------------- 1 | function AllDigitsSame(N: Int64): Boolean; 2 | var 3 | D: 0..9; // sample digit from N 4 | begin 5 | N := Abs(N); 6 | D := N mod 10; 7 | Result := False; 8 | while N > 0 do 9 | begin 10 | if N mod 10 <> D then 11 | Exit; 12 | N := N div 10; 13 | end; 14 | Result := True; 15 | end; -------------------------------------------------------------------------------- /collection/306.dat: -------------------------------------------------------------------------------- 1 | function GetWordByIndex(const N: Integer; const Str: string; 2 | const Delims: TCharSet): string; 3 | var 4 | St, En: Integer; // start and end of string to find 5 | begin 6 | if GetStartAndEndWord(N, Str, Delims, St, En) then 7 | Result := Copy(Str, St, En - St + 1) 8 | else 9 | Result := ''; 10 | end; -------------------------------------------------------------------------------- /collection/528.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16File(const FileName: string): Boolean; 2 | var 3 | Stm: Classes.TStream; 4 | begin 5 | Stm := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUTF16Stream(Stm); 10 | finally 11 | Stm.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/529.dat: -------------------------------------------------------------------------------- 1 | function IsUTF7File(const FileName: string): Boolean; 2 | var 3 | Stm: Classes.TStream; 4 | begin 5 | Stm := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUTF7Stream(Stm); 10 | finally 11 | Stm.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/530.dat: -------------------------------------------------------------------------------- 1 | function IsUTF8File(const FileName: string): Boolean; 2 | var 3 | Stm: Classes.TStream; 4 | begin 5 | Stm := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUTF8Stream(Stm); 10 | finally 11 | Stm.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/567.dat: -------------------------------------------------------------------------------- 1 | function EnglishColorName(AColor: Graphics.TColor; 2 | const AConvertSysColors: Boolean = False): string; 3 | begin 4 | if AConvertSysColors then 5 | AColor := ColorToRGB(AColor); 6 | Result := Graphics.ColorToString(AColor); 7 | if StrUtils.AnsiStartsText('cl', Result) then 8 | Delete(Result, 1, 2); 9 | end; -------------------------------------------------------------------------------- /collection/069.dat: -------------------------------------------------------------------------------- 1 | function DriveDisplayName(const Drive: string): string; 2 | var 3 | FI: ShellAPI.TSHFileInfo; // info about drive 4 | begin 5 | if ShellAPI.SHGetFileInfo( 6 | PChar(Drive), 0, FI, SizeOf(FI), ShellAPI.SHGFI_DISPLAYNAME 7 | ) = 0 then 8 | SysUtils.RaiseLastOSError; 9 | Result := FI.szDisplayName; 10 | end; -------------------------------------------------------------------------------- /collection/323.dat: -------------------------------------------------------------------------------- 1 | procedure HexToBuf(HexStr: string; var Buf); 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sHexConvertError = '''%s'' is not a valid hexadecimal string'; 8 | begin 9 | if not TryHexToBuf(HexStr, Buf) then 10 | raise SysUtils.EConvertError.CreateFmt(sHexConvertError, [HexStr]); 11 | end; -------------------------------------------------------------------------------- /collection/331.dat: -------------------------------------------------------------------------------- 1 | function ProgIDInstalled(const PID: string): Boolean; 2 | var 3 | WPID: WideString; // PID as wide string 4 | Dummy: TGUID; // unused out value from CLSIDFromProgID function 5 | begin 6 | WPID := PID; 7 | Result := ActiveX.Succeeded( 8 | ActiveX.CLSIDFromProgID(PWideChar(WPID), Dummy) 9 | ); 10 | end; -------------------------------------------------------------------------------- /collection/383.dat: -------------------------------------------------------------------------------- 1 | function ScaleRect(const ARect: Types.TRect; AScaling: Double): Types.TRect; 2 | begin 3 | Result.Left := System.Round(ARect.Left * AScaling); 4 | Result.Top := System.Round(ARect.Top * AScaling); 5 | Result.Right := System.Round(ARect.Right * AScaling); 6 | Result.Bottom := System.Round(ARect.Bottom * AScaling); 7 | end; -------------------------------------------------------------------------------- /collection/391.dat: -------------------------------------------------------------------------------- 1 | procedure RegParsePath(const APath: string; out ASubKey, AValueName: string); 2 | begin 3 | ASubKey := APath; 4 | AValueName := ''; 5 | while (Length(ASubKey) > 0) and (LastChar(ASubKey) <> '\') do 6 | begin 7 | AValueName := LastChar(ASubKey) + AValueName; 8 | StripLastChar(ASubKey); 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/526.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16BEFile(const FileName: string): Boolean; 2 | var 3 | Stm: Classes.TStream; 4 | begin 5 | Stm := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUTF16BEStream(Stm); 10 | finally 11 | Stm.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/527.dat: -------------------------------------------------------------------------------- 1 | function IsUTF16LEFile(const FileName: string): Boolean; 2 | var 3 | Stm: Classes.TStream; 4 | begin 5 | Stm := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUTF16LEStream(Stm); 10 | finally 11 | Stm.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/202.dat: -------------------------------------------------------------------------------- 1 | function DigitCount(AInteger: Int64): Integer; 2 | begin 3 | if AInteger <> 0 then 4 | begin 5 | Result := 0; 6 | AInteger := Abs(AInteger); 7 | while AInteger > 0 do 8 | begin 9 | AInteger := AInteger div 10; 10 | Inc(Result); 11 | end; 12 | end 13 | else 14 | Result := 1; 15 | end; -------------------------------------------------------------------------------- /collection/324.dat: -------------------------------------------------------------------------------- 1 | function HexToBytes(HexStr: string): TBytes; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sHexConvertError = '''%s'' is not a valid hexadecimal string'; 8 | begin 9 | if not TryHexToBytes(HexStr, Result) then 10 | raise SysUtils.EConvertError.CreateFmt(sHexConvertError, [HexStr]); 11 | end; -------------------------------------------------------------------------------- /collection/325.dat: -------------------------------------------------------------------------------- 1 | function HexToInt(const HexStr: string): Integer; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sHexConvertError = '''%s'' is not a valid hexadecimal value'; 8 | begin 9 | if not TryHexToInt(HexStr, Result) then 10 | raise SysUtils.EConvertError.CreateFmt(sHexConvertError, [HexStr]); 11 | end; -------------------------------------------------------------------------------- /collection/349.dat: -------------------------------------------------------------------------------- 1 | function ChangeChar(const AString: string; ASearch, AReplace: Char): string; 2 | var 3 | I: integer; // loops thru all chars of string 4 | begin 5 | Result := AString; 6 | if Result = '' then 7 | Exit; 8 | for I := 1 to Length(Result) do 9 | if Result[I] = ASearch then 10 | Result[I] := AReplace; 11 | end; -------------------------------------------------------------------------------- /collection/497.dat: -------------------------------------------------------------------------------- 1 | function RepeatedDigits(N: Int64): Boolean; 2 | begin 3 | N := Abs(N); 4 | if N > 0 then 5 | Result := 6 | N = SysUtils.StrToInt64( 7 | StringOfChar( 8 | Char(48 + N mod 10), 9 | Succ(Math.Floor(Math.Log10(N))) 10 | ) 11 | ) 12 | else 13 | Result := True; 14 | end; -------------------------------------------------------------------------------- /collection/230.dat: -------------------------------------------------------------------------------- 1 | function IsDaylightSaving: Boolean; 2 | var 3 | Dummy: Windows.TTimeZoneInformation; // info about time zone 4 | begin 5 | Result := False; 6 | case Windows.GetTimeZoneInformation(Dummy) of 7 | Windows.TIME_ZONE_ID_INVALID: SysUtils.RaiseLastOSError; 8 | Windows.TIME_ZONE_ID_DAYLIGHT: Result := True; 9 | end; 10 | end; -------------------------------------------------------------------------------- /collection/294.dat: -------------------------------------------------------------------------------- 1 | function SizeOfFile2(const AFilename: string): Integer; 2 | var 3 | SRec: SysUtils.TSearchRec; 4 | begin 5 | Result := 0; 6 | if SysUtils.FindFirst( 7 | AFilename, SysUtils.faAnyFile and not SysUtils.faDirectory, SRec) = 0 then 8 | begin 9 | Result := SRec.Size; 10 | SysUtils.FindClose(SRec); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/326.dat: -------------------------------------------------------------------------------- 1 | function HexToInt64(const HexStr: string): Int64; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sHexConvertError = '''%s'' is not a valid hexadecimal value'; 8 | begin 9 | if not TryHexToInt64(HexStr, Result) then 10 | raise SysUtils.EConvertError.CreateFmt(sHexConvertError, [HexStr]); 11 | end; -------------------------------------------------------------------------------- /collection/386.dat: -------------------------------------------------------------------------------- 1 | type 2 | TAIBrightness = -100..100; // range of valid brightness values 3 | TAIContrast = -100..100; // range of valid constrast values 4 | TAITint = -100..100; // range of valid tint values 5 | TAISaturation = -100..100; // range of valid saturation values 6 | TAIGamma = 2500..65000; // range of valid gamma values -------------------------------------------------------------------------------- /collection/480.dat: -------------------------------------------------------------------------------- 1 | function DelText(const Needle, Haystack: string): string; 2 | var 3 | StartIdx: Integer; 4 | begin 5 | Result := Haystack; 6 | StartIdx := SysUtils.AnsiPos( 7 | SysUtils.AnsiLowerCase(Needle), SysUtils.AnsiLowerCase(Haystack) 8 | ); 9 | if StartIdx > 0 then 10 | Delete(Result, StartIdx, Length(Needle)); 11 | end; -------------------------------------------------------------------------------- /collection/570.dat: -------------------------------------------------------------------------------- 1 | function IsPrime2(Val: Integer): Boolean; 2 | var 3 | X: Integer; // index 4 | begin 5 | Result := (Val > 1); 6 | if Result then 7 | begin 8 | for X := (Val div 2) downto 2 do 9 | begin 10 | Result := Result and ((Val mod X) <> 0); 11 | if not Result then 12 | Break; 13 | end; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/079.dat: -------------------------------------------------------------------------------- 1 | procedure StringToFile(const Str, FileName: string); 2 | var 3 | FS: Classes.TFileStream; // stream used to write file 4 | begin 5 | FS := Classes.TFileStream.Create(FileName, Classes.fmCreate); 6 | try 7 | StringToStream(Str, FS); // uses default ANSI encoding for output 8 | finally 9 | FS.Free; 10 | end; 11 | end; -------------------------------------------------------------------------------- /collection/164.dat: -------------------------------------------------------------------------------- 1 | function GetDriveNumber(const Drive: string): Integer; 2 | var 3 | DriveLetter: Char; // drive letter 4 | begin 5 | Result := -1; 6 | if Drive <> '' then 7 | begin 8 | DriveLetter := UpCase(Drive[1]); 9 | if IsCharInSet(DriveLetter, ['A'..'Z']) then 10 | Result := Ord(DriveLetter) - Ord('A'); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/509.dat: -------------------------------------------------------------------------------- 1 | function ScreenResolution: Types.TSize; 2 | var 3 | DC: Windows.HDC; 4 | begin 5 | DC := Windows.GetDC(Windows.HWND_DESKTOP); 6 | try 7 | Result.cx := Windows.GetDeviceCaps(DC, Windows.HORZRES); 8 | Result.cy := Windows.GetDeviceCaps(DC, Windows.VERTRES); 9 | finally 10 | Windows.ReleaseDC(0, DC); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/560.dat: -------------------------------------------------------------------------------- 1 | function SAR(Value: LongInt; Shift: Byte): LongInt; 2 | begin 3 | Shift := Shift and 31; 4 | if Shift = 0 then 5 | begin 6 | Result := Value; 7 | Exit; 8 | end; 9 | Result := LongInt(LongWord(Value) shr Shift); 10 | if Value < 0 then 11 | Result := LongInt(LongWord(Result) or ($FFFFFFFF shl (32 - Shift))); 12 | end; -------------------------------------------------------------------------------- /collection/704.dat: -------------------------------------------------------------------------------- 1 | function TSS(const A: array of Double): Double; overload; 2 | var 3 | ElemOfA: Double; 4 | MeanOfA: Double; 5 | begin 6 | // Note: ArithmeticMean raises an exception if A is empty 7 | MeanOfA := ArithmeticMean(A); 8 | Result := 0.0; 9 | for ElemOfA in A do 10 | Result := Result + System.Sqr(ElemOfA - MeanOfA); 11 | end; -------------------------------------------------------------------------------- /collection/705.dat: -------------------------------------------------------------------------------- 1 | function TSS(const A: array of Integer): Double; overload; 2 | var 3 | ElemOfA: Double; 4 | MeanOfA: Double; 5 | begin 6 | // Note: ArithmeticMean raises an exception if A is empty 7 | MeanOfA := ArithmeticMean(A); 8 | Result := 0.0; 9 | for ElemOfA in A do 10 | Result := Result + System.Sqr(ElemOfA - MeanOfA); 11 | end; -------------------------------------------------------------------------------- /collection/060.dat: -------------------------------------------------------------------------------- 1 | function ColorToHTML(const Color: Graphics.TColor): string; 2 | var 3 | ColorRGB: Integer; 4 | begin 5 | ColorRGB := Graphics.ColorToRGB(Color); 6 | Result := SysUtils.Format( 7 | '#%0.2X%0.2X%0.2X', 8 | [Windows.GetRValue(ColorRGB), 9 | Windows.GetGValue(ColorRGB), 10 | Windows.GetBValue(ColorRGB)] 11 | ); 12 | end; -------------------------------------------------------------------------------- /collection/087.dat: -------------------------------------------------------------------------------- 1 | function IsShellLink(const LinkFileName: string): Boolean; 2 | begin 3 | // Ensure COM is initialized 4 | ActiveX.CoInitialize(nil); 5 | try 6 | // Valid shell link if we can load it 7 | Result := Assigned(LoadShellLink(LinkFileName)); 8 | finally 9 | // Finalize COM 10 | ActiveX.CoUninitialize; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/252.dat: -------------------------------------------------------------------------------- 1 | function FloatToFixed(const Value: Extended; const DecimalPlaces: Byte; 2 | const SeparateThousands: Boolean): string; 3 | const 4 | // float format specifiers 5 | cFmtSpec: array[Boolean] of Char = ('f', 'n'); 6 | begin 7 | Result := SysUtils.Format( 8 | '%.*' + cFmtSpec[SeparateThousands], [DecimalPlaces, Value] 9 | ); 10 | end; -------------------------------------------------------------------------------- /collection/258.dat: -------------------------------------------------------------------------------- 1 | function SizeOfFile(const FileName: string): Windows.DWORD; 2 | var 3 | FH: THandle; // file handle 4 | begin 5 | FH := SysUtils.FileOpen( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := Windows.GetFileSize(FH, nil); 10 | finally 11 | SysUtils.FileClose(FH); 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/690.dat: -------------------------------------------------------------------------------- 1 | function LogarithmicMean(const X, Y: Double): Double; 2 | begin 3 | if (X <= 0) or (Y <= 0) then 4 | raise SysUtils.EArgumentException.Create( 5 | 'Parameters X & Y must both be positive' 6 | ); 7 | if Math.SameValue(X, Y) then 8 | Result := X 9 | else 10 | Result := (Y - X) / (System.Ln(Y) - System.Ln(X)); 11 | end; -------------------------------------------------------------------------------- /collection/083.dat: -------------------------------------------------------------------------------- 1 | procedure WideStringToUnicodeFile(const Str: WideString; 2 | const FileName: string); 3 | var 4 | FS: Classes.TFileStream; // Stream onto file being created 5 | begin 6 | FS := Classes.TFileStream.Create(FileName, Classes.fmCreate); 7 | try 8 | WideStringToUnicodeStream(Str, FS); 9 | finally 10 | FS.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/151.dat: -------------------------------------------------------------------------------- 1 | function IsVista: Boolean; 2 | var 3 | PFunction: Pointer; // pointer to GetProductInfo function if exists 4 | begin 5 | // Try to load GetProductInfo from Kernel32: present if Vista 6 | PFunction := Windows.GetProcAddress( 7 | Windows.GetModuleHandle('kernel32.dll'), 'GetProductInfo' 8 | ); 9 | Result := Assigned(PFunction); 10 | end; -------------------------------------------------------------------------------- /collection/238.dat: -------------------------------------------------------------------------------- 1 | function ContainsDelims(const S, Delimiters: string): Boolean; 2 | var 3 | DelimIdx: Integer; // loops thru delimiters 4 | begin 5 | Result := False; 6 | for DelimIdx := 1 to Length(Delimiters) do 7 | if SysUtils.AnsiPos(Delimiters[DelimIdx], S) > 0 then 8 | begin 9 | Result := True; 10 | Break; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/304.dat: -------------------------------------------------------------------------------- 1 | function CutWordByIndex(const N: Integer; var Str: string; 2 | const Delims: TCharSet): string; 3 | var 4 | St, En: Integer; // start and end of string to cut 5 | begin 6 | if GetStartAndEndWord(N, Str, Delims, St, En) then 7 | begin 8 | Result := Copy(Str, St, En - St + 1); 9 | Delete(Str, St, En - St + 1); 10 | end; 11 | end; -------------------------------------------------------------------------------- /collection/415.dat: -------------------------------------------------------------------------------- 1 | function DateQuarterStart(const D: TDateTime): TDateTime; 2 | var 3 | Year, Month, Day, Quarter: Word; 4 | begin 5 | SysUtils.DecodeDate(D, Year, Month, Day); 6 | Quarter := 4 - ((12 - Month) div 3); 7 | Month := 0; 8 | SysUtils.IncAMonth(Year, Month, Day, (Quarter * 3) - 2); 9 | Result := SysUtils.EncodeDate(Year, Month, 1); 10 | end; -------------------------------------------------------------------------------- /collection/477.dat: -------------------------------------------------------------------------------- 1 | function DelAllStr(const Needle, Haystack: string): string; 2 | var 3 | StartIdx: Integer; 4 | begin 5 | Result := Haystack; 6 | StartIdx := SysUtils.AnsiPos(Needle, Result); 7 | while StartIdx > 0 do 8 | begin 9 | Delete(Result, StartIdx, Length(Needle)); 10 | StartIdx := SysUtils.AnsiPos(Needle, Result); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/692.dat: -------------------------------------------------------------------------------- 1 | function PowerMean(const A: array of Integer; const Lambda: Double): Double; 2 | overload; 3 | var 4 | Floats: Types.TDoubleDynArray; 5 | Idx: Integer; 6 | begin 7 | System.SetLength(Floats, System.Length(A)); 8 | for Idx := 0 to Pred(System.Length(A)) do 9 | Floats[Idx] := A[Idx]; 10 | Result := PowerMean(Floats, Lambda); 11 | end; -------------------------------------------------------------------------------- /collection/693.dat: -------------------------------------------------------------------------------- 1 | function PowerMean(const A: array of Cardinal; const Lambda: Double): Double; 2 | overload; 3 | var 4 | Floats: Types.TDoubleDynArray; 5 | Idx: Integer; 6 | begin 7 | System.SetLength(Floats, System.Length(A)); 8 | for Idx := 0 to Pred(System.Length(A)) do 9 | Floats[Idx] := A[Idx]; 10 | Result := PowerMean(Floats, Lambda); 11 | end; -------------------------------------------------------------------------------- /collection/194.dat: -------------------------------------------------------------------------------- 1 | function LastPos(const SubStr, Str: string): Integer; 2 | var 3 | Idx: Integer; // an index of SubStr in Str 4 | begin 5 | Result := 0; 6 | Idx := StrUtils.PosEx(SubStr, Str); 7 | if Idx = 0 then 8 | Exit; 9 | while Idx > 0 do 10 | begin 11 | Result := Idx; 12 | Idx := StrUtils.PosEx(SubStr, Str, Idx + 1); 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/284.dat: -------------------------------------------------------------------------------- 1 | function EnableLayersSupport(const HWnd: Windows.HWND): Boolean; 2 | const 3 | WS_EX_LAYERED = $00080000; // layered window style 4 | begin 5 | Windows.SetWindowLong( 6 | HWnd, 7 | Windows.GWL_EXSTYLE, 8 | Windows.GetWindowLong(HWnd, Windows.GWL_EXSTYLE) or WS_EX_LAYERED 9 | ); 10 | Result := WindowSupportsLayers(HWnd); 11 | end; -------------------------------------------------------------------------------- /collection/615.dat: -------------------------------------------------------------------------------- 1 | function DOSCommandRedirect(const CommandLine, OutFile: string): Boolean; 2 | overload; 3 | var 4 | FileStream: Classes.TFileStream; 5 | begin 6 | FileStream := Classes.TFileStream.Create(OutFile, Classes.fmCreate); 7 | try 8 | Result := DOSCommandRedirect(CommandLine, FileStream); 9 | finally 10 | FileStream.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/617.dat: -------------------------------------------------------------------------------- 1 | function StripDuplicateStrings(const SA: array of string): 2 | Types.TStringDynArray; 3 | var 4 | SL: Classes.TStringList; 5 | begin 6 | SL := Classes.TStringList.Create; 7 | try 8 | ArrayToStringList(SA, SL); 9 | RemoveDuplicateStrings(SL); 10 | Result := StringListToArray(SL); 11 | finally 12 | SL.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/664.dat: -------------------------------------------------------------------------------- 1 | function SoftMax(const A: array of Double): Types.TDoubleDynArray; 2 | var 3 | LSEOfA: Double; 4 | Idx: Integer; 5 | begin 6 | LSEOfA := LSE(A); // raise EArgumentException if A is empty 7 | System.SetLength(Result, System.Length(A)); 8 | for Idx := 0 to Pred(System.Length(A)) do 9 | Result[Idx] := System.Exp(A[Idx] - LSEOfA); 10 | end; -------------------------------------------------------------------------------- /collection/027.dat: -------------------------------------------------------------------------------- 1 | function DownloadURLToFile(const URL, FileName: string): Boolean; 2 | begin 3 | // URLDownloadFile returns true if URL exists even if file not created 4 | // hence we also check file has been created. 5 | Result := Windows.Succeeded( 6 | UrlMon.URLDownloadToFile(nil, PChar(URL), PChar(FileName), 0, nil) 7 | ) and SysUtils.FileExists(FileName); 8 | end; -------------------------------------------------------------------------------- /collection/076.dat: -------------------------------------------------------------------------------- 1 | function IsUnicodeFile(const FileName: string): Boolean; 2 | var 3 | FS: Classes.TFileStream; // stream onto file being tested 4 | begin 5 | FS := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := IsUnicodeStream(FS); 10 | finally 11 | FS.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/081.dat: -------------------------------------------------------------------------------- 1 | function UnicodeFileToWideString(const FileName: string): WideString; 2 | var 3 | FS: Classes.TFileStream; // Stream onto file 4 | begin 5 | FS := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone); 7 | try 8 | Result := UnicodeStreamToWideString(FS); 9 | finally 10 | FS.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/112.dat: -------------------------------------------------------------------------------- 1 | procedure ExtractRGB(const Color: Graphics.TColor; out Red, Green, Blue: Byte); 2 | var 3 | RGB: Windows.TColorRef; // RGB equivalent of given Colour 4 | begin 5 | RGB := Graphics.ColorToRGB(Color); // ensures system Colours are converted 6 | Red := Windows.GetRValue(RGB); 7 | Green := Windows.GetGValue(RGB); 8 | Blue := Windows.GetBValue(RGB); 9 | end; -------------------------------------------------------------------------------- /collection/113.dat: -------------------------------------------------------------------------------- 1 | function GetIconHotspot(const Icon: Graphics.TIcon): Windows.TPoint; 2 | var 3 | IconInfo: Windows.TIconInfo; // receives info about icon 4 | begin 5 | if not Windows.GetIconInfo(Icon.Handle, IconInfo) then 6 | raise SysUtils.Exception.Create('Can''t get icon information'); 7 | Result.X := IconInfo.xHotspot; 8 | Result.Y := IconInfo.yHotspot; 9 | end; -------------------------------------------------------------------------------- /collection/247.dat: -------------------------------------------------------------------------------- 1 | function PadLeft(const AString: string; const AChar: Char; 2 | const ALen: Integer): string; 3 | var 4 | PadLength: Integer; // number of padding characters required 5 | begin 6 | Result := AString; 7 | PadLength := ALen - Length(AString); 8 | if PadLength < 1 then 9 | Exit; 10 | Result := AString + StringOfChar(AChar, PadLength); 11 | end; -------------------------------------------------------------------------------- /collection/248.dat: -------------------------------------------------------------------------------- 1 | function PadRight(const AString: string; const AChar: Char; 2 | const ALen: Integer): string; 3 | var 4 | PadLength: Integer; // number of padding characters required 5 | begin 6 | Result := AString; 7 | PadLength := ALen - Length(AString); 8 | if PadLength < 1 then 9 | Exit; 10 | Result := StringOfChar(AChar, PadLength) + AString; 11 | end; -------------------------------------------------------------------------------- /collection/115.dat: -------------------------------------------------------------------------------- 1 | function IsColorIcon(const Icon: Graphics.TIcon): Boolean; 2 | var 3 | IconInfo: Windows.TIconInfo; // receives info about icon 4 | begin 5 | if not Windows.GetIconInfo(Icon.Handle, IconInfo) then 6 | raise SysUtils.Exception.Create('Can''t get icon information'); 7 | // colour icons have separate colour bitmap 8 | Result := IconInfo.hbmColor <> 0; 9 | end; -------------------------------------------------------------------------------- /collection/129.dat: -------------------------------------------------------------------------------- 1 | function ComputerName: string; 2 | var 3 | Buf: array[0..Windows.MAX_COMPUTERNAME_LENGTH] of Char; // for computer name 4 | BufSize: Windows.DWORD; // size of name buffer 5 | begin 6 | BufSize := SizeOf(Buf); 7 | if Windows.GetComputerName(Buf, BufSize) then 8 | Result := Buf 9 | else 10 | Result := ''; 11 | end; -------------------------------------------------------------------------------- /collection/672.dat: -------------------------------------------------------------------------------- 1 | function RangeOf(const A: array of Double): Double; overload; 2 | var 3 | MinValue, MaxValue: Double; 4 | begin 5 | MinMaxOfArray(A, MinValue, MaxValue); // exception raised if A is empty 6 | Result := MaxValue - MinValue; 7 | // Ensure that exactly zero is returned when MaxValue = MinValue 8 | if Math.IsZero(Result) then 9 | Result := 0.0; 10 | end; -------------------------------------------------------------------------------- /collection/362.dat: -------------------------------------------------------------------------------- 1 | function CodePageSupportsString(const S: UnicodeString; 2 | const CodePage: Word): Boolean; 3 | var 4 | Encoding: SysUtils.TEncoding; // Encoding for required code page 5 | begin 6 | Encoding := SysUtils.TMBCSEncoding.Create(CodePage); 7 | try 8 | Result := EncodingSupportsString(S, Encoding); 9 | finally 10 | Encoding.Free; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/385.dat: -------------------------------------------------------------------------------- 1 | procedure ScaleBitmap(ABitmap: Graphics.TBitmap; AScaling: Double); overload; 2 | var 3 | TempBmp: Graphics.TBitmap; 4 | begin 5 | TempBmp := Graphics.TBitmap.Create; 6 | try 7 | TempBmp.PixelFormat := Graphics.pf24Bit; 8 | ScaleBitmap(TempBmp, ABitmap, AScaling); 9 | ABitmap.Assign(TempBmp); 10 | finally 11 | TempBmp.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/620.dat: -------------------------------------------------------------------------------- 1 | function JPEGPixelFormatToPixelFormat(APixelFormat: JPEG.TJPEGPixelFormat): 2 | Graphics.TPixelFormat; 3 | begin 4 | case APixelFormat of 5 | JPEG.jf8bit: 6 | Result := Graphics.pf8bit; 7 | JPEG.jf24bit: 8 | Result := Graphics.pf24bit; 9 | else 10 | raise SysUtils.Exception.Create('Unexpected TJPEGPixelFormat value'); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/658.dat: -------------------------------------------------------------------------------- 1 | function DigitCountBase(N: Int64; const Base: Byte): Cardinal; 2 | begin 3 | if Base < 2 then 4 | raise SysUtils.EArgumentException.Create( 5 | 'Base must be in the range 2..255' 6 | ); 7 | if N = 0 then 8 | Exit(1); 9 | N := Abs(N); 10 | Result := 0; 11 | repeat 12 | Inc(Result); 13 | N := N div Base; 14 | until N = 0; 15 | end; -------------------------------------------------------------------------------- /collection/114.dat: -------------------------------------------------------------------------------- 1 | function IsCursorIcon(const Icon: Graphics.TIcon): Boolean; 2 | var 3 | IconInfo: Windows.TIconInfo; // receives info about icon 4 | begin 5 | if not Windows.GetIconInfo(Icon.Handle, IconInfo) then 6 | raise SysUtils.Exception.Create('Can''t get icon information'); 7 | // fIcon flag set to indicate a true icon, unset for cursor 8 | Result := not IconInfo.fIcon; 9 | end; -------------------------------------------------------------------------------- /collection/345.dat: -------------------------------------------------------------------------------- 1 | procedure SetVistaFont(const AFont: Graphics.TFont); 2 | const 3 | VistaFont = 'Segoe UI'; // name of main Vista font 4 | begin 5 | if (SysUtils.Win32MajorVersion >= 6) 6 | and not SysUtils.SameText(AFont.Name, VistaFont) 7 | and FontExists(VistaFont) then 8 | begin 9 | AFont.Size := AFont.Size + 1; 10 | AFont.Name := VistaFont; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/365.dat: -------------------------------------------------------------------------------- 1 | function ByteArraysEqual(const B1, B2: array of Byte): Boolean; 2 | var 3 | I: Integer; 4 | begin 5 | Result := Length(B1) = Length(B2); 6 | if Result then 7 | begin 8 | for I := 0 to High(B1) do 9 | begin 10 | if B1[I] <> B2[I] then 11 | begin 12 | Result := False; 13 | Exit; 14 | end; 15 | end; 16 | end; 17 | end; -------------------------------------------------------------------------------- /collection/075.dat: -------------------------------------------------------------------------------- 1 | function FileToString(const FileName: string): string; 2 | var 3 | FS: Classes.TFileStream; // stream used to read file 4 | begin 5 | FS := Classes.TFileStream.Create( 6 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 7 | ); 8 | try 9 | Result := StreamToString(FS); // uses default ANSI encoding 10 | finally 11 | FS.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/191.dat: -------------------------------------------------------------------------------- 1 | function UnixLineBreaks(const S: string): string; 2 | begin 3 | // Replace any CRLF (MSDOS/Windows) line ends with LF 4 | Result := SysUtils.StringReplace( 5 | S, #13#10, #10, [SysUtils.rfReplaceAll] 6 | ); 7 | // Replace any remaining CR (Mac) line ends with LF 8 | Result := SysUtils.StringReplace( 9 | Result, #13, #10, [SysUtils.rfReplaceAll] 10 | ); 11 | end; -------------------------------------------------------------------------------- /collection/255.dat: -------------------------------------------------------------------------------- 1 | function IntToOctal(Value: Integer; const Digits: Byte): string; 2 | const 3 | // Octal digit characters 4 | cOctalDigits: array[$0..$7] of Char = '01234567'; 5 | begin 6 | Result := ''; 7 | while Value <> 0 do 8 | begin 9 | Result := cOctalDigits[Value and 7] + Result; 10 | Value := Value shr 3; 11 | end; 12 | Result := PadRight(Result, '0', Digits); 13 | end; -------------------------------------------------------------------------------- /collection/344.dat: -------------------------------------------------------------------------------- 1 | procedure SetDesktopIconFont(const AFont: Graphics.TFont); 2 | var 3 | LogFont: Windows.TLogFont; // structure containing desktop icon font info 4 | begin 5 | if Windows.SystemParametersInfo( 6 | Windows.SPI_GETICONTITLELOGFONT, SizeOf(LogFont), @LogFont, 0) then 7 | AFont.Handle := Windows.CreateFontIndirect(LogFont) 8 | else 9 | SetDefaultFont(AFont); 10 | end; -------------------------------------------------------------------------------- /collection/537.dat: -------------------------------------------------------------------------------- 1 | function StrToken(var S: string; Separator: Char): string; 2 | var 3 | Idx: Cardinal; // index of Separator in S 4 | begin 5 | Idx := SysUtils.AnsiPos(Separator, S); 6 | if Idx > 0 then 7 | begin 8 | Result := System.Copy(S, 1, Idx - 1); 9 | System.Delete(S, 1, Idx); 10 | end 11 | else 12 | begin 13 | Result := S; 14 | S := ''; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/654.dat: -------------------------------------------------------------------------------- 1 | function WeightedArithmeticMean(const Values: array of Integer; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | DblVals: array of Double; 6 | begin 7 | SetLength(DblVals, Length(Values)); 8 | for Idx := Low(Values) to High(Values) do 9 | DblVals[Idx] := Values[Idx]; 10 | Result := WeightedArithmeticMean(DblVals, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/095.dat: -------------------------------------------------------------------------------- 1 | function GMTToLocalTime(GMTTime: TDateTime): TDateTime; 2 | var 3 | GMTST: Windows.TSystemTime; 4 | LocalST: Windows.TSystemTime; 5 | begin 6 | SysUtils.DateTimeToSystemTime(GMTTime, GMTST); 7 | SysUtils.Win32Check( 8 | Windows.SystemTimeToTzSpecificLocalTime( 9 | nil, GMTST, LocalST 10 | ) 11 | ); 12 | Result := SysUtils.SystemTimeToDateTime(LocalST); 13 | end; -------------------------------------------------------------------------------- /collection/130.dat: -------------------------------------------------------------------------------- 1 | function UserName: string; 2 | const 3 | UNLEN = 256; // max size of user name buffer (per MS SDK docs) 4 | var 5 | Buf: array[0..UNLEN] of Char; // buffer for user name 6 | BufSize: Windows.DWORD; // size of name buffer 7 | begin 8 | BufSize := SizeOf(Buf); 9 | if Windows.GetUserName(Buf, BufSize) then 10 | Result := Buf 11 | else 12 | Result := ''; 13 | end; -------------------------------------------------------------------------------- /collection/264.dat: -------------------------------------------------------------------------------- 1 | function CurrentMemoryUsage: Cardinal; 2 | var 3 | PMC: PsAPI.TProcessMemoryCounters; // receives info about process memory 4 | begin 5 | Result := 0; // default result on error or if not supported on OS 6 | PMC.cb := SizeOf(PMC); 7 | if PsAPI.GetProcessMemoryInfo( 8 | Windows.GetCurrentProcess, @PMC, SizeOf(PMC) 9 | ) then 10 | Result := PMC.WorkingSetSize; 11 | end; -------------------------------------------------------------------------------- /collection/308.dat: -------------------------------------------------------------------------------- 1 | function ReplaceWordByIndex(const N: Integer; const NewWord: string; 2 | var Str: string; const Delims: TCharSet): Boolean; 3 | var 4 | St, En: Integer; // start and end of word to change 5 | begin 6 | Result := GetStartAndEndWord(N, Str, Delims, St, En); 7 | if Result then 8 | begin 9 | Delete(Str, St, En - St + 1); 10 | Insert(NewWord, Str, St); 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/624.dat: -------------------------------------------------------------------------------- 1 | function IntToBinary(Value: Integer; const Digits: Byte): string; overload; 2 | const 3 | // Binary digit characters 4 | BinaryDigits: array[0..1] of Char = '01'; 5 | begin 6 | Result := ''; 7 | while Value <> 0 do 8 | begin 9 | Result := BinaryDigits[Value and 1] + Result; 10 | Value := Value shr 1; 11 | end; 12 | Result := PadRight(Result, '0', Digits); 13 | end; -------------------------------------------------------------------------------- /collection/655.dat: -------------------------------------------------------------------------------- 1 | function WeightedArithmeticMean(const Values: array of Cardinal; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | DblVals: array of Double; 6 | begin 7 | SetLength(DblVals, Length(Values)); 8 | for Idx := Low(Values) to High(Values) do 9 | DblVals[Idx] := Values[Idx]; 10 | Result := WeightedArithmeticMean(DblVals, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/392.dat: -------------------------------------------------------------------------------- 1 | procedure RegKeyList(const ARootKey: Windows.HKEY; const ASubKey: string; 2 | const AKeyList: Classes.TStrings); 3 | begin 4 | with Registry.TRegistry.Create do 5 | try 6 | RootKey := ARootKey; 7 | if OpenKeyReadOnly(ASubKey) then 8 | GetKeyNames(AKeyList) 9 | else 10 | AKeyList.Clear; 11 | finally 12 | Free; 13 | end; 14 | end; 15 | -------------------------------------------------------------------------------- /collection/393.dat: -------------------------------------------------------------------------------- 1 | procedure RegValueList(const ARootKey: Windows.HKEY; const ASubKey: string; 2 | const AValueList: Classes.TStrings); 3 | begin 4 | with Registry.TRegistry.Create do 5 | try 6 | RootKey := ARootKey; 7 | if OpenKeyReadOnly(ASubKey) then 8 | GetValueNames(AValueList) 9 | else 10 | AValueList.Clear; 11 | finally 12 | Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/481.dat: -------------------------------------------------------------------------------- 1 | function ByteArraysSameStart(const B1, B2: array of Byte; const Count: Integer): 2 | Boolean; 3 | var 4 | I: Integer; 5 | begin 6 | Assert(Count > 0, 'Count must be >= 1'); 7 | Result := False; 8 | if (Length(B1) < Count) or (Length(B2) < Count) then 9 | Exit; 10 | for I := 0 to Pred(Count) do 11 | if B1[I] <> B2[I] then 12 | Exit; 13 | Result := True; 14 | end; -------------------------------------------------------------------------------- /collection/186.dat: -------------------------------------------------------------------------------- 1 | function GetFileType(const FilePath: string): string; 2 | var 3 | Info: ShellAPI.TSHFileInfo; 4 | begin 5 | if ShellAPI.SHGetFileInfo( 6 | PChar(FilePath), 7 | 0, 8 | Info, 9 | SizeOf(Info), 10 | ShellAPI.SHGFI_TYPENAME 11 | ) <> 0 then 12 | Result := Info.szTypeName 13 | else 14 | Result := ''; // result if file or folder does not exist 15 | end; -------------------------------------------------------------------------------- /collection/292.dat: -------------------------------------------------------------------------------- 1 | function IsWindows7: Boolean; 2 | var 3 | PFunction: Pointer; // points to PowerCreateRequest function if exists 4 | begin 5 | // Try to load PowerCreateRequest from Kernel32: 6 | // present if Windows 7 or Server 2008 R2 7 | PFunction := Windows.GetProcAddress( 8 | Windows.GetModuleHandle('kernel32.dll'), 'PowerCreateRequest' 9 | ); 10 | Result := Assigned(PFunction); 11 | end; -------------------------------------------------------------------------------- /collection/301.dat: -------------------------------------------------------------------------------- 1 | procedure TrimAppMemorySize; 2 | var 3 | MainHandle: Windows.THandle; // handle to current process 4 | begin 5 | MainHandle := Windows.OpenProcess( 6 | Windows.PROCESS_ALL_ACCESS, False, Windows.GetCurrentProcessID 7 | ); 8 | try 9 | Windows.SetProcessWorkingSetSize(MainHandle, $FFFFFFFF, $FFFFFFFF); 10 | finally 11 | Windows.CloseHandle(MainHandle); 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/518.dat: -------------------------------------------------------------------------------- 1 | function FileHasWatermark(const FileName: string; 2 | const Watermark: AnsiString; const Offset: Integer = 0): Boolean; 3 | overload; 4 | var 5 | Bytes: array of Byte; 6 | I: Integer; 7 | begin 8 | SetLength(Bytes, Length(Watermark)); 9 | for I := 1 to Length(Watermark) do 10 | Bytes[I - 1] := Ord(Watermark[I]); 11 | Result := FileHasWatermark(FileName, Bytes, Offset); 12 | end; -------------------------------------------------------------------------------- /collection/702.dat: -------------------------------------------------------------------------------- 1 | function RMS(const A: array of Double): Double; overload; 2 | var 3 | Squares: array of Double; 4 | Idx: Integer; 5 | begin 6 | System.SetLength(Squares, System.Length(A)); 7 | for Idx := 0 to Pred(System.Length(A)) do 8 | Squares[Idx] := A[Idx] * A[Idx]; 9 | // Note: ArithmeticMean raises exception if A is empty 10 | Result := Math.Power(ArithmeticMean(Squares), 0.5); 11 | end; -------------------------------------------------------------------------------- /collection/019.dat: -------------------------------------------------------------------------------- 1 | function FindAssociatedApp(const Doc: string): string; 2 | var 3 | PExecFile: array[0..Windows.MAX_PATH] of Char; // buffer to hold exe name 4 | begin 5 | // Win API call in ShellAPI 6 | if ShellAPI.FindExecutable(PChar(Doc), nil, PExecFile) < 32 then 7 | // No associated program found 8 | Result := '' 9 | else 10 | // Return program file name 11 | Result := PExecFile; 12 | end; -------------------------------------------------------------------------------- /collection/020.dat: -------------------------------------------------------------------------------- 1 | function OpenFolder(const Folder: string): Boolean; 2 | begin 3 | if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then 4 | // Folder is valid directory: try to open it 5 | Result := ShellAPI.ShellExecute( 6 | 0, 'open', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL 7 | ) > 32 8 | else 9 | // Folder is not a directory: error 10 | Result := False; 11 | end; -------------------------------------------------------------------------------- /collection/055.dat: -------------------------------------------------------------------------------- 1 | function IsSpecialFolderSupported(CSIDL: Integer): Boolean; 2 | var 3 | PIDL: ShlObj.PItemIDList; // PIDL of the special folder 4 | begin 5 | // Try to get PIDL for folder: fails if not supported 6 | Result := Windows.Succeeded( 7 | ShlObj.SHGetSpecialFolderLocation(0, CSIDL, PIDL) 8 | ); 9 | if Result then 10 | // Free the PIDL using shell allocator 11 | FreePIDL(PIDL); 12 | end; -------------------------------------------------------------------------------- /collection/143.dat: -------------------------------------------------------------------------------- 1 | procedure ProcessMessages; 2 | var 3 | Msg: Windows.TMsg; // stores message peeked from message loop 4 | begin 5 | while Windows.PeekMessage(Msg, 0, 0, 0, Windows.PM_REMOVE) do 6 | begin 7 | if Msg.Message <> Messages.WM_QUIT then 8 | begin 9 | Windows.TranslateMessage(Msg); 10 | Windows.DispatchMessage(Msg); 11 | end 12 | else 13 | Exit; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/508.dat: -------------------------------------------------------------------------------- 1 | function TreeNodeChildCount(ParentNode: ComCtrls.TTreeNode): Integer; 2 | var 3 | ChildNode: ComCtrls.TTreeNode; // references each child node 4 | begin 5 | Result := 0; 6 | if ParentNode = nil then 7 | Exit; 8 | ChildNode := ParentNode.GetFirstChild; 9 | while (ChildNode <> nil) do 10 | begin 11 | Inc(Result); 12 | ChildNode := ChildNode.GetNextSibling; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/525.dat: -------------------------------------------------------------------------------- 1 | function IsASCIIFile(const FileName: string; BytesToCheck: Int64 = 0; 2 | BufSize: Integer = 8*1024): Boolean; 3 | var 4 | Stm: Classes.TStream; 5 | begin 6 | Stm := Classes.TFileStream.Create( 7 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 8 | ); 9 | try 10 | Result := IsASCIIStream(Stm, BytesToCheck, BufSize); 11 | finally 12 | Stm.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/592.dat: -------------------------------------------------------------------------------- 1 | function TerminateProcessByID(ProcessID: Cardinal): Boolean; 2 | var 3 | HProcess : THandle; 4 | begin 5 | Result := False; 6 | HProcess := Windows.OpenProcess(Windows.PROCESS_TERMINATE, False, ProcessID); 7 | if HProcess > 0 then 8 | try 9 | Result := SysUtils.Win32Check(Windows.TerminateProcess(HProcess, 0)); 10 | finally 11 | Windows.CloseHandle(HProcess); 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/017.dat: -------------------------------------------------------------------------------- 1 | function ExploreFolder(const Folder: string): Boolean; 2 | begin 3 | if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then 4 | // Folder is valid directory: try to explore it 5 | Result := ShellAPI.ShellExecute( 6 | 0, 'explore', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL 7 | ) > 32 8 | else 9 | // Folder is not a directory: error 10 | Result := False; 11 | end; -------------------------------------------------------------------------------- /collection/346.dat: -------------------------------------------------------------------------------- 1 | procedure SetVistaContentFont(const AFont: Graphics.TFont); 2 | const 3 | VistaContentFont = 'Calibri'; // name of Vista content font 4 | begin 5 | if (SysUtils.Win32MajorVersion >= 6) 6 | and not SysUtils.SameText(AFont.Name, VistaContentFont) 7 | and FontExists(VistaContentFont) then 8 | begin 9 | AFont.Size := AFont.Size + 2; 10 | AFont.Name := VistaContentFont; 11 | end; 12 | end; -------------------------------------------------------------------------------- /collection/080.dat: -------------------------------------------------------------------------------- 1 | procedure StringToStream(const Str: string; const Stm: Classes.TStream); 2 | var 3 | SS: Classes.TStringStream; // used to copy string to stream 4 | begin 5 | // This TStreamStream constructor uses default ANSI encoding in Unicode 6 | // versions of Delphi. 7 | SS := Classes.TStringStream.Create(Str); 8 | try 9 | Stm.CopyFrom(SS, Length(Str)); 10 | finally 11 | SS.Free; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/369.dat: -------------------------------------------------------------------------------- 1 | function SliceByteArray(const B: array of Byte; Start, Len: Integer): 2 | TBytes; 3 | begin 4 | if Start < 0 then 5 | Start := 0; 6 | if Len < 0 then 7 | Len := 0 8 | else if Start >= Length(B) then 9 | Len := 0 10 | else if Start + Len > Length(B) then 11 | Len := Length(B) - Start; 12 | SetLength(Result, Len); 13 | if Len > 0 then 14 | Move(B[Start], Result[0], Len); 15 | end; -------------------------------------------------------------------------------- /collection/071.dat: -------------------------------------------------------------------------------- 1 | function WindowsProductID: string; 2 | const 3 | // Registry keys for Win 9x/NT 4 | cRegKey: array[Boolean] of string = ( 5 | 'Software\Microsoft\Windows\CurrentVersion', 6 | 'Software\Microsoft\Windows NT\CurrentVersion' 7 | ); 8 | // Registry key name 9 | cName = 'ProductID'; 10 | begin 11 | Result := GetRegistryString( 12 | Windows.HKEY_LOCAL_MACHINE, cRegKey[IsWinNT], cName 13 | ); 14 | end; -------------------------------------------------------------------------------- /collection/118.dat: -------------------------------------------------------------------------------- 1 | function IsLibraryInstalled(const LibFileName: string): Boolean; 2 | var 3 | DLLHandle: Windows.THandle; // handle to DLL 4 | begin 5 | // Try to load DLL 6 | try 7 | DLLHandle := SysUtils.SafeLoadLibrary(LibFileName); 8 | except 9 | DLLHandle := 0; 10 | end; 11 | // Check if DLL has been loaded 12 | Result := DLLHandle <> 0; 13 | if Result then 14 | Windows.FreeLibrary(DLLHandle); 15 | end; -------------------------------------------------------------------------------- /collection/178.dat: -------------------------------------------------------------------------------- 1 | procedure BitmapToMetafile(const Bmp: Graphics.TBitmap; 2 | const EMF: Graphics.TMetafile); 3 | var 4 | MetaCanvas: Graphics.TMetafileCanvas; // canvas for drawing on metafile 5 | begin 6 | EMF.Height := Bmp.Height; 7 | EMF.Width := Bmp.Width; 8 | MetaCanvas := Graphics.TMetafileCanvas.Create(EMF, 0); 9 | try 10 | MetaCanvas.Draw(0, 0, Bmp); 11 | finally 12 | MetaCanvas.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/679.dat: -------------------------------------------------------------------------------- 1 | function WeightedGeometricMean(const Values: array of Cardinal; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | FloatValues: Types.TDoubleDynArray; 6 | begin 7 | System.Setlength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedGeometricMean(FloatValues, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/680.dat: -------------------------------------------------------------------------------- 1 | function WeightedGeometricMean(const Values: array of Integer; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | FloatValues: Types.TDoubleDynArray; 6 | begin 7 | System.Setlength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedGeometricMean(FloatValues, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/688.dat: -------------------------------------------------------------------------------- 1 | function WeightedHarmonicMean(const Values: array of Cardinal; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | FloatValues: Types.TDoubleDynArray; 6 | begin 7 | System.Setlength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedHarmonicMean(FloatValues, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/689.dat: -------------------------------------------------------------------------------- 1 | function WeightedHarmonicMean(const Values: array of Integer; 2 | const Weights: array of Double): Double; overload; 3 | var 4 | Idx: Integer; 5 | FloatValues: Types.TDoubleDynArray; 6 | begin 7 | System.Setlength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedHarmonicMean(FloatValues, Weights); 11 | end; -------------------------------------------------------------------------------- /collection/078.dat: -------------------------------------------------------------------------------- 1 | function StreamToString(const Stm: Classes.TStream): string; 2 | var 3 | SS: Classes.TStringStream; // used to copy stream to string 4 | begin 5 | // This TStreamStream constructor uses default ANSI encoding in Unicode 6 | // versions of Delphi. 7 | SS := Classes.TStringStream.Create(''); 8 | try 9 | SS.CopyFrom(Stm, 0); 10 | Result := SS.DataString; 11 | finally 12 | SS.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/271.dat: -------------------------------------------------------------------------------- 1 | function TimeZoneName: string; 2 | var 3 | TZI: Windows.TTimeZoneInformation; // info about time zone 4 | begin 5 | case GetTimeZoneInformation(TZI) of 6 | Windows.TIME_ZONE_ID_INVALID: SysUtils.RaiseLastOSError; 7 | Windows.TIME_ZONE_ID_STANDARD: Result := TZI.StandardName; 8 | Windows.TIME_ZONE_ID_DAYLIGHT: Result := TZI.DaylightName; 9 | Windows.TIME_ZONE_ID_UNKNOWN: Result := ''; 10 | end; 11 | end; -------------------------------------------------------------------------------- /collection/334.dat: -------------------------------------------------------------------------------- 1 | function MemoCursorPos(const Memo: StdCtrls.TCustomMemo): Windows.TPoint; 2 | var 3 | Row, Col: Integer; // row and column containing cursor 4 | begin 5 | Row := Windows.SendMessage( 6 | Memo.Handle, Messages.EM_LINEFROMCHAR, Memo.SelStart, 0 7 | ); 8 | Col := Memo.SelStart - Windows.SendMessage( 9 | Memo.Handle, Messages.EM_LINEINDEX, Row, 0 10 | ); 11 | Result.X := Col; 12 | Result.Y := Row; 13 | end; -------------------------------------------------------------------------------- /collection/002.dat: -------------------------------------------------------------------------------- 1 | function WinFileTimeToDateTime(FT: Windows.TFileTime): TDateTime; 2 | var 3 | SysTime: Windows.TSystemTime; // stores date/time in system time format 4 | begin 5 | // Convert file time to system time, raising exception on error 6 | SysUtils.Win32Check(Windows.FileTimeToSystemTime(FT, SysTime)); 7 | // Convert system time to Delphi date time, raising excpetion on error 8 | Result := SysUtils.SystemTimeToDateTime(SysTime); 9 | end; -------------------------------------------------------------------------------- /collection/179.dat: -------------------------------------------------------------------------------- 1 | procedure ShowShellPropertiesDlg(const APath: string); 2 | var 3 | AExecInfo: ShellAPI.TShellExecuteinfo; // info passed to ShellExecuteEx 4 | begin 5 | FillChar(AExecInfo, SizeOf(AExecInfo), 0); 6 | AExecInfo.cbSize := SizeOf(AExecInfo); 7 | AExecInfo.lpFile := PChar(APath); 8 | AExecInfo.lpVerb := 'properties'; 9 | AExecInfo.fMask := ShellAPI.SEE_MASK_INVOKEIDLIST; 10 | ShellAPI.ShellExecuteEx(@AExecInfo); 11 | end; -------------------------------------------------------------------------------- /collection/511.dat: -------------------------------------------------------------------------------- 1 | function GetBiosVendor: string; 2 | var 3 | Reg: Registry.TRegistry; 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create(Windows.KEY_READ); 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if not Reg.OpenKey('HARDWARE\DESCRIPTION\System\Bios\', False) then 10 | Exit; 11 | Result := Reg.ReadString('BIOSVendor'); 12 | Reg.CloseKey; 13 | finally 14 | Reg.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/682.dat: -------------------------------------------------------------------------------- 1 | function SumOfReciprocals(const A: array of Integer): Double; overload; 2 | var 3 | Elem: Integer; 4 | begin 5 | if System.Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for Elem in A do 9 | begin 10 | if Elem <= 0 then 11 | raise SysUtils.EArgumentException.Create('Array values must be > 0'); 12 | Result := Result + 1 / Elem; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/683.dat: -------------------------------------------------------------------------------- 1 | function SumOfReciprocals(const A: array of Cardinal): Double; overload; 2 | var 3 | Elem: Cardinal; 4 | begin 5 | if System.Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for Elem in A do 9 | begin 10 | if Elem = 0 then 11 | raise SysUtils.EArgumentException.Create('Array values must be > 0'); 12 | Result := Result + 1 / Elem; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/660.dat: -------------------------------------------------------------------------------- 1 | function IsPalindromic(const N: Int64; const Base: Byte = 10): Boolean; 2 | var 3 | Digits: SysUtils.TBytes; 4 | Idx: Integer; 5 | PartitionSize: Integer; 6 | begin 7 | Digits := DigitsOf(N, Base); // raises exception for Base < 2 8 | Result := True; 9 | PartitionSize := Length(Digits) div 2; 10 | for Idx := 0 to Pred(PartitionSize) do 11 | if Digits[Idx] <> Digits[Length(Digits) - Idx - 1] then 12 | Exit(False); 13 | end; -------------------------------------------------------------------------------- /collection/695.dat: -------------------------------------------------------------------------------- 1 | function WeightedPowerMean(const Values: array of Integer; 2 | const Weights: array of Double; const Lambda: Double): Double; overload; 3 | var 4 | FloatValues: Types.TDoubleDynArray; 5 | Idx: Integer; 6 | begin 7 | System.SetLength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedPowerMean(FloatValues, Weights, Lambda); 11 | end; -------------------------------------------------------------------------------- /collection/696.dat: -------------------------------------------------------------------------------- 1 | function WeightedPowerMean(const Values: array of Cardinal; 2 | const Weights: array of Double; const Lambda: Double): Double; overload; 3 | var 4 | FloatValues: Types.TDoubleDynArray; 5 | Idx: Integer; 6 | begin 7 | System.SetLength(FloatValues, System.Length(Values)); 8 | for Idx := 0 to Pred(System.Length(Values)) do 9 | FloatValues[Idx] := Values[Idx]; 10 | Result := WeightedPowerMean(FloatValues, Weights, Lambda); 11 | end; -------------------------------------------------------------------------------- /collection/514.dat: -------------------------------------------------------------------------------- 1 | function GetSystemManufacturer: string; 2 | var 3 | Reg: Registry.TRegistry; 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create(Windows.KEY_READ); 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if not Reg.OpenKey('HARDWARE\DESCRIPTION\System\Bios\', False) then 10 | Exit; 11 | Result := Reg.ReadString('SystemManufacturer'); 12 | Reg.CloseKey; 13 | finally 14 | Reg.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/515.dat: -------------------------------------------------------------------------------- 1 | function GetSystemProductName: string; 2 | var 3 | Reg: Registry.TRegistry; 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create(Windows.KEY_READ); 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if not Reg.OpenKey('HARDWARE\DESCRIPTION\System\Bios\', False) then 10 | Exit; 11 | Result := Reg.ReadString('SystemProductName'); 12 | Reg.CloseKey; 13 | finally 14 | Reg.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/517.dat: -------------------------------------------------------------------------------- 1 | function FileHasWatermark(const FileName: string; 2 | const Watermark: array of Byte; const Offset: Integer = 0): Boolean; 3 | overload; 4 | var 5 | FS: Classes.TFileStream; 6 | begin 7 | FS := Classes.TFileStream.Create( 8 | FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone 9 | ); 10 | try 11 | FS.Position := Offset; 12 | Result := StreamHasWatermark(FS, Watermark); 13 | finally 14 | FS.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/031.dat: -------------------------------------------------------------------------------- 1 | function JoinStr(const SL: Classes.TStrings; const Delim: string; 2 | const AllowEmpty: Boolean = True): string; 3 | var 4 | Idx: Integer; // loops thru all items in string list 5 | begin 6 | Result := ''; 7 | for Idx := 0 to Pred(SL.Count) do 8 | begin 9 | if (SL[Idx] <> '') or AllowEmpty then 10 | if Result = '' then 11 | Result := SL[Idx] 12 | else 13 | Result := Result + Delim + SL[Idx]; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/360.dat: -------------------------------------------------------------------------------- 1 | function EncodingSupportsString(const S: UnicodeString; 2 | const Encoding: SysUtils.TEncoding): Boolean; 3 | var 4 | ConvertedStr: UnicodeString; // string converted using Encoding 5 | begin 6 | // Convert S to bytes and back to unicode string using Encoding 7 | ConvertedStr := Encoding.GetString(Encoding.GetBytes(S)); 8 | // If text is valid for given encoding, text and converted text must be same 9 | Result := S = ConvertedStr; 10 | end; -------------------------------------------------------------------------------- /collection/414.dat: -------------------------------------------------------------------------------- 1 | function DateQuarterEnd(const D: TDateTime): TDateTime; 2 | var 3 | Year, Month, Day, Quarter: Word; 4 | begin 5 | SysUtils.DecodeDate(D, Year, Month, Day); 6 | Quarter := 4 - ((12 - Month) div 3); 7 | // get 1st day of following quarter 8 | Month := 0; 9 | SysUtils.IncAMonth(Year, Month, Day, Quarter * 3 + 1); 10 | // required date is day before 1st day of following quarter 11 | Result := SysUtils.EncodeDate(Year, Month, 1) - 1.0; 12 | end; -------------------------------------------------------------------------------- /collection/471.dat: -------------------------------------------------------------------------------- 1 | function TempFileNameEx(const APath: string; const AStub: string; 2 | const ACreate: Boolean): string; 3 | begin 4 | SetLength(Result, Windows.MAX_PATH); 5 | if Windows.GetTempFileName( 6 | PChar(APath), PChar(AStub), 0, PChar(Result) 7 | ) <> 0 then 8 | begin 9 | if not ACreate then 10 | // user doesn't want file creating so delete it 11 | SysUtils.DeleteFile(Result); 12 | end 13 | else 14 | Result := ''; 15 | end; -------------------------------------------------------------------------------- /collection/089.dat: -------------------------------------------------------------------------------- 1 | function ExploreFile(const Filename: string ): Boolean; 2 | var 3 | Params: string; // params passed to explorer 4 | begin 5 | if SysUtils.FileExists(Filename) then 6 | begin 7 | Params := '/n, /e, /select, ' + Filename; 8 | Result := ShellAPI.ShellExecute ( 9 | 0, 'open', 'explorer', PChar(Params), '', Windows.SW_SHOWNORMAL 10 | ) > 32; 11 | end 12 | else 13 | // Error: filename does not exist 14 | Result := False; 15 | end; -------------------------------------------------------------------------------- /collection/185.dat: -------------------------------------------------------------------------------- 1 | function GetGenericFileType(const FileNameOrExt: string): string; 2 | var 3 | Info: ShellAPI.TSHFileInfo; 4 | begin 5 | if ShellAPI.SHGetFileInfo( 6 | PChar(FileNameOrExt), 7 | Windows.FILE_ATTRIBUTE_NORMAL, 8 | Info, 9 | SizeOf(Info), 10 | ShellAPI.SHGFI_TYPENAME or ShellAPI.SHGFI_USEFILEATTRIBUTES 11 | ) <> 0 then 12 | Result := Info.szTypeName 13 | else 14 | Result := ''; // should never be reached 15 | end; -------------------------------------------------------------------------------- /collection/267.dat: -------------------------------------------------------------------------------- 1 | function IsEqualResID(const R1, R2: PChar): Boolean; 2 | begin 3 | if IsIntResource(R1) then 4 | // R1 is ordinal: R2 must also be ordinal with same value in lo word 5 | Result := IsIntResource(R2) and 6 | (Windows.LoWord(Windows.DWORD(R1)) = Windows.LoWord(Windows.DWORD(R2))) 7 | else 8 | // R1 is string pointer: R2 must be same string (ignoring case) 9 | Result := not IsIntResource(R2) and (SysUtils.StrIComp(R1, R2) = 0); 10 | end; -------------------------------------------------------------------------------- /collection/276.dat: -------------------------------------------------------------------------------- 1 | function CloneCursorHandleAsBitmap(const Handle: Windows.HCURSOR; 2 | const PixelFmt: Graphics.TPixelFormat; 3 | const TransparentColor: Graphics.TColor): Graphics.TBitmap; 4 | var 5 | CursorIcon: Graphics.TIcon; 6 | begin 7 | CursorIcon := Graphics.TIcon.Create; 8 | try 9 | CursorIcon.Handle := Handle; 10 | Result := CloneGraphicAsBitmap(CursorIcon, PixelFmt, TransparentColor); 11 | finally 12 | CursorIcon.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/348.dat: -------------------------------------------------------------------------------- 1 | function ExplodeStrArray(const S, Delim: string; 2 | const AllowEmpty: Boolean = True; 3 | const Trim: Boolean = False): Types.TStringDynArray; 4 | var 5 | Strings: Classes.TStringList; // intermediate string list for ExplodeStr 6 | begin 7 | Strings := Classes.TStringList.Create; 8 | try 9 | ExplodeStr(S, Delim, Strings, AllowEmpty, Trim); 10 | Result := StringListToArray(Strings); 11 | finally 12 | Strings.Free; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/627.dat: -------------------------------------------------------------------------------- 1 | function SplitString(const AText, ADelimiter: string): Classes.TStringList; 2 | var 3 | LTxt, LTmp: string; 4 | begin 5 | Result := TStringList.Create; 6 | LTxt := AText; 7 | while Pos(ADelimiter, LTxt) > 0 do 8 | begin 9 | LTmp := Copy(LTxt, 1, Pos(ADelimiter, LTxt) - 1); 10 | Result.Add(LTmp); 11 | LTxt := SysUtils.StringReplace(LTxt, LTmp + ADelimiter, '', []); 12 | end; 13 | if (LTxt <> '') then 14 | Result.Add(LTxt); 15 | end; -------------------------------------------------------------------------------- /collection/644.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Int64): Extended; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Int64; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Elem <= 0 then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/646.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of UInt64): Extended; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: UInt64; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Elem = 0 then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/681.dat: -------------------------------------------------------------------------------- 1 | function SumOfReciprocals(const A: array of Double): Double; overload; 2 | var 3 | Elem: Double; 4 | begin 5 | if System.Length(A) = 0 then 6 | raise SysUtils.EArgumentException.Create('Array is empty'); 7 | Result := 0.0; 8 | for Elem in A do 9 | begin 10 | if Math.Sign(Elem) <> Math.PositiveValue then 11 | raise SysUtils.EArgumentException.Create('Array values must be > 0'); 12 | Result := Result + 1 / Elem; 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/011.dat: -------------------------------------------------------------------------------- 1 | function SetFileDate(const FName: string; const ADate: Integer): Boolean; 2 | var 3 | FileH: Integer; // file handle 4 | begin 5 | // Open file (assume failure) 6 | Result := False; 7 | FileH := SysUtils.FileOpen(FName, SysUtils.fmOpenWrite); 8 | if FileH <> -1 then 9 | begin 10 | // File opened OK - set date and close file 11 | SysUtils.FileSetDate(FileH, ADate); 12 | SysUtils.FileClose(FileH); 13 | Result := True; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/643.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Cardinal): Extended; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Cardinal; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Elem = 0 then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/645.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Integer): Extended; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Integer; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Elem <= 0 then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Peter Johnson (DelphiDabbler) 2 | DennisLV 3 | Alan Bailey 4 | Bill Miller 5 | Joe Donth 6 | Laurent Pierre 7 | Jan Roza 8 | Rubem Nascimento da Rocha 9 | Don Rowlett 10 | MDeltas 11 | Arno Wolff 12 | EX4 13 | Montor 14 | Shlomo Abuisak 15 | Michael Rockett 16 | Irwin Scollar 17 | Topellina 18 | Guru Kathiresan 19 | Homolibere 20 | Ariel Rivas 21 | Bruce Wernick 22 | Daniel 23 | Marv 24 | Torsten Hunnenberg 25 | Johan Keizer 26 | Mark Billig 27 | Michael 28 | -------------------------------------------------------------------------------- /collection/502.dat: -------------------------------------------------------------------------------- 1 | function GetKnownFolderPath(const FolderID: System.TGUID): UnicodeString; 2 | var 3 | Buffer: PWideChar; // path returned by SHGetKnownFolderPath 4 | begin 5 | Result := ''; 6 | if ActiveX.Succeeded(ShlObj.SHGetKnownFolderPath(FolderID, 0, 0, Buffer)) then 7 | Result := Buffer; 8 | // According to MSDN, we must use CoTaskMemFree to free the string 9 | // allocated by this function and pointed to by ppszPath. 10 | ActiveX.CoTaskMemFree(Buffer); 11 | end; -------------------------------------------------------------------------------- /collection/632.dat: -------------------------------------------------------------------------------- 1 | function MinsToStr(AMinutes: Cardinal): string; 2 | {$IFNDEF FPC} 3 | resourcestring 4 | {$ELSE} 5 | const 6 | {$ENDIF} 7 | sFmt = '%d Days %d Hours %d Minutes'; 8 | const 9 | HoursPerDay = 24; 10 | var 11 | Days, Hours, Minutes: Cardinal; 12 | begin 13 | Hours := AMinutes div 60; 14 | Minutes := AMinutes mod 60; 15 | Days := Hours div HoursPerDay; 16 | Hours := Hours mod HoursPerDay; 17 | Result := SysUtils.Format(sFmt, [Days, Hours, Minutes]); 18 | end; -------------------------------------------------------------------------------- /collection/506.dat: -------------------------------------------------------------------------------- 1 | function RemoveURIQueryString(const URI: string): string; 2 | var 3 | QueryStart: Integer; 4 | FragStart: Integer; 5 | begin 6 | QueryStart := SysUtils.AnsiPos('?', URI); 7 | if QueryStart = 0 then 8 | begin 9 | Result := URI; 10 | Exit; 11 | end; 12 | Result := Copy(URI, 1, QueryStart - 1); 13 | FragStart := SysUtils.AnsiPos('#', URI); 14 | if FragStart > 0 then 15 | Result := Result + Copy(URI, FragStart, Length(URI) - FragStart + 1); 16 | end; -------------------------------------------------------------------------------- /collection/663.dat: -------------------------------------------------------------------------------- 1 | function LSE(const A: array of Double): Double; 2 | var 3 | MaxElem: Double; 4 | Elem: Double; 5 | Sum: Double; 6 | begin 7 | if System.Length(A) = 0 then 8 | raise SysUtils.EArgumentException.Create('Empty array'); 9 | // Using the centering "trick": see https://rpubs.com/FJRubio/LSE 10 | MaxElem := MaxOfArray(A); 11 | Sum := 0.0; 12 | for Elem in A do 13 | Sum := Sum + System.Exp(Elem - MaxElem); 14 | Result := System.Ln(Sum) + MaxElem; 15 | end; -------------------------------------------------------------------------------- /collection/099.dat: -------------------------------------------------------------------------------- 1 | procedure DrawTextOutline(const Canvas: Graphics.TCanvas; const X, Y: Integer; 2 | const Text: string); 3 | var 4 | OldBkMode: Integer; // stores previous background mode 5 | begin 6 | OldBkMode := Windows.SetBkMode(Canvas.Handle, Windows.TRANSPARENT); 7 | Windows.BeginPath(Canvas.Handle); 8 | Canvas.TextOut(X, Y, Text); 9 | Windows.EndPath(Canvas.Handle); 10 | Windows.StrokeAndFillPath(Canvas.Handle); 11 | Windows.SetBkMode(Canvas.Handle, OldBkMode); 12 | end; -------------------------------------------------------------------------------- /collection/100.dat: -------------------------------------------------------------------------------- 1 | function IsHexStr(const S: string): Boolean; 2 | {Returns true if string S contains only valid hex digits, false otherwise} 3 | const 4 | cHexChars = ['0'..'9', 'A'..'F', 'a'..'f']; // set of valid hex digits 5 | var 6 | Idx: Integer; // loops thru all characters in string 7 | begin 8 | Result := True; 9 | for Idx := 1 to Length(S) do 10 | if not IsCharInSet(S[Idx], cHexChars) then 11 | begin 12 | Result := False; 13 | Break; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/266.dat: -------------------------------------------------------------------------------- 1 | function GetIEVersionStr: string; 2 | var 3 | Reg: Registry.TRegistry; // registry access object 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create; 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if Reg.OpenKeyReadOnly('Software\Microsoft\Internet Explorer') then 10 | begin 11 | if Reg.ValueExists('Version') then 12 | Result := Reg.ReadString('Version'); 13 | end; 14 | finally 15 | Reg.Free; 16 | end; 17 | end; -------------------------------------------------------------------------------- /collection/512.dat: -------------------------------------------------------------------------------- 1 | function GetProcessorIdentifier: string; 2 | var 3 | Reg: Registry.TRegistry; 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create(Windows.KEY_READ); 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if not Reg.OpenKey( 10 | 'HARDWARE\DESCRIPTION\System\CentralProcessor\0\', False 11 | ) then 12 | Exit; 13 | Result := Reg.ReadString('Identifier'); 14 | Reg.CloseKey; 15 | finally 16 | Reg.Free; 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/596.dat: -------------------------------------------------------------------------------- 1 | procedure GetAllEnvVars(const Vars: Classes.TStrings); 2 | var 3 | PEnvVars: PChar; // pointer to start of environment block 4 | begin 5 | Assert(Assigned(Vars)); 6 | Vars.Clear; 7 | // Get reference to environment block for this process 8 | PEnvVars := Windows.GetEnvironmentStrings; 9 | if PEnvVars = nil then 10 | Exit; 11 | try 12 | MultiSzToStrings(PEnvVars, Vars); 13 | finally 14 | Windows.FreeEnvironmentStrings(PEnvVars); 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/009.dat: -------------------------------------------------------------------------------- 1 | function GetFileDate(const FName: string): Integer; 2 | var 3 | FileH: Integer; // file handle 4 | begin 5 | // Open file 6 | FileH := SysUtils.FileOpen(FName, SysUtils.fmOpenRead); 7 | if FileH = -1 then 8 | // Couldn't open file - return -1 to indicate can't get date 9 | Result := -1 10 | else 11 | begin 12 | // File opened OK - record date and close file 13 | Result := SysUtils.FileGetDate(FileH); 14 | SysUtils.FileClose(FileH); 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/157.dat: -------------------------------------------------------------------------------- 1 | function TaskbarBounds: Windows.TRect; 2 | var 3 | Data: ShellAPI.TAppBarData; // structure receive task bar info 4 | begin 5 | // set up data structure 6 | Data.cbSize := SizeOf(Data); 7 | Data.hWnd := TaskbarHandle; 8 | // get bounding rectangle 9 | if ShellAPI.SHAppBarMessage(ShellAPI.ABM_GETTASKBARPOS, Data) <> 0 then 10 | Result := Data.rc 11 | else 12 | // can't get task bar info: return empty rectangle 13 | FillChar(Result, SizeOf(Result), 0); 14 | end; -------------------------------------------------------------------------------- /collection/265.dat: -------------------------------------------------------------------------------- 1 | procedure Delay(ADelay: Integer); 2 | var 3 | StartTC: Windows.DWORD; // tick count when routine called 4 | CurrentTC: Int64; // tick count at each loop iteration 5 | begin 6 | StartTC := Windows.GetTickCount; 7 | repeat 8 | CurrentTC := Windows.GetTickCount; 9 | if CurrentTC < StartTC then 10 | // tick count has wrapped around: adjust it 11 | CurrentTC := CurrentTC + High(Windows.DWORD); 12 | until CurrentTC - StartTC >= ADelay; 13 | end; 14 | -------------------------------------------------------------------------------- /collection/380.dat: -------------------------------------------------------------------------------- 1 | procedure HalftoneStretch(DestBmp, SrcBmp: Graphics.TBitmap); overload; 2 | begin 3 | if not Assigned(DestBmp) or not Assigned(SrcBmp) then 4 | Exit; 5 | if (DestBmp.Width <= 0) or (DestBmp.Height <= 0) or 6 | (SrcBmp.Width <= 0) or (SrcBmp.Height <= 0) then 7 | Exit; 8 | HalftoneStretch( 9 | DestBmp.Canvas, 10 | Types.Rect(0, 0, DestBmp.Width, DestBmp.Height), 11 | SrcBmp.Canvas, 12 | Types.Rect(0, 0, SrcBmp.Width, SrcBmp.Height) 13 | ); 14 | end; -------------------------------------------------------------------------------- /collection/384.dat: -------------------------------------------------------------------------------- 1 | procedure ScaleBitmap(ADestBmp, ASrcBmp: Graphics.TBitmap; AScaling: Double); 2 | overload; 3 | var 4 | OutRect: Types.TRect; // rectangle defining resized image 5 | begin 6 | OutRect := ScaleRect(ASrcBmp.Canvas.ClipRect, AScaling); 7 | ADestBmp.Width := RectWidth(OutRect); 8 | ADestBmp.Height := RectHeight(OutRect); 9 | HalftoneStretch( 10 | ADestBmp.Canvas, 11 | ADestBmp.Canvas.ClipRect, 12 | ASrcBmp.Canvas, 13 | ASrcBmp.Canvas.ClipRect 14 | ); 15 | end; -------------------------------------------------------------------------------- /collection/396.dat: -------------------------------------------------------------------------------- 1 | procedure RegDeleteValue(const ARootKey: Windows.HKEY; const APath: string); 2 | var 3 | SubKey: string; // registry sub-key extracted from APath 4 | ValueName: string; // value name extracted from APath 5 | begin 6 | with Registry.TRegistry.Create do 7 | try 8 | RootKey := ARootKey; 9 | RegParsePath(APath, SubKey, ValueName); 10 | if OpenKey(SubKey, True) then 11 | DeleteValue(ValueName); 12 | finally 13 | Free; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/478.dat: -------------------------------------------------------------------------------- 1 | function DelAllText(const Needle, Haystack: string): string; 2 | var 3 | StartIdx: Integer; 4 | LowerNeedle: string; 5 | begin 6 | Result := Haystack; 7 | LowerNeedle := SysUtils.AnsiLowerCase(Needle); 8 | StartIdx := SysUtils.AnsiPos(LowerNeedle, SysUtils.AnsiLowerCase(Result)); 9 | while StartIdx > 0 do 10 | begin 11 | Delete(Result, StartIdx, Length(Needle)); 12 | StartIdx := SysUtils.AnsiPos(LowerNeedle, SysUtils.AnsiLowerCase(Result)); 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/513.dat: -------------------------------------------------------------------------------- 1 | function GetProcessorName: string; 2 | var 3 | Reg: Registry.TRegistry; 4 | begin 5 | Result := ''; 6 | Reg := Registry.TRegistry.Create(Windows.KEY_READ); 7 | try 8 | Reg.RootKey := Windows.HKEY_LOCAL_MACHINE; 9 | if not Reg.OpenKey( 10 | 'HARDWARE\DESCRIPTION\System\CentralProcessor\0\', False 11 | ) then 12 | Exit; 13 | Result := Reg.ReadString('ProcessorNameString'); 14 | Reg.CloseKey; 15 | finally 16 | Reg.Free; 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/647.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Double): Double; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Double; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Math.Sign(Elem) <> Math.PositiveValue then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/649.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Single): Single; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Single; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Math.Sign(Elem) <> Math.PositiveValue then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/061.dat: -------------------------------------------------------------------------------- 1 | function TaskAllocWideString(const S: string): Windows.PWChar; 2 | var 3 | StrLen: Integer; // length of string in bytes 4 | begin 5 | // Store length of string allowing for terminal #0 6 | StrLen := Length(S) + 1; 7 | // Alloc buffer for wide string using task allocator 8 | Result := ActiveX.CoTaskMemAlloc(StrLen * SizeOf(WideChar)); 9 | if Assigned(Result) then 10 | // Convert string to wide string and store in buffer 11 | StringToWideChar(S, Result, StrLen); 12 | end; -------------------------------------------------------------------------------- /collection/213.dat: -------------------------------------------------------------------------------- 1 | function WindowScrollbars(const Wnd: Windows.HWND): StdCtrls.TScrollStyle; 2 | var 3 | StyleFlags: Windows.DWORD; 4 | begin 5 | StyleFlags:= Windows.GetWindowLong(Wnd, Windows.GWL_STYLE) and 6 | (Windows.WS_VSCROLL or Windows.WS_HSCROLL); 7 | case StyleFlags of 8 | 0: Result := StdCtrls.ssNone; 9 | Windows.WS_VSCROLL: Result := StdCtrls.ssVertical; 10 | Windows.WS_HSCROLL: Result := StdCtrls.ssHorizontal; 11 | else Result := StdCtrls.ssBoth; 12 | end; 13 | end; -------------------------------------------------------------------------------- /collection/341.dat: -------------------------------------------------------------------------------- 1 | function IsTrueTypeFont(const Font: Graphics.TFont): Boolean; overload; 2 | var 3 | DC: Windows.HDC; // device context in which font is selected 4 | TM: Windows.TTextMetric; // text metrics for font in DC 5 | begin 6 | DC := CreateDisplayDC; 7 | try 8 | Windows.SelectObject(DC, Font.Handle); 9 | Windows.GetTextMetrics(DC, TM); 10 | Result := IsFlagSet(TM.tmPitchAndFamily, Windows.TMPF_TRUETYPE); 11 | finally 12 | Windows.DeleteDC(DC); 13 | end; 14 | end; -------------------------------------------------------------------------------- /collection/504.dat: -------------------------------------------------------------------------------- 1 | function ExtractURIQueryString(const URI: string): string; 2 | var 3 | QueryStart: Integer; 4 | QueryEnd: Integer; 5 | begin 6 | Result := ''; 7 | QueryStart := SysUtils.AnsiPos('?', URI); 8 | if QueryStart = 0 then 9 | Exit; 10 | Inc(QueryStart); 11 | QueryEnd := SysUtils.AnsiPos('#', URI); 12 | if QueryEnd < QueryStart then 13 | QueryEnd := Length(URI) 14 | else 15 | Dec(QueryEnd); 16 | Result := Copy(URI, QueryStart, QueryEnd - QueryStart + 1); 17 | end; -------------------------------------------------------------------------------- /collection/535.dat: -------------------------------------------------------------------------------- 1 | function JoinStrArray(const Strings: array of string; const Delim: string; 2 | const AllowEmpty: Boolean = True): string; 3 | var 4 | Idx: Integer; // loops thru all elements of string array 5 | begin 6 | Result := ''; 7 | for Idx := 0 to Pred(Length(Strings)) do 8 | begin 9 | if (Strings[Idx] <> '') or AllowEmpty then 10 | if Result = '' then 11 | Result := Strings[Idx] 12 | else 13 | Result := Result + Delim + Strings[Idx]; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/577.dat: -------------------------------------------------------------------------------- 1 | procedure WBAppendHTML(WB: SHDocVw.TWebbrowser; const HTML: string); 2 | var 3 | Doc: MSHTML.IHTMLDocument2; 4 | BodyElem: MSHTML.IHTMLBodyElement; 5 | Range: MSHTML.IHTMLTxtRange; 6 | begin 7 | if not SysUtils.Supports(WB.Document, MSHTML.IHTMLDocument2, Doc) then 8 | Exit; 9 | if not SysUtils.Supports(Doc.body, MSHTML.IHTMLBodyElement, BodyElem) then 10 | Exit; 11 | Range := BodyElem.createTextRange; 12 | Range.collapse(False); 13 | Range.pasteHTML(HTML); 14 | end; -------------------------------------------------------------------------------- /collection/277.dat: -------------------------------------------------------------------------------- 1 | procedure CursorHandleToBitmap(const Handle: Windows.HCURSOR; 2 | const Bmp: Graphics.TBitmap; const TransparentColor: Graphics.TColor); 3 | var 4 | CursorIcon: Graphics.TIcon; // icon used to render cursor 5 | begin 6 | // Render cursor in icon 7 | CursorIcon := Graphics.TIcon.Create; 8 | try 9 | CursorIcon.Handle := Handle; 10 | // Draw icon on bitmap 11 | GraphicToBitmap(CursorIcon, Bmp, TransparentColor); 12 | finally 13 | CursorIcon.Free; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/648.dat: -------------------------------------------------------------------------------- 1 | function SumOfLogs(const A: array of Extended): Extended; overload; 2 | {$IFDEF FPC} 3 | const 4 | {$ELSE} 5 | resourcestring 6 | {$ENDIF} 7 | sNotPositive = 'All elements of array A must be > 0'; 8 | var 9 | Elem: Extended; 10 | begin 11 | Result := 0.0; 12 | for Elem in A do 13 | begin 14 | if Math.Sign(Elem) <> Math.PositiveValue then 15 | raise SysUtils.EArgumentOutOfRangeException.Create(sNotPositive); 16 | Result := Result + System.Ln(Elem); 17 | end; 18 | end; -------------------------------------------------------------------------------- /collection/045.dat: -------------------------------------------------------------------------------- 1 | function URLFromShortcut(const Shortcut: string): string; 2 | var 3 | Ini: IniFiles.TIniFile; // object used to read shortcut file 4 | begin 5 | // Return URL item from [InternetShortcut] section of shortcut file 6 | Ini := IniFiles.TIniFile.Create(Shortcut); 7 | try 8 | try 9 | Result := Ini.ReadString('InternetShortcut', 'URL', ''); 10 | except; 11 | // We return '' on error 12 | Result := ''; 13 | end; 14 | finally 15 | Ini.Free; 16 | end; 17 | end; -------------------------------------------------------------------------------- /collection/166.dat: -------------------------------------------------------------------------------- 1 | function DiskSpaceInfo(const Drive: string; out AvailBytes, TotalBytes, 2 | FreeBytes: Int64): Boolean; 3 | begin 4 | // We use GetDiskFreeSpaceEx from SysUtils since it deals with OSs that do not 5 | // support the Windows GetDiskFreeSpaceEx API call 6 | Result := SysUtils.GetDiskFreeSpaceEx( 7 | PChar(Drive), AvailBytes, TotalBytes, @FreeBytes 8 | ); 9 | if not Result then 10 | begin 11 | AvailBytes := 0; 12 | TotalBytes := 0; 13 | FreeBytes := 0; 14 | end; 15 | end; -------------------------------------------------------------------------------- /collection/192.dat: -------------------------------------------------------------------------------- 1 | function GetFirstWord(var S: string; const Delim: Char = ' '): string; 2 | var 3 | AWordCount: Integer; // number of words in string 4 | Words: Classes.TStrings; // list of words in string 5 | begin 6 | Words := Classes.TStringList.Create; 7 | try 8 | AWordCount := ExplodeStr(CompressWhiteSpace(S), Delim, Words, False, True); 9 | if AWordCount > 0 then 10 | Result := Words[0] 11 | else 12 | Result := ''; 13 | finally 14 | Words.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/070.dat: -------------------------------------------------------------------------------- 1 | procedure DriveDisplayNames(const List: Classes.TStrings); 2 | var 3 | Drives: Classes.TStringList; // list of drives 4 | Idx: Integer; // loops thru drives 5 | begin 6 | // Get list of drives 7 | Drives := Classes.TStringList.Create; 8 | try 9 | ListDrives(Drives); 10 | // Loop thru drive list getting drive info 11 | for Idx := 0 to Pred(Drives.Count) do 12 | List.Add(DriveDisplayName(Drives[Idx])); 13 | finally 14 | Drives.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/366.dat: -------------------------------------------------------------------------------- 1 | function ChopByteArray(const B: array of Byte; Start, Len: Integer): 2 | TBytes; 3 | var 4 | First, Last: TBytes; 5 | begin 6 | if Start < 0 then 7 | Start := 0; 8 | if Len < 0 then 9 | Len := 0 10 | else if Start >= Length(B) then 11 | Len := 0 12 | else if Start + Len > Length(B) then 13 | Len := Length(B) - Start; 14 | First := SliceByteArray(B, 0, Start); 15 | Last := SliceByteArray(B, Start + Len, Length(B)); 16 | Result := ConcatByteArrays(First, Last); 17 | end; -------------------------------------------------------------------------------- /collection/626.dat: -------------------------------------------------------------------------------- 1 | procedure ParseStr(const StrToParse: string; const Delimiter: Char; 2 | const Words: Classes.TStringList); 3 | var 4 | TmpInStr: string; 5 | begin 6 | TmpInStr := StrToParse; 7 | Words.Clear; 8 | if Length(TmpInStr) > 0 then 9 | begin 10 | while Pos(Delimiter, TmpInStr) > 0 do 11 | begin 12 | Words.Append(Copy(TmpInStr, 1, Pos(Delimiter, TmpInStr) - 1)); 13 | Delete(TmpInStr, 1, Pos(Delimiter, TmpInStr)); 14 | end; 15 | Words.Append(TmpInStr); 16 | end; 17 | end; -------------------------------------------------------------------------------- /collection/193.dat: -------------------------------------------------------------------------------- 1 | function GetLastWord(var S: string; const Delim: Char = ' '): string; 2 | var 3 | AWordCount: Integer; // number of words in string 4 | Words: Classes.TStrings; // list of words in string 5 | begin 6 | Words := Classes.TStringList.Create; 7 | try 8 | AWordCount := ExplodeStr(CompressWhiteSpace(S), Delim, Words, False, True); 9 | if AWordCount > 0 then 10 | Result := Words[AWordCount - 1] 11 | else 12 | Result := ''; 13 | finally 14 | Words.Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/395.dat: -------------------------------------------------------------------------------- 1 | procedure RegWriteString(const ARootKey: Windows.HKEY; 2 | const APath, AValue: string); 3 | var 4 | SubKey: string; // registry sub-key extracted from APath 5 | ValueName: string; // value name extracted from APath 6 | begin 7 | with Registry.TRegistry.Create do 8 | try 9 | RootKey := ARootKey; 10 | RegParsePath(APath, SubKey, ValueName); 11 | if OpenKey(SubKey, True) then 12 | WriteString(ValueName, AValue); 13 | finally 14 | Free; 15 | end; 16 | end; -------------------------------------------------------------------------------- /collection/593.dat: -------------------------------------------------------------------------------- 1 | function SysUserErrorMessage(const OSErrorCode: Cardinal): string; 2 | var 3 | MessageBuffer: PChar; 4 | begin 5 | Windows.FormatMessage( 6 | Windows.FORMAT_MESSAGE_ALLOCATE_BUFFER or Windows.FORMAT_MESSAGE_FROM_SYSTEM, 7 | nil, 8 | OSErrorCode, 9 | Windows.LANG_USER_DEFAULT, 10 | @MessageBuffer, 11 | 0, 12 | nil 13 | ); 14 | try 15 | Result := SysUtils.Trim(MessageBuffer); 16 | finally 17 | Windows.LocalFree(Windows.HLOCAL(MessageBuffer)); 18 | end; 19 | end; --------------------------------------------------------------------------------