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

Patch from Alexander S. Klenin

Browse Source 
* Implemented TLookupList.FirstKeyByValue and ValuesToStrings

git-svn-id: trunk@12344 -
This commit is contained in:
joost 2008-12-11 20:46:35 +00:00
parent 8056591845
commit 4b5bc94bff
1 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
packages/fcl-db/src/base/db.pas
View File

@ -251,7 +251,9 @@ type
destructor Destroy; override;
procedure Add(const AKey, AValue: Variant);
procedure Clear;
function FirstKeyByValue(const AValue: Variant): Variant;
function ValueOfKey(const AKey: Variant): Variant;
procedure ValuesToStrings(AStrings: TStrings);
end;
{ TField }
@ -2314,6 +2316,20 @@ begin
FList.Clear;
end;
function TLookupList.FirstKeyByValue(const AValue: Variant): Variant;
var
i: Integer;
begin
for i := 0 to FList.Count - 1 do
with PLookupListRec(FList[i])^ do
if Value = AValue then
begin
Result := Key;
exit;
end;
Result := Null;
end;
function TLookupList.ValueOfKey(const AKey: Variant): Variant;
Function VarArraySameValues(VarArray1,VarArray2 : Variant) : Boolean;
@ -2346,6 +2362,19 @@ begin
if i >= 0 then Result := PLookupListRec(FList.Items[I])^.Value;
end;
procedure TLookupList.ValuesToStrings(AStrings: TStrings);
var
i: Integer;
p: PLookupListRec;
begin
AStrings.Clear;
for i := 0 to FList.Count - 1 do
begin
p := PLookupListRec(FList[i]);
AStrings.AddObject(p^.Value, TObject(p));
end;
end;
procedure DisposeMem(var Buffer; Size: Integer);
begin
if Pointer(Buffer) <> nil then