tntunicodeqrpt3_register.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntUnicodeQRpt3_Register;

interface

{$I JVCL.Inc}

uses
{$IFDEF DELPHI6_UP}
  DesignIntf, DesignEditors
{$ELSE}
  DsgnIntf
{$ENDIF};

procedure Register;

implementation

uses
  DB, Classes, QuickRpt, TypInfo, TntQrCtrls;

const
  TNT_QREPORT = 'Tnt QReport';

type
  TDBStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TTntQRDataFieldProperty = class(TDBStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;


procedure Register;
begin
  // ------- QuickReport -------
  RegisterComponents(TNT_QREPORT, [TTntQRLabel]);
  RegisterComponents(TNT_QREPORT, [TTntQRMemo]);
  RegisterComponents(TNT_QREPORT, [TTntQRDBText]);
  RegisterComponents(TNT_QREPORT, [TTntQRSysData]);

  RegisterPropertyEditor(TypeInfo(string), TTntQRDBText, 'DataField', TTntQRDataFieldProperty);
end;

{ TQRDataFieldProperty }

function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
    Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
end;

procedure TTntQRDataFieldProperty.GetValueList(List: TStrings);
var
  DataSet: TDataSet;
begin
  DataSet := GetPropertyValue(GetComponent(0), 'DataSet') as TDataset;
  if (DataSet <> nil) then
    DataSet.GetFieldNames(List);
end;

{ TDBStringProperty }

function TDBStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TDBStringProperty.GetValueList(List: TStrings);
begin
end;

procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;


end.