jvqinspdb.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{******************************************************************************

 Project JEDI Visible Component Library (J-VCL)

 The contents of this file are subject to the Mozilla Public License Version
 1.1 (the "License"); you may not use this file except in compliance with the
 License. You may obtain a copy of the License at http://www.mozilla.org/MPL/

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Initial Developer of the Original Code is Marcel Bestebroer
  <marcelb att zeelandnet dott nl>.
 Portions created by Marcel Bestebroer are Copyright (C) 2000 - 2002 mbeSoft.
 All Rights Reserved.

******************************************************************************

 JvInspector data layer to inspect TField instances.

 You may retrieve the latest version of this file at the Project JEDI home
 page, located at http://www.delphi-jedi.org

******************************************************************************}

unit JvQInspDB;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes, DB, TypInfo, QDBCtrls,
  JvQInspector;

type
  TJvInspectorDBData = class(TJvCustomInspectorData)
  private
    FDataLink: TFieldDataLink;
  protected
    procedure ActiveChange(Sender: TObject); virtual;
    procedure DataChange(Sender: TObject); virtual;
    procedure EditingChange(Sender: TObject); virtual;
    function GetAsFloat: Extended; override;
    function GetAsInt64: Int64; override;
    function GetAsMethod: TMethod; override;
    function GetAsOrdinal: Int64; override;
    function GetAsString: string; override;
    function GetDataSource: TDataSource; virtual;
    function GetField: TField; virtual;
    function GetFieldName: string; virtual;
    procedure InitDB(const ADataSource: TDataSource; const AFieldName: string); virtual;
    function IsEqualReference(const Ref: TJvCustomInspectorData): Boolean; override;
    procedure SetAsFloat(const Value: Extended); override;
    procedure SetAsInt64(const Value: Int64); override;
    procedure SetAsMethod(const Value: TMethod); override;
    procedure SetAsOrdinal(const Value: Int64); override;
    procedure SetAsString(const Value: string); override;
    procedure SetDataSource(const Value: TDataSource); virtual;
    procedure SetField(const Value: TField); virtual;
    procedure SetFieldName(const Value: string); virtual;
    property DataLink: TFieldDataLink read FDataLink;
  public
    class function New(const AParent: TJvCustomInspectorItem; const ADataSource: TDataSource;
      const AFieldName: string): TJvCustomInspectorItem; overload;
    class function New(const AParent: TJvCustomInspectorItem;
      const ADataSource: TDataSource): TJvInspectorItemInstances; overload;
    class function New(const AParent: TJvCustomInspectorItem; const ADataSource: TDataSource;
      const AFieldNames: array of string): TJvInspectorItemInstances; overload;
    destructor Destroy; override;
    class function FieldTypeMapping: TJvInspectorRegister;
    procedure GetAsSet(var Buf); override;
    function HasValue: Boolean; override;
    function IsAssigned: Boolean; override;
    function IsInitialized: Boolean; override;
    class function ItemRegister: TJvInspectorRegister; override;
    procedure SetAsSet(const Buf); override;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Field: TField read GetField write SetField;
    property FieldName: string read GetFieldName write SetFieldName;
  end;

  TJvInspectorTFieldTypeRegItem = class(TJvCustomInspectorRegItem)
  private
    FFieldName: string;
    FFieldTable: string;
    FFieldType: TFieldType;
    FTypeInfo: PTypeInfo;
  public
    constructor Create(const AFieldName, AFieldTable: string; const AFieldType: TFieldType;
       ATypeInfo: PTypeInfo);
    function MatchValue(const ADataObj: TJvCustomInspectorData): Integer; override;
    function MatchPercent(const ADataObj: TJvCustomInspectorData): Integer; override;
    property FieldName: string read FFieldName;
    property FieldTable: string read FFieldTable;
    property FieldType: TFieldType read FFieldType;
    property TypeInfo: PTypeInfo read FTypeInfo;
  end;

function GetTableName(const AField: TField): string;
function GetFieldName(const AField: TField): string;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  QConsts,
  JvQResources;

var
  GlobalDBReg: TJvInspectorRegister = nil;
  GlobalMapReg: TJvInspectorRegister = nil;

function GetTableName(const AField: TField): string;
begin
  if AField.Origin <> '' then
  begin
    Result := AField.Origin;
    Delete(Result, Pos('.', Result) + 1, Length(Result));
  end
  else
    Result := '';
end;

function GetFieldName(const AField: TField): string;
begin
  if AField.Origin <> '' then
  begin
    Result := AField.Origin;
    Delete(Result, 1, Pos('.', Result));
    if Result = '' then
      Result := AField.FieldName;
  end
  else
    Result := AField.FieldName;
end;

//=== { TJvInspectorDBData } =================================================

destructor TJvInspectorDBData.Destroy;
begin
  inherited Destroy;
  DataLink.Free;
  FDataLink := nil;
end;

procedure TJvInspectorDBData.ActiveChange(Sender: TObject);
begin
  DoneEdits(True);
{  if Item.Editing then
    Item.DoneEdit(True);}
  Invalidate;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) and DataSource.DataSet.Active then
    InitEdits;
{  if (DataSource <> nil) and (DataSource.DataSet <> nil) and DataSource.DataSet.Active and
      (Item.Inspector.FocusedItem <> nil) then
    Item.Inspector.FocusedItem.InitEdit;}
end;

