UnsignedFunc.pas 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116
  1. unit UnsignedFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Provides unsigned alternatives to Delphi functions that use signed types for parameters or return
  8. values where unsigned types would have been more appropriate
  9. }
  10. interface
  11. { FRAMEWORK_VCL is available as of Delphi 11.1, so define it manually here when we need it, to
  12. support Delphi 10.4 }
  13. {$IF Defined(ISIDEPROJ) or Defined(SETUPPROJ)}
  14. {$DEFINE FRAMEWORK_VCL}
  15. {$IFEND}
  16. uses
  17. {$IFDEF FRAMEWORK_VCL} Windows, UITypes, Controls, Graphics, {$ENDIF} SysUtils;
  18. function ULength(const S: String): Cardinal; overload; inline;
  19. function ULength(const S: RawByteString): Cardinal; overload; inline;
  20. function ULength(const S: WideString): Cardinal; overload; inline;
  21. function ULength(const S: TBytes): Cardinal; overload; inline;
  22. procedure UMove(const Source; var Dest; Count: NativeUInt);
  23. procedure UFillChar(var Dest; Count: NativeUInt; const Value: Integer);
  24. function UCompareMem(P1, P2: Pointer; Length: NativeUInt): Boolean;
  25. {$IFDEF FRAMEWORK_VCL}
  26. function UColorToRGB(Color: TColor): TColorRef;
  27. function UDrawTextBiDiModeFlags(const Control: TControl; const Flags: UINT): UINT;
  28. {$ENDIF}
  29. implementation
  30. function ULength(const S: String): Cardinal;
  31. begin
  32. Result := Cardinal(Length(S));
  33. end;
  34. function ULength(const S: RawByteString): Cardinal;
  35. begin
  36. Result := Cardinal(Length(S));
  37. end;
  38. function ULength(const S: WideString): Cardinal;
  39. begin
  40. Result := Cardinal(Length(S));
  41. end;
  42. function ULength(const S: TBytes): Cardinal;
  43. begin
  44. Result := Cardinal(Length(S));
  45. end;
  46. procedure UMove(const Source; var Dest; Count: NativeUInt);
  47. begin
  48. var SourceBuf: PByte := @Source;
  49. var DestBuf: PByte := @Dest;
  50. while Count > 0 do begin
  51. var SignedCount := High(NativeInt);
  52. if Count < NativeUInt(SignedCount) then
  53. SignedCount := NativeInt(Count);
  54. Move(SourceBuf^, DestBuf^, SignedCount);
  55. Dec(Count, SignedCount);
  56. Inc(SourceBuf, SignedCount);
  57. Inc(DestBuf, SignedCount);
  58. end;
  59. end;
  60. procedure UFillChar(var Dest; Count: NativeUInt; const Value: Integer);
  61. begin
  62. var DestBuf: PByte := @Dest;
  63. while Count > 0 do begin
  64. var SignedCount := High(NativeInt);
  65. if Count < NativeUInt(SignedCount) then
  66. SignedCount := NativeInt(Count);
  67. FillChar(DestBuf^, SignedCount, Value);
  68. Dec(Count, SignedCount);
  69. Inc(DestBuf, SignedCount);
  70. end;
  71. end;
  72. function UCompareMem(P1, P2: Pointer; Length: NativeUInt): Boolean;
  73. begin
  74. Result := True;
  75. if P1 <> P2 then begin
  76. while Length > 0 do begin
  77. var SignedLength := High(NativeInt);
  78. if Length < NativeUInt(SignedLength) then
  79. SignedLength := NativeInt(Length);
  80. if not CompareMem(P1, P2, SignedLength) then
  81. Exit(False);
  82. Dec(Length, SignedLength);
  83. Inc(PByte(P1), SignedLength);
  84. Inc(PByte(P2), SignedLength);
  85. end;
  86. end;
  87. end;
  88. {$IFDEF FRAMEWORK_VCL}
  89. function UColorToRGB(Color: TColor): TColorRef;
  90. begin
  91. Result := TColorRef(ColorToRGB(Color));
  92. end;
  93. function UDrawTextBiDiModeFlags(const Control: TControl; const Flags: UINT): UINT;
  94. begin
  95. Result := UINT(Control.DrawTextBiDiModeFlags(Integer(Flags)));
  96. end;
  97. {$ENDIF}
  98. end.