paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-15 10:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 470,483 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@522 -
This commit is contained in:
peter 2005-06-29 09:35:13 +00:00
parent 645b6201c9
commit 849b96191a
2 changed files with 123 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
fcl/inc/contnrs.pp
View File

@ -21,6 +21,28 @@ uses
SysUtils,Classes;
Type
{$inline on}
TFPObjectList = class(TFPList)
private
FFreeObjects : Boolean;
protected
function GetItem(Index: Integer): TObject; {$ifdef HASINLINE} inline;{$endif}
procedure SetItem(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
public
constructor Create;
constructor Create(FreeObjects : Boolean);
function Add(AObject: TObject): Integer; {$ifdef HASINLINE} inline;{$endif}
function Extract(Item: TObject): TObject;
function Remove(AObject: TObject): Integer;
function IndexOf(AObject: TObject): Integer;
function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt: Integer): Integer;
procedure Insert(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
function First: TObject;
function Last: TObject;
property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
property Items[Index: Integer]: TObject read GetItem write SetItem; default;
end;
TObjectList = class(TList)
private
@ -131,6 +153,92 @@ Type
implementation
constructor TFPObjectList.Create(FreeObjects : boolean);
begin
inherited Create;
FFreeObjects:=Freeobjects;
end;
constructor TFPObjectList.Create;
begin
inherited Create;
FFreeObjects:=True;
end;
function TFPObjectList.GetItem(Index: Integer): TObject; {$ifdef HASINLINE} inline;{$endif}
begin
Result:=TObject(inherited Get(Index));
end;
procedure TFPObjectList.SetItem(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
var
O : TObject;
begin
if OwnsObjects then
begin
O:=GetItem(Index);
O.Free;
end;
Put(Index,Pointer(AObject));
end;
function TFPObjectList.Add(AObject: TObject): Integer; {$ifdef HASINLINE} inline;{$endif}
begin
Result:=inherited Add(Pointer(AObject));
end;
function TFPObjectList.Extract(Item: TObject): TObject;
begin
Result:=Tobject(inherited Extract(Pointer(Item)));
end;
function TFPObjectList.Remove(AObject: TObject): Integer;
begin
Result:=inherited Remove(Pointer(AObject));
end;
function TFPObjectList.IndexOf(AObject: TObject): Integer;
begin
Result:=inherited indexOF(Pointer(AObject));
end;
function TFPObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt : Integer): Integer;
var
I : Integer;
begin
I:=AStartAt;
Result:=-1;
If AExact then
while (I<Count) and (Result=-1) do
If Items[i].ClassType=AClass then
Result:=I
else
Inc(I)
else
while (I<Count) and (Result=-1) do
If Items[i].InheritsFrom(AClass) then
Result:=I
else
Inc(I);
end;
procedure TFPObjectList.Insert(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
begin
inherited Insert(Index,Pointer(AObject));
end;
function TFPObjectList.First: TObject;
begin
Result := TObject(inherited First);
end;
function TFPObjectList.Last: TObject;
begin
Result := TObject(inherited Last);
end;
{ TObjectList }
constructor tobjectlist.create(freeobjects : boolean);
begin

27
fcl/inc/gettext.pp
View File

@ -70,6 +70,7 @@ type
EMOFileError = class(Exception);
procedure GetLanguageIDs(var Lang, FallbackLang: string);
procedure TranslateResourceStrings(AFile: TMOFile);
procedure TranslateResourceStrings(const AFilename: String);
@ -259,8 +260,6 @@ begin
end;
{$endif}
procedure TranslateResourceStrings(const AFilename: String);
{$ifdef win32}
procedure GetLanguageIDs(var Lang, FallbackLang: string);
var
@ -284,15 +283,11 @@ begin
Lang := FallbackLang+'_'+Country;
end;
end;
{$endif}
var
mo: TMOFile;
lang, FallbackLanguage: String;
{$else}
procedure GetLanguageIDs(var Lang, FallbackLang: string);
begin
{$ifdef win32}
GetLanguageIDs(Lang, FallbackLanguage);
{$else}
lang := GetEnv('LC_ALL');
if Length(lang) = 0 then
begin
@ -304,10 +299,18 @@ begin
exit; // no language defined via environment variables
end;
end;
FallbackLanguage := Copy(lang, 1, 2);
{$endif}
FallbackLang := Copy(lang, 1, 2);
end;
{$endif}
procedure TranslateResourceStrings(const AFilename: String);
var
mo: TMOFile;
lang, FallbackLang: String;
begin
GetLanguageIDs(Lang, FallbackLang);
try
mo := TMOFile.Create(Format(AFilename, [FallbackLanguage]));
mo := TMOFile.Create(Format(AFilename, [FallbackLang]));
try
TranslateResourceStrings(mo);
finally