Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.0.0 / tests / test / units / system / tresext.pp
Size: Mime:
{ Test for resources support - external resources. }

{%TARGET=darwin}
{%OPT=-We}

{$mode objfpc}

{$R tres1.res}

procedure Fail(const Msg: string);
begin
  writeln(Msg);
  Halt(1);
end;

function GetResource(ResourceName, ResourceType: PChar; PResSize: PLongInt = nil): pointer;
var
  hRes: TFPResourceHandle;
  gRes: TFPResourceHGLOBAL;
begin
  hRes:=FindResource(HINSTANCE, ResourceName, ResourceType);
  if hRes = 0 then
    Fail('FindResource failed.');
  gRes:=LoadResource(HINSTANCE, hRes);
  if gRes = 0 then
    Fail('LoadResource failed.');
  if PResSize <> nil then begin
    PResSize^:=SizeofResource(HINSTANCE, hRes);
    if PResSize^ = 0 then
      Fail('SizeofResource failed.');
  end;
  Result:=LockResource(gRes);
  if Result = nil then
    Fail('LockResource failed.');
end;

procedure DoTest;
var
  s: string;
  p: PChar;
  sz: longint;
begin
  p:=GetResource('TestFile', 'FILE', @sz);
  SetString(s, p, sz);
  if s <> 'test file.' then
    Fail('Invalid resource loaded.');
  writeln(s);
  
  p:=GetResource('Test', 'TEXT', @sz);
  SetString(s, p, sz);
  if s <> 'Another test file.' then
    Fail('Invalid resource loaded.');
  writeln(s);
end;

begin
  writeln('Resources test.');
  DoTest;
  writeln('Done.');
end.