tresext.pp 1.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. { Test for resources support - external resources. }
  2. {%TARGET=darwin}
  3. {%OPT=-We}
  4. {$mode objfpc}
  5. {$R tres1.res}
  6. procedure Fail(const Msg: string);
  7. begin
  8. writeln(Msg);
  9. Halt(1);
  10. end;
  11. function GetResource(ResourceName, ResourceType: PChar; PResSize: PLongInt = nil): pointer;
  12. var
  13. hRes: TFPResourceHandle;
  14. gRes: TFPResourceHGLOBAL;
  15. begin
  16. hRes:=FindResource(HINSTANCE, ResourceName, ResourceType);
  17. if hRes = 0 then
  18. Fail('FindResource failed.');
  19. gRes:=LoadResource(HINSTANCE, hRes);
  20. if gRes = 0 then
  21. Fail('LoadResource failed.');
  22. if PResSize <> nil then begin
  23. PResSize^:=SizeofResource(HINSTANCE, hRes);
  24. if PResSize^ = 0 then
  25. Fail('SizeofResource failed.');
  26. end;
  27. Result:=LockResource(gRes);
  28. if Result = nil then
  29. Fail('LockResource failed.');
  30. end;
  31. procedure DoTest;
  32. var
  33. s: string;
  34. p: PChar;
  35. sz: longint;
  36. begin
  37. p:=GetResource('TestFile', 'FILE', @sz);
  38. SetString(s, p, sz);
  39. if s <> 'test file.' then
  40. Fail('Invalid resource loaded.');
  41. writeln(s);
  42. p:=GetResource('Test', 'TEXT', @sz);
  43. SetString(s, p, sz);
  44. if s <> 'Another test file.' then
  45. Fail('Invalid resource loaded.');
  46. writeln(s);
  47. end;
  48. begin
  49. writeln('Resources test.');
  50. DoTest;
  51. writeln('Done.');
  52. end.