1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
{ Test for FindResourceEx function - external resources. }
{%TARGET=darwin}
{%OPT=-We}
{$mode objfpc}
uses
sysutils;
{$R tresb.res}
procedure Fail(const Msg: string);
begin
writeln(Msg);
Halt(1);
end;
function GetResource(ResourceType, ResourceName: PChar; ResLang : word; PResSize: PLongInt = nil): pointer;
var
hRes: TFPResourceHandle;
gRes: TFPResourceHGLOBAL;
begin
writeln('trying ',ResourceType,':',ResourceName,':',IntToHex(ResLang,4));
hRes:=FindResourceEx(HINSTANCE, ResourceType,ResourceName,ResLang);
if hRes = 0 then
Fail('FindResourceEx 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;
const
LANG_ENGLISH = $09;
SUBLANG_ENGLISH_US = $01;
LANG_ITALIAN = $10;
SUBLANG_ITALIAN = $01;
SUBLANG_ITALIAN_SWISS = $02;
LANG_GERMAN = $07;
SUBLANG_GERMAN = $01;
var
s: string;
p: PChar;
sz: longint;
begin
//us english, exact match
p:=GetResource('FILE','TestFile', MakeLangID(LANG_ENGLISH,SUBLANG_ENGLISH_US), @sz);
SetString(s, p, sz);
if s <> 'test file.' then
Fail('Invalid resource loaded.');
writeln(s);
//italian, exact match
p:=GetResource('FILE','TestFile', MakeLangID(LANG_ITALIAN,SUBLANG_ITALIAN), @sz);
SetString(s, p, sz);
if s <> 'test file (italian).' then
Fail('Invalid resource loaded.');
writeln(s);
{ On Windows, FindResourceEx behaviour varies between versions, so we
can't rely on the following tests }
{$IFNDEF WINDOWS}
//swiss italian , should fallback to italian
p:=GetResource('FILE','TestFile', MakeLangID(LANG_ITALIAN,SUBLANG_ITALIAN_SWISS), @sz);
SetString(s, p, sz);
if s <> 'test file (italian).' then
Fail('Invalid resource loaded.');
writeln(s);
//german, should fallback on the first resource found (english)
p:=GetResource('FILE','TestFile', MakeLangID(LANG_GERMAN,SUBLANG_GERMAN), @sz);
SetString(s, p, sz);
if s <> 'test file.' then
Fail('Invalid resource loaded.');
writeln(s);
{$ENDIF}
end;
begin
writeln('Resources test.');
DoTest;
writeln('Done.');
end.
|