procedure TJvInspectorDBData.DataChange(Sender: TObject);
begin
  if (DataLink <> nil) and (DataLink.Field <> nil) then
  begin
    RefreshEdits;
{    if Item.Editing then
    begin
      Item.DoneEdit(True);
      Item.InitEdit;
    end;}
    InvalidateData;
    Invalidate;
  end;
end;

procedure TJvInspectorDBData.EditingChange(Sender: TObject);
begin
  Invalidate;
end;

function TJvInspectorDBData.GetAsFloat: Extended;
begin
  CheckReadAccess;
  if TypeInfo.Kind = tkFloat then
    Result := Field.AsFloat
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorFloat]);
end;

function TJvInspectorDBData.GetAsInt64: Int64;
begin
  CheckReadAccess;
  if TypeInfo.Kind = tkInt64 then
    Result := TLargeIntField(Field).AsLargeInt
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorInt64]);
end;

function TJvInspectorDBData.GetAsMethod: TMethod;
begin
  CheckReadAccess;
  raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorTMethod]);
end;

function TJvInspectorDBData.GetAsOrdinal: Int64;
begin
  CheckReadAccess;
  if Field is TBooleanField then
    Result := Ord(TBooleanField(Field).AsBoolean)
  else
  if TypeInfo.Kind in [tkInteger, tkChar, tkEnumeration, tkSet, tkWChar, tkClass] then
  begin
    if GetTypeData(TypeInfo).OrdType = otULong then
      Result := Cardinal(Field.AsInteger)
    else
      Result := Field.AsInteger;
  end
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorOrdinal]);
end;

function TJvInspectorDBData.GetAsString: string;
begin
  CheckReadAccess;
  if TypeInfo.Kind in [tkString, tkLString, tkWString] then
    Result := Field.AsString
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorString]);
end;

function TJvInspectorDBData.GetDataSource: TDataSource;
begin
  if DataLink <> nil then
    Result := DataLink.DataSource
  else
    Result := nil;
end;

function TJvInspectorDBData.GetField: TField;
begin
  if (DataSource <> nil) and (DataSource.DataSet <> nil) and (FieldName <> '') then
    Result := DataSource.DataSet.FindField(FieldName)
  else
    Result := nil;
end;

function TJvInspectorDBData.GetFieldName: string;
begin
  if DataLink <> nil then
    Result := DataLink.FieldName
  else
    Result := '';
end;

procedure TJvInspectorDBData.InitDB(const ADataSource: TDataSource; const AFieldName: string);
var
  MapItem: TJvCustomInspectorRegItem;
  ATypeInfo: PTypeInfo;
begin
  if DataLink = nil then
    FDataLink := TFieldDataLink.Create;
  DataLink.DataSource := ADataSource;
  DataLink.FieldName := AFieldName;
  DataLink.OnDataChange := DataChange;
  DataLink.OnActiveChange := ActiveChange;
  DataLink.OnEditingChange := EditingChange;
  MapItem := FieldTypeMapping.FindMatch(Self);
  if MapItem <> nil then
    ATypeInfo := TJvInspectorTFieldTypeRegItem(MapItem).TypeInfo
  else
    ATypeInfo := nil;
  if Field <> nil then
  begin
    Name := Field.DisplayName;
    TypeInfo := ATypeInfo;
  end
  else
  begin
    Name := AFieldName;
    TypeInfo := nil;
  end;
end;

function TJvInspectorDBData.IsEqualReference(const Ref: TJvCustomInspectorData): Boolean;
begin
  Result := (Ref is TJvInspectorDBData) and (TJvInspectorDBData(Ref).Field = Field);
end;

procedure TJvInspectorDBData.SetAsFloat(const Value: Extended);
begin
  CheckWriteAccess;
  if TypeInfo.Kind = tkFloat then
  begin
    DataLink.Edit;
    Field.AsFloat := Value;
  end
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorFloat]);
end;

procedure TJvInspectorDBData.SetAsInt64(const Value: Int64);
begin
  CheckWriteAccess;
  if TypeInfo.Kind = tkInt64 then
  begin
    DataLink.Edit;
    TLargeIntField(Field).AsLargeInt := Value;
  end
  else
    raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorInt64]);
end;

procedure TJvInspectorDBData.SetAsMethod(const Value: TMethod);
begin
  CheckWriteAccess;
  raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorTMethod]);
end;

procedure TJvInspectorDBData.SetAsOrdinal(const Value: Int64);
var
  MinValue: Int64;
  MaxValue: Int64;
begin
  CheckWriteAccess;
  if Field is TBooleanField then
  begin
    DataLink.Edit;
    TBooleanField(Field).AsBoolean := Value <> 0;
  end
  else
  if TypeInfo.Kind in [tkInteger, tkChar, tkEnumeration, tkWChar] then
  begin
    case GetTypeData(TypeInfo).OrdType of
      otSByte:
        begin
          MinValue := GetTypeData(TypeInfo).MinValue;
          MaxValue := GetTypeData(TypeInfo).MaxValue;
          if (Value < MinValue) or (Value > MaxValue) then
            raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]);
          DataLink.Edit;
          Field.AsInteger := Shortint(Value)
        end;
      otUByte:
        begin
          MinValue := GetTypeData(TypeInfo).MinValue;
          MaxValue := GetTypeData(TypeInfo).MaxValue;
          if (Value < MinValue) or (Value > MaxValue) then
            raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]);
          DataLink.Edit;
          Field.AsInteger := Byte(Value)
        end;
      otSWord:
        begin