* Patch from Ing. Petr Kristan

  - Add dlerror() to dl unit
  - Add CurValue to TField in db.pp
  - Add TCurrencyfield to db.pp
  - Add TDataset.IslinkedTo to db.pp
  - Add ShellExecuteEx call to shellapi

git-svn-id: trunk@167 -

fcl/db/dataset.inc

@@ -1391,6 +1391,20 @@ begin
   Result:=(Bof and Eof);
 end;
 
+Function TDataset.IsLinkedTo(DataSource: TDataSource): Boolean;
+
+begin
+//!! Not tested, I never used nested DS
+  if (DataSource = nil) or (DataSource.Dataset = nil) then begin
+    Result := False
+  end else if DataSource.Dataset = Self then begin
+    Result := True;
+  end else begin
+    Result := DataSource.Dataset.IsLinkedTo(DataSource.Dataset.DataSource);
+  end;
+//!! DataSetField not implemented
+end;
+
 Function TDataset.IsSequenced: Boolean;
 
 begin
@@ -1724,6 +1738,12 @@ begin
   DataEvent(deUpdateRecord, 0);
 end;
 
+Function TDataSet.UpdateStatus: TUpdateStatus;
+
+begin
+  Result:=usUnmodified;
+end;
+
 Procedure TDataset.RemoveField (Field : TField);
 
 begin
@@ -1776,6 +1796,12 @@ begin
   Result := False;
 end;
 
+Function TDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; 
+
+begin
+  Result := False;
+end;
+          
 
 Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
 
@@ -1783,7 +1809,6 @@ begin
   FDataSources.Remove(ADataSource);
 end;
 
-
 {
   $Log: dataset.inc,v $
   Revision 1.36  2005/04/13 22:08:16  joost

fcl/db/db.pp

@@ -160,6 +160,7 @@ type
     Function AddFieldDef : TFieldDef;
     procedure Assign(FieldDefs: TFieldDefs);
     procedure Clear;
+    procedure Delete(Index: Longint);
     function Find(const AName: string): TFieldDef;
     function IndexOf(const AName: string): Longint;
     procedure Update;
@@ -254,6 +255,8 @@ type
     function GetDataSize: Word; virtual;
     function GetDefaultWidth: Longint; virtual;
     function GetDisplayName : String;
+    function GetCurValue: Variant; virtual;
+    function GetNewValue: Variant; virtual;
     function GetIsNull: Boolean; virtual;
     function GetParentComponent: TComponent; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
@@ -270,6 +273,7 @@ type
     procedure SetAsVariant(AValue: variant); virtual;
     procedure SetAsString(const AValue: string); virtual;
     procedure SetDataType(AValue: TFieldType);
+    procedure SetNewValue(const AValue: Variant);
     procedure SetSize(AValue: Word); virtual;
     procedure SetParentComponent(AParent: TComponent); override;
     procedure SetText(const AValue: string); virtual;
@@ -298,6 +302,7 @@ type
     property AttributeSet: string read FAttributeSet write FAttributeSet;
     property Calculated: Boolean read FCalculated write FCalculated;
     property CanModify: Boolean read FCanModify;
+    property CurValue: Variant read GetCurValue;
     property DataSet: TDataSet read FDataSet write SetDataSet;
     property DataSize: Word read GetDataSize;
     property DataType: TFieldType read FDataType;
@@ -306,6 +311,7 @@ type
     property FieldNo: Longint read FFieldNo;
     property IsIndexField: Boolean read FIsIndexField;
     property IsNull: Boolean read GetIsNull;
+    property NewValue: Variant read GetNewValue write SetNewValue;
     property Offset: word read FOffset;
     property Size: Word read FSize write FSize;
     property Text: string read FEditText write FEditText;
@@ -443,6 +449,7 @@ type
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : largeint) : Boolean;
     property Value: Longint read GetAsLongint write SetAsLongint;
+    property AsLargeInt: LargeInt read GetAsLargeint write SetAsLargeint;
   published
     property MaxValue: Largeint read FMaxValue write SetMaxValue default 0;
     property MinValue: Largeint read FMinValue write SetMinValue default 0;
@@ -504,6 +511,13 @@ type
     property Precision: Longint read FPrecision write FPrecision default 15;
   end;
 
+{ TCurrencyField }
+
+  TCurrencyField = class(TFloatField)
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+  end;
 
 { TBooleanField }
 
@@ -617,6 +631,7 @@ type
     function GetAsFloat: Double; override;
     function GetAsLongint: Longint; override;
     function GetAsString: string; override;
+    function GetValue(var AValue: Currency): Boolean;
     function GetAsVariant: variant; override;
     function GetDataSize: Word; override;
     function GetDefaultWidth: Longint; override;
@@ -1068,9 +1083,11 @@ type
     procedure Insert;
     procedure InsertRecord(const Values: array of const);
     function IsEmpty: Boolean;
+    function IsLinkedTo(DataSource: TDataSource): Boolean;
     function IsSequenced: Boolean; virtual;
     procedure Last;
     function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; virtual;
+    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; virtual;
     function MoveBy(Distance: Longint): Longint;
     procedure Next;
     procedure Open;
@@ -1082,6 +1099,7 @@ type
     function  Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
     procedure UpdateCursorPos;
     procedure UpdateRecord;
+    function UpdateStatus: TUpdateStatus; virtual;
     property BOF: Boolean read FBOF;
     property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
     property CanModify: Boolean read GetCanModify;
@@ -1696,6 +1714,7 @@ Procedure DatabaseError (Const Msg : String; Comp : TComponent);
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                             Comp : TComponent);
+Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
 
 implementation
 
@@ -1731,6 +1750,21 @@ begin
   Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
 end;
 
+Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
+
+var
+  i: integer;
+begin
+  for i := Pos to Length(Fields) do begin
+    if Fields[i] = ';' then begin
+      Result := Copy(Fields, Pos, i - Pos);
+      Pos := i + 1;
+      Exit;
+    end;
+  end;
+  Result := Copy(Fields, Pos, Length(Fields));
+  Pos := Length(Fields) + 1;
+end;
 
 { TIndexDef }
 

fcl/db/fields.inc

@@ -154,6 +154,16 @@ begin
   Result:=TFieldDef(FItems[Index]);
 end;
 
+procedure TFieldDefs.Delete(Index: Longint);
+
+var
+  c: TComponent;
+begin
+  c := GetItem(Index);
+  RemoveComponent(c);
+  //c.Free; maybe not needed?
+end;
+
 constructor TFieldDefs.Create(ADataSet: TDataSet);
 
 begin
@@ -397,16 +407,58 @@ end;
 
 function TField.GetOldValue: Variant;
 
-var SaveState : tDatasetState;
+var SaveState : TDatasetState;
 
 begin
-  with FDataset do
-    begin
-    SaveState := State;
-    SetTempState(dsOldValue);
+  SaveState := FDataset.State;
+  try
+    FDataset.SetTempState(dsOldValue);
     Result := GetAsVariant;
-    RestoreState(SaveState);
-    end;
+  finally
+    FDataset.RestoreState(SaveState);
+  end;
+end;
+
+function TField.GetNewValue: Variant;
+
+var SaveState : TDatasetState;
+
+begin
+  SaveState := FDataset.State;
+  try
+    FDataset.SetTempState(dsNewValue);
+    Result := GetAsVariant;
+  finally
+    FDataset.RestoreState(SaveState);
+  end;
+end;
+
+procedure TField.SetNewValue(const AValue: Variant);
+
+var SaveState : TDatasetState;
+
+begin
+  SaveState := FDataset.State;
+  try
+    FDataset.SetTempState(dsNewValue);
+    SetAsVariant(AValue);
+  finally
+    FDataset.RestoreState(SaveState);
+  end;
+end;
+
+function TField.GetCurValue: Variant;
+
+var SaveState : TDatasetState;
+
+begin
+  SaveState := FDataset.State;
+  try
+    FDataset.SetTempState(dsCurValue);
+    Result := GetAsVariant;
+  finally
+    FDataset.RestoreState(SaveState);
+  end;
 end;
 
 function TField.GetCanModify: Boolean;
@@ -1421,6 +1473,41 @@ begin
     Result:=True;
 end;
 
+{ TCurrencyField }
+
+Constructor TCurrencyField.Create(AOwner: TComponent);
+
+begin
+  inherited Create(AOwner);
+  SetDataType(ftCurrency);
+end;
+
+procedure TCurrencyField.GetText(var TheText: string; ADisplayText: Boolean);
+
+Var
+    fmt : string;
+    ff: TFloatFormat;
+    E : Double;
+
+begin
+  TheText:='';
+  If Not GetData(@E) then exit;
+  If ADisplayText or (Length(FEditFormat) = 0) Then
+    Fmt:=FDisplayFormat
+  else
+    Fmt:=FEditFormat;
+
+  if ADisplayText then 
+    ff := ffCurrency 
+  else 
+    ff := ffFixed;
+        
+  If fmt<>'' then
+    TheText:=FormatFloat(fmt, E)
+  else
+    TheText:=FloatToStrF(E, ff, FPrecision, CurrencyDecimals);
+end;
+
 
 { TBooleanField }
 
@@ -1825,6 +1912,12 @@ begin
     Result:='';
 end;
 
+function TBCDField.GetValue(var AValue: Currency): Boolean;
+
+begin
+  Result := GetData(@AValue);
+end;
+  
 function TBCDField.GetDataSize: Word;
 
 begin

packages/extra/winunits/shellapi.pp

@@ -93,6 +93,10 @@ Function ShellExecuteW(hwnd: HWND;lpOperation : LPCWSTR ; lpFile : LPCWSTR ; lpP
 Function ShellExecute(HWND: hwnd;lpOperation : LPCSTR ; lpFile : LPCSTR ; lpParameters : LPCSTR; lpDirectory:  LPCSTR; nShowCmd:LONGINT):HInst; external 'shell32.dll' name 'ShellExecuteA';
 Function ShellExecute(hwnd: HWND;lpOperation : LPCWSTR ; lpFile : LPCWSTR ; lpParameters : LPCWSTR; lpDirectory:  LPCWSTR; nShowCmd:LONGINT):HInst; external 'shell32.dll' name 'ShellExecuteW';
 
+Function ShellExecuteEx(lpExecInfo: LPSHELLEXECUTEINFO):BOOL; external 'shell32.dll' name 'ShellExecuteEx';
+Function ShellExecuteExA(lpExecInfo: LPSHELLEXECUTEINFOA):BOOL; external 'shell32.dll' name 'ShellExecuteExA';
+Function ShellExecuteExW(lpExecInfo: LPSHELLEXECUTEINFOW):BOOL; external 'shell32.dll' name 'ShellExecuteExW';
+
 Function FindExecutableA(lpFile : LPCSTR ;lpDirectory : LPCSTR ; lpResult : LPSTR):HInst;external 'shell32.dll' name 'FindExecutableA';
 Function FindExecutableW(lpFile : LPCWSTR;lpDirectory : LPCWSTR; lpResult : LPWSTR):HInst;external 'shell32.dll' name 'FindExecutableW';
 Function FindExecutable(lpFile : LPCSTR ;lpDirectory : LPCSTR ; lpResult : LPSTR):HInst;external 'shell32.dll' name 'FindExecutableA';

rtl/unix/dl.pp

@@ -20,6 +20,7 @@ Const
 Function dlopen(Name : PChar; Flags : longint) : Pointer; cdecl; external libdl;
 FUnction dlsym(Lib : Pointer; Name : Pchar) : Pointer; cdecl; external Libdl;
 Function dlclose(Lib : Pointer) : Longint; cdecl; external libdl;
+Function dlerror() : Pchar; cdecl; external libdl;
 
 implementation