mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 10:19:31 +01:00
739 lines
24 KiB
ObjectPascal
739 lines
24 KiB
ObjectPascal
{ Resource Unit
|
|
|
|
Programmer: Brad Williams
|
|
BitSoft Development, L.L.C.
|
|
Copyright (c) 1996
|
|
Version 1.1
|
|
|
|
Revision History
|
|
|
|
1.1 (12/26/97)
|
|
- updated to add cdResource directive so that can use standard TStringList
|
|
resources created by TVRW and TVDT
|
|
|
|
1.0
|
|
- original implementation }
|
|
|
|
unit Resource;
|
|
|
|
interface
|
|
|
|
{
|
|
The Resource unit provides global variables which are used to build and
|
|
access resource files. InitRez must always be called before accessing any
|
|
variables in the Resource unit. The programmer should also always call
|
|
Done to free all file handles allocated to the program.
|
|
}
|
|
|
|
{$i platform.inc}
|
|
|
|
{$ifdef PPC_FPC}
|
|
{$H-}
|
|
{$else}
|
|
{$F+,O+,E+,N+}
|
|
{$endif}
|
|
{$X+,R-,I-,Q-,V-}
|
|
{$ifndef OS_UNIX}
|
|
{$S-}
|
|
{$endif}
|
|
|
|
uses
|
|
|
|
FVConsts, Objects, Dos;
|
|
|
|
const
|
|
|
|
RezExt: ExtStr = '.RES';
|
|
{ The file extension used on all resource files. }
|
|
RezBufferSize: Word = 4096;
|
|
{ RezBufferSize is the number of bytes to use for the resource file's
|
|
stream's buffer. RezBufferSize is passed to TBufStream.Init. }
|
|
|
|
{ reXXXX constants are used with resource files to retrieve the standard
|
|
Free Vision dialogs. The constant is followed by the Unit in which it
|
|
is used and the resource which is stored separated by a period. }
|
|
|
|
reChDirDialog = 'ChDirDialog'; { StdDlg.TChDirDialog }
|
|
reEditChDirDialog = 'EditChDirDialog'; { StdDlg.TEditChDirDialog }
|
|
reFindTextDlg = 'FindTextDlg'; { Editors.CreateFindDialog }
|
|
reHints = 'Hints'; { Resource.Hints }
|
|
reJumpLineDlg = 'JumpLineDlg'; { Editors.MakeJumpLineDlg }
|
|
reLabels = 'Labels'; { Resource.Labels }
|
|
reMenuBar = 'MenuBar'; { App.MenuBar }
|
|
reOpenDlg = 'OpenDlg'; { StdDlg.TFileDialog - Open }
|
|
reReformDocDlg = 'ReformDocDlg'; { Editors.MakeReformDocDlg }
|
|
reReplaceDlg = 'ReplaceDlg'; { Editors.CreateReplaceDialog }
|
|
reRightMarginDlg = 'RightMarginDlg'; { Editors.MakeRightMarginDlg }
|
|
reStatusLine = 'StatusLine'; { App.StatusLine }
|
|
reStrings = 'Strings'; { Resource.Strings }
|
|
reSaveAsDlg = 'SaveAsDlg'; { StdDlg.TFileDialog - Save As }
|
|
reTabStopDlg = 'TabStopDlg'; { Editors.MakeTabStopDlg }
|
|
reWindowListDlg = 'WindowListDlg'; { Editors.MakeWindowListDlg }
|
|
reAboutDlg = 'About'; { App unit about dialog }
|
|
|
|
{$I str.inc}
|
|
{ STR.INC declares all the string list constants used in the standard
|
|
Free Vision library units. They are placed in a separate file as a
|
|
template for use by the resource file generator, MakeRez.
|
|
|
|
Applications which use resource files and need to add strings of their
|
|
own should use STR.INC as the start for the resource file.
|
|
|
|
See MakeRez.PAS for more information about generating resource files.}
|
|
|
|
type
|
|
|
|
|
|
PConstant = ^TConstant;
|
|
TConstant = object(TObject)
|
|
Value: Word;
|
|
{ The value assigned to the constant. }
|
|
constructor Init (AValue: Word; AText: string);
|
|
{ Init assigns AValue to Value to AText to Text. AText may be an empty
|
|
string.
|
|
|
|
If an error occurs Init fails. }
|
|
destructor Done; virtual;
|
|
{ Done disposes of Text then calls the inherited destructor. }
|
|
procedure SetText (AText: string);
|
|
{ SetText changes FText to the word equivalent of AText. }
|
|
procedure SetValue (AValue: string);
|
|
{ SetValue changes Value to the word equivalent of AValue. }
|
|
function Text: string;
|
|
{ Text returns a string equivalent to FText. If FText is nil, an
|
|
empty string is returned. }
|
|
function ValueAsString: string;
|
|
{ ValueAsString returns the string equivalent of Value. }
|
|
private
|
|
FText: PString;
|
|
{ The text to display for the constant. }
|
|
end; { of TConstant }
|
|
|
|
|
|
PMemStringList = ^TMemStringList;
|
|
TMemStringList = object(TSortedCollection)
|
|
{ A TMemStringList combines the functions of a TStrListMaker and a
|
|
TStringList into one object, allowing generation and use of string
|
|
lists in the same application. TMemStringList is fully compatible
|
|
with string lists created using TStrListMaker, so legacy applications
|
|
will work without problems.
|
|
|
|
When using a string list in the same program as it is created, a
|
|
resource file is not required. This allows language independant coding
|
|
of units without the need for conditional defines and recompiling. }
|
|
constructor Init;
|
|
{ Creates an empty, in-memory string list that is not associated with a
|
|
resource file. }
|
|
constructor Load (var S: TStream);
|
|
{ Load creates a TStringList from which it gets its strings upon a call
|
|
to Get. The strings on the resource file may be loaded into memory
|
|
for editing by calling LoadList.
|
|
|
|
If initialized with Load, the stream must remain valid for the life
|
|
of this object. }
|
|
destructor Done; virtual;
|
|
{ Done deallocates the memory allocated to the string list. }
|
|
function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
|
|
{ Compare assumes Key1 and Key2 are Word values and returns:
|
|
|
|
-1 if Key1 < Key2
|
|
0 if Key1 = Key2
|
|
1 if Key1 > Key2 }
|
|
function Get (Key: Word): String; virtual;
|
|
{ GetKey searches for a string with a key matching Key and returns it.
|
|
An empty string is returned if a string with a matching Key is not
|
|
found.
|
|
|
|
If Count > 0, the in memory collection is searched. If List^.Count
|
|
is 0, the inherited Get method is called. }
|
|
procedure Insert (Item: Pointer); virtual;
|
|
{ If Item is not nil, Insert attempts to insert the item into the
|
|
collection. If a collection expansion error occurs Insert disposes
|
|
of Item by calling FreeItem.
|
|
|
|
Item must be a pointer to a TConstant or its descendant. }
|
|
function KeyOf (Item: Pointer): Pointer; virtual;
|
|
{ KeyOf returns a pointer to TConstant.Value. }
|
|
function LoadStrings: Sw_Integer;
|
|
{ LoadStrings reads all strings the associated resource file into
|
|
memory, places them in the collection, and returns 0.
|
|
|
|
If an error occurs LoadStrings returns the stream status error code
|
|
or a DOS error code. Possible DOS error codes include:
|
|
|
|
2: no associated resource file
|
|
8: out of memory }
|
|
function NewConstant (Value: Word; S: string): PConstant; virtual;
|
|
{ NewConstant is called by LoadStrings. }
|
|
procedure Put (Key: Word; S: String); virtual;
|
|
{ Put creates a new PConstant containing Key and Word then calls
|
|
Insert to place it in the collection. }
|
|
procedure Store (var S: TStream);
|
|
{ Store creates a TStrListMaker, fills it with the items in List,
|
|
writes the TStrListMaker to the stream by calling
|
|
TStrListMaker.Store, then disposes of the TStrListMaker. }
|
|
private
|
|
StringList: PStringList;
|
|
end; { of TMemStringList) }
|
|
|
|
|
|
var
|
|
|
|
{$ifdef cdResource}
|
|
Hints: PStringList;
|
|
{$else}
|
|
Hints: PMemStringList;
|
|
{$endif cdResource}
|
|
{ Hints is a string list for use within the application to provide
|
|
context sensitive help on the command line. Hints is always used in
|
|
the application. }
|
|
|
|
{$ifdef cdResource}
|
|
Strings: PStringList;
|
|
{$else}
|
|
Strings: PMemStringList;
|
|
{$endif cdResource}
|
|
{ Strings holds messages such as errors and general information that are
|
|
displayed at run-time, normally with MessageBox. Strings is always
|
|
used in the application. }
|
|
|
|
{$ifdef cdResource}
|
|
Labels: PStringList;
|
|
{$else}
|
|
Labels: PMemStringList;
|
|
{$endif cdResource}
|
|
{ Labels is a string list for use within the application when a
|
|
resource file is not used, or when creating a resource file. Labels
|
|
contains all text used in dialog titles, labels, buttons, menus,
|
|
statuslines, etc., used in the application which can be burned into
|
|
language specific resources. It does not contain any messages
|
|
displayed at run-time using MessageBox or the status line hints.
|
|
|
|
Using the Labels variable when creating views allows language
|
|
independant coding of views such as the MessageBox, StdDlg and Editors
|
|
units. }
|
|
|
|
RezFile: PResourceFile;
|
|
{ RezFile is a global variable used when the Free Vision library
|
|
is compiled using the cdResource conditional define, or when creating
|
|
resource files.
|
|
|
|
All standard Free Vision application resources are accessed from the
|
|
resource file using the reXXXX constants. Modify the STR.INC under a
|
|
new file name to create new language specific resource files. See the
|
|
MakeRez program file for more information. }
|
|
|
|
|
|
|
|
procedure DoneResource;
|
|
{ Done destructs all objects initialized in this unit and frees all
|
|
allocated heap. }
|
|
|
|
{$ifndef cdResource}
|
|
function InitResource: Boolean;
|
|
{$endif cdResource}
|
|
{ Init initializes the Hints and Strings for use with in memory strings
|
|
lists. Init should be used in applications which do not use a resource
|
|
file, or when creating resource files. }
|
|
|
|
{$ifdef cdResource}
|
|
function InitRezFile (AFile: FNameStr; Mode: Word;
|
|
var AResFile: PResourceFile): Sw_Integer;
|
|
{$endif cdResource}
|
|
{ InitRezFile initializes a new PResourceFile using the name passed in
|
|
AFile and the stream mode passed in Mode and returns 0.
|
|
|
|
If an error occurs InitRezFile returns the DOS error and AResFile is
|
|
invalid. Possible DOS error values include:
|
|
|
|
2: file not found or other stream initialization error
|
|
11: invalid format - not a valid resource file }
|
|
|
|
{$ifdef cdResource}
|
|
function LoadResource (AFile: FNameStr): Boolean;
|
|
{$endif cdResource}
|
|
{ Load is used to open a resource file for use in the application.
|
|
|
|
For Load to return True, the resource file must be properly opened and
|
|
assigned to RezFile and the Hints string list must be successfully loaded
|
|
from the stream. If an error occurs, Load displays an English error
|
|
message using PrintStr and returns False. }
|
|
|
|
function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
|
|
{ MergeLists moves all key/string pairs from Source to destination,
|
|
deleting them from Source. Duplicate strings are ignored. }
|
|
|
|
|
|
const
|
|
RMemStringList: TStreamRec = (
|
|
ObjType: idMemStringList;
|
|
VmtLink: Ofs(TypeOf(TMemStringList)^);
|
|
Load: @TMemStringList.Load;
|
|
Store: @TMemStringList.Store);
|
|
|
|
|
|
implementation
|
|
|
|
{****************************************************************************}
|
|
{ Private Declarations }
|
|
{****************************************************************************}
|
|
|
|
uses
|
|
Memory, Drivers;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant object }
|
|
{****************************************************************************}
|
|
{****************************************************************************}
|
|
{ TConstant.Init }
|
|
{****************************************************************************}
|
|
constructor TConstant.Init (AValue: Word; AText: string);
|
|
begin
|
|
if not inherited Init then
|
|
Fail;
|
|
Value := AValue;
|
|
FText := NewStr(AText);
|
|
if (FText = nil) and (AText <> '') then
|
|
begin
|
|
inherited Done;
|
|
Fail;
|
|
end;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant.Done }
|
|
{****************************************************************************}
|
|
destructor TConstant.Done;
|
|
begin
|
|
DisposeStr(FText);
|
|
inherited Done;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant.SetText }
|
|
{****************************************************************************}
|
|
procedure TConstant.SetText (AText: string);
|
|
begin
|
|
DisposeStr(FText);
|
|
FText := NewStr(AText);
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant.SetValue }
|
|
{****************************************************************************}
|
|
procedure TConstant.SetValue (AValue: string);
|
|
var
|
|
N: Word;
|
|
ErrorCode: Integer;
|
|
begin
|
|
Val(AValue,N,ErrorCode);
|
|
if ErrorCode = 0 then
|
|
Value := N;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant.Text }
|
|
{****************************************************************************}
|
|
function TConstant.Text: string;
|
|
begin
|
|
if (FText = nil) then
|
|
Text := ''
|
|
else Text := FText^;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TConstant.ValueAsString }
|
|
{****************************************************************************}
|
|
function TConstant.ValueAsString: string;
|
|
var
|
|
S: string[5];
|
|
begin
|
|
Str(Value,S);
|
|
ValueAsString := S;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList Object }
|
|
{****************************************************************************}
|
|
{****************************************************************************}
|
|
{ TMemStringList.Init }
|
|
{****************************************************************************}
|
|
constructor TMemStringList.Init;
|
|
begin
|
|
if not inherited Init(10,10) then
|
|
Fail;
|
|
StringList := nil;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Load }
|
|
{****************************************************************************}
|
|
constructor TMemStringList.Load (var S: TStream);
|
|
begin
|
|
if not inherited Init(10,10) then
|
|
Fail;
|
|
StringList := New(PStringList,Load(S));
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Done }
|
|
{****************************************************************************}
|
|
destructor TMemStringList.Done;
|
|
begin
|
|
if (StringList <> nil) then
|
|
Dispose(StringList,Done);
|
|
inherited Done;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Compare }
|
|
{****************************************************************************}
|
|
function TMemStringList.Compare (Key1, Key2: Pointer): Sw_Integer;
|
|
begin
|
|
if Word(Key1^) < Word(Key2^) then
|
|
Compare := -1
|
|
else Compare := Byte(Word(Key1^) > Word(Key2^));
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Get }
|
|
{****************************************************************************}
|
|
function TMemStringList.Get (Key: Word): string;
|
|
var
|
|
i: Sw_Integer;
|
|
S: string;
|
|
begin
|
|
if (StringList = nil) then
|
|
begin { started with Init, use in memory string list }
|
|
if Search(@Key,i) then
|
|
Get := PConstant(At(i))^.Text
|
|
else Get := '';
|
|
end
|
|
else begin
|
|
S := StringList^.Get(Key);
|
|
Get := S;
|
|
end;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Insert }
|
|
{****************************************************************************}
|
|
procedure TMemStringList.Insert (Item: Pointer);
|
|
var
|
|
i: Sw_Integer;
|
|
begin
|
|
if (Item <> nil) then
|
|
begin
|
|
i := Count;
|
|
inherited Insert(Item);
|
|
if (i = Count) then { collection expansion failed }
|
|
Dispose(PConstant(Item),Done);
|
|
end;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.KeyOf }
|
|
{****************************************************************************}
|
|
function TMemStringList.KeyOf (Item: Pointer): Pointer;
|
|
begin
|
|
KeyOf := @(PConstant(Item)^.Value);
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.LoadStrings }
|
|
{****************************************************************************}
|
|
function TMemStringList.LoadStrings: Sw_Integer;
|
|
procedure MakeEditableString (var Str: string);
|
|
const
|
|
SpecialChars: array[1..3] of Char = #3#10#13;
|
|
var
|
|
i, j: Byte;
|
|
begin
|
|
for i := 1 to 3 do
|
|
while (Pos(SpecialChars[i],Str) <> 0) do
|
|
begin
|
|
j := Pos(SpecialChars[i],Str);
|
|
System.Delete(Str,j,1);
|
|
case i of
|
|
1: System.Insert('#3',Str,j);
|
|
2: System.Insert('#10',Str,j);
|
|
3: System.Insert('#13',Str,j);
|
|
end;
|
|
end;
|
|
end;
|
|
var
|
|
Constant: PConstant;
|
|
i: Word;
|
|
S: string;
|
|
begin
|
|
LoadStrings := 0;
|
|
if (StringList = nil) then
|
|
begin
|
|
LoadStrings := 2;
|
|
Exit;
|
|
end;
|
|
for i := 0 to 65535 do
|
|
begin
|
|
S := StringList^.Get(i);
|
|
if (S <> '') then
|
|
begin
|
|
MakeEditableString(S);
|
|
Constant := NewConstant(i,S);
|
|
if LowMemory then
|
|
begin
|
|
if (Constant <> nil) then
|
|
Dispose(Constant,Done);
|
|
LoadStrings := 8; { out of memory }
|
|
Exit;
|
|
end;
|
|
Insert(Constant);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.NewConstant }
|
|
{****************************************************************************}
|
|
function TMemStringList.NewConstant (Value: Word; S: string): PConstant;
|
|
begin
|
|
NewConstant := New(PConstant,Init(Value,S));
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Put }
|
|
{****************************************************************************}
|
|
procedure TMemStringList.Put (Key: Word; S: string);
|
|
begin
|
|
Insert(New(PConstant,Init(Key,S)));
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ TMemStringList.Store }
|
|
{****************************************************************************}
|
|
procedure TMemStringList.Store (var S: TStream);
|
|
var
|
|
StrList: PStrListMaker;
|
|
Size: Word;
|
|
procedure Total (Constant: PConstant);{$ifndef FPC}far;{$endif}
|
|
begin
|
|
with Constant^ do
|
|
Inc(Size,Succ(Length(Text)));
|
|
end;
|
|
procedure AddString (Constant: PConstant);{$ifndef FPC}far;{$endif}
|
|
const
|
|
Numbers = ['0'..'9'];
|
|
var
|
|
i, j: Byte;
|
|
N: Byte;
|
|
ErrorCode: Integer;
|
|
S: string;
|
|
begin
|
|
with Constant^ do
|
|
begin
|
|
{ convert formatting characters }
|
|
S := Text;
|
|
while (Pos('#',S) <> 0) do
|
|
begin
|
|
i := Succ(Pos('#',S));
|
|
j := i;
|
|
if (Length(S) > j) then
|
|
Inc(j,Byte(S[Succ(j)] in Numbers));
|
|
Val(Copy(S,i,j-i+1),N,ErrorCode);
|
|
System.Delete(S,Pred(i),j-i+2);
|
|
System.Insert(Char(N),S,Pred(i));
|
|
end;
|
|
StrList^.Put(Value,Text)
|
|
end;
|
|
end;
|
|
begin
|
|
Size := 0;
|
|
ForEach(@Total);
|
|
StrList := New(PStrListMaker,Init(Size,Count * 6));
|
|
if (StrList = nil) then
|
|
begin
|
|
S.Status := 8; { DOS error not enough memory }
|
|
Exit;
|
|
end;
|
|
ForEach(@AddString);
|
|
StrList^.Store(S);
|
|
Dispose(StrList,Done);
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ Public Procedures and Functions }
|
|
{****************************************************************************}
|
|
|
|
{****************************************************************************}
|
|
{ Done }
|
|
{****************************************************************************}
|
|
procedure DoneResource;
|
|
begin
|
|
if (RezFile <> nil) then
|
|
begin
|
|
Dispose(RezFile,Done);
|
|
RezFile:=nil;
|
|
end;
|
|
if (Strings <> nil) then
|
|
begin
|
|
Dispose(Strings,Done);
|
|
Strings:=nil;
|
|
end;
|
|
if (Hints <> nil) then
|
|
begin
|
|
Dispose(Hints,Done);
|
|
Hints:=nil;
|
|
end;
|
|
if (Labels <> nil) then
|
|
begin
|
|
Dispose(Labels,Done);
|
|
Labels:=nil;
|
|
end;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ Init }
|
|
{****************************************************************************}
|
|
{$ifndef cdResource}
|
|
|
|
{$I strtxt.inc}
|
|
{ strtxt.inc contains the real strings and procedures InitRes... which
|
|
is converted from str.inc }
|
|
|
|
function InitResource: Boolean;
|
|
begin
|
|
InitResource := False;
|
|
Hints := New(PMemStringList,Init);
|
|
if (Hints = nil) then
|
|
begin
|
|
PrintStr('Fatal error. Could not create Hints list.');
|
|
Exit;
|
|
end;
|
|
Strings := New(PMemStringList,Init);
|
|
if (Strings = nil) then
|
|
begin
|
|
DoneResource;
|
|
Exit;
|
|
end;
|
|
Labels := New(PMemStringList,Init);
|
|
if (Labels = nil) then
|
|
begin
|
|
DoneResource;
|
|
Exit;
|
|
end;
|
|
{ now load the defaults }
|
|
InitResLabels;
|
|
InitResStrings;
|
|
InitResource := True;
|
|
end;
|
|
{$endif cdResource}
|
|
|
|
{****************************************************************************}
|
|
{ InitRezFile }
|
|
{****************************************************************************}
|
|
{$ifdef cdResource}
|
|
function InitRezFile (AFile: FNameStr; Mode: Word;
|
|
var AResFile: PResourceFile): Sw_Integer;
|
|
var
|
|
Stream: PBufStream;
|
|
Result: Sw_Integer;
|
|
begin
|
|
Stream := New(PBufStream,Init(AFile,Mode,RezBufferSize));
|
|
if (Stream = nil) then
|
|
Result := 2 { file not found; could also be out of memory }
|
|
else begin
|
|
AResFile := New(PResourceFile,Init(Stream));
|
|
if (AResFile = nil) then
|
|
begin
|
|
Dispose(Stream,Done);
|
|
Result := 11;
|
|
end
|
|
else Result := 0;
|
|
end;
|
|
InitRezFile := Result;
|
|
end;
|
|
{$endif cdResource}
|
|
|
|
{****************************************************************************}
|
|
{ Load }
|
|
{****************************************************************************}
|
|
{$ifdef cdResource}
|
|
function LoadResource (AFile: FNameStr): Boolean;
|
|
var
|
|
Stream: PBufStream;
|
|
begin
|
|
Load := False;
|
|
Stream := New(PBufStream,Init(AFile,stOpenRead,RezBufferSize));
|
|
if (Stream = nil) or (Stream^.Status <> 0) then
|
|
begin
|
|
Done;
|
|
PrintStr('Fatal error. Could not open resource file: ' + AFile);
|
|
Exit;
|
|
end;
|
|
RezFile := New(PResourceFile,Init(Stream));
|
|
if (RezFile = nil) then
|
|
begin
|
|
Dispose(Stream,Done);
|
|
Done;
|
|
PrintStr('Fatal error. Could not initialize resource file.');
|
|
Exit;
|
|
end;
|
|
Hints := PStringList(RezFile^.Get(reHints));
|
|
if (Hints = nil) then
|
|
begin
|
|
Done;
|
|
PrintStr('Fatal error. Could not load Hints string list.');
|
|
Exit;
|
|
end;
|
|
Strings := PStringList(RezFile^.Get(reStrings));
|
|
if (Strings = nil) then
|
|
begin
|
|
Done;
|
|
PrintStr('Fatal error. Could not load Strings string list.');
|
|
Exit;
|
|
end;
|
|
Load := True;
|
|
end;
|
|
{$endif cdResource}
|
|
|
|
{****************************************************************************}
|
|
{ MergeLists }
|
|
{****************************************************************************}
|
|
function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
|
|
var
|
|
Result: Sw_Integer;
|
|
procedure MoveItem (Constant: PConstant);{$ifndef FPC}far;{$endif}
|
|
var
|
|
j: Sw_Integer;
|
|
begin
|
|
if (Result = 0) and (not Dest^.Search(Dest^.KeyOf(Constant),j)) then
|
|
begin
|
|
j := Dest^.Count;
|
|
Dest^.Insert(Constant);
|
|
if (j = Dest^.Count) then
|
|
Result := 8
|
|
else Source^.Delete(Constant);
|
|
end;
|
|
end;
|
|
begin
|
|
if (Source = nil) or (Dest = nil) then
|
|
begin
|
|
MergeLists := 6;
|
|
Exit;
|
|
end;
|
|
Result := 0;
|
|
Source^.ForEach(@MoveItem);
|
|
MergeLists := Result;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{ Unit Initialization }
|
|
{****************************************************************************}
|
|
|
|
begin
|
|
RezFile := nil;
|
|
Hints := nil;
|
|
Strings := nil;
|
|
Labels := nil;
|
|
end.
|
|
|