wnadocquery.~pas

数据库查询。已经做成控件

{*******************************************************}
{                                                       }
{       单元说明：关贸通务管理系统公共函数库            }
{                  版权所有                             }
{       Copyright (c) 2002-2004, 关贸通科技有限公司     }
{                                                       }
{       创 建 者：罗克平                                }
{       创建日期：2004/02/21                            }
{       修 改 者：罗克平                                }
{       修改日期：2004/02/21                            }
{       版    本：V 1.0                                 }
{*******************************************************}

unit WNADOCQuery;

interface

uses
  WNADOQDlg, Dialogs, Windows, Messages, SysUtils, Classes, Controls,
  DB;

type
  TLkFieldType = (lftString, lftNumber, lftDatetime);

  TLkSearch = class;
  TLkCollectionItem = class;

  TFieldCollectionItem = class(TCollectionItem)
  private
    FDescription: string;
    FCode: string;
    FLkCollectionItem: TLkCollectionItem;
  public
    constructor Create(Collection: TCollection); override;
    constructor CreateApart(ALkCollectionItem: TLkCollectionItem);
    property LkCollectionItem: TLkCollectionItem read FLkCollectionItem;
  published
    property Code: string read FCode write FCode;
    property Description: string read FDescription write FDescription;
  end;

  TFieldCollectionItemClass = class of TFieldCollectionItem;

  TFieldCollection = class(TCollection)
  private
    FLkCollectionItem: TLkCollectionItem;
    function GetFieldItem(Index: Integer): TFieldCollectionItem;
    procedure SetFieldItem(Index: Integer;
      const Value: TFieldCollectionItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(ALkCollectionItem: TLkCollectionItem; FieldCollectionItemClass: TFieldCollectionItemClass);
    function Add: TFieldCollectionItem;
    property LkCollectionItem: TLkCollectionItem read FLkCollectionItem;
    property Items[Index: Integer]: TFieldCollectionItem read GetFieldItem write SetFieldItem; default;
  end;

  TLkCollectionItem = class(TCollectionItem)
  private
    FItemsList: TStringList;
    FFieldName: string;
    FDisplayText: string;
    FFieldType: TLkFieldType;
    FSelectValue: Boolean;
    FFieldItems: TFieldCollection;
    function GetItems: TStrings;
    procedure SetItems(const Value: TStrings);
    procedure SetFieldItems(const Value: TFieldCollection);

    function CreateFieldItems: TFieldCollection;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property DisplayText: string read FDisplayText write FDisplayText;
    property FieldName: string read FFieldName write FFieldName;
    property FieldType: TLkFieldType read FFieldType write FFieldType;
    property Items: TStrings read GetItems write SetItems;
    property SelectValue: Boolean read FSelectValue write FSelectValue;
    property FieldItems: TFieldCollection read FFieldItems write SetFieldItems;
  end;

  TLkCollection = class(TCollection)
  private
    FLkSearch: TLkSearch;
    function GetItem(Index: Integer): TLkCollectionItem;
    procedure SetItem(Index: Integer; const Value: TLkCollectionItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(ALkSearch: TLkSearch);
    function Add: TLkCollectionItem;
    property Items[Index: Integer]: TLkCollectionItem read GetItem write SetItem; default;
  end;

  TLkSearch = class(TComponent)
  private
    FDateSeperate: Char;
    FQryFormFontSize: Integer;
    FQryFormCaption: String;
    FItems: TLkCollection;
    FQueryTerm: WideString;

    FForm_WNADOQDlg: TForm_WNADOQDlg;
    FFileName: string;
    FDataSet: TDataSet;

    procedure SetDateSeperate(const Value: Char);
    procedure SetItems(const Value: TLkCollection);
    procedure SetDataSet(const Value: TDataSet);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    property QueryTerm: WideString read FQueryTerm write FQueryTerm;
  published
    property DateSeperate: Char read FDateSeperate write SetDateSeperate; //日期分隔符默认为单引号但是在Access中为'#'
    property QryFormFontSize: Integer read FQryFormFontSize write FQryFormFontSize default 12;  //* add by pely 20020325
    property QryFormCaption: string read FQryFormCaption write FQryFormCaption ;  //* add by pely 20020325
    property Fields: TLkCollection read FItems write SetItems;
    property FileName: string read FFileName write FFileName;
    property DataSet: TDataSet read FDataSet write SetDataSet;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LKP', [TLkSearch]);
end;

{ TLkCollection }

function TLkCollection.Add: TLkCollectionItem;
begin
  Result := TLkCollectionItem(inherited Add);
end;

constructor TLkCollection.Create(ALkSearch: TLkSearch);
begin
  inherited Create(TLkCollectionItem);
  FLkSearch := ALkSearch;
end;

function TLkCollection.GetItem(Index: Integer): TLkCollectionItem;
begin
  Result := TLkCollectionItem(inherited GetItem(Index));
end;

function TLkCollection.GetOwner: TPersistent;
begin
  Result := FLkSearch;
end;

procedure TLkCollection.SetItem(Index: Integer;
  const Value: TLkCollectionItem);
begin
  inherited SetItem(Index, Value);
end;

{ TLkSearch }

constructor TLkSearch.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TLkCollection.Create(Self);
end;

destructor TLkSearch.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TLkSearch.Execute: Boolean;
var
  iIndex, iCount: Integer;
  vWnFieldsArray: array of WNField;
begin
  iCount := Fields.Count;
  SetLength(vWnFieldsArray, iCount);
  for iIndex := 0 to Fields.Count - 1 do
  begin
    vWnFieldsArray[iIndex].FieldName := Fields[iIndex].FieldName;
    vWnFieldsArray[iIndex].FieldGut := Fields[iIndex].DisplayText;
    vWnFieldsArray[iIndex].FieldShowName := Fields[iIndex].DisplayText;
    vWnFieldsArray[iIndex].Items := Fields[iIndex].Items;
    vWnFieldsArray[iIndex].SelectValue := Fields[iIndex].SelectValue;
    case Fields[iIndex].FieldType of
      lftString: vWnFieldsArray[iIndex].FieldType := 1;
      lftNumber: vWnFieldsArray[iIndex].FieldType := 2;
      lftDatetime: vWnFieldsArray[iIndex].FieldType := 4;
    end;
  end;
  FForm_WNADOQDlg := TForm_WNADOQDlg.Create(Self);
  try
    FForm_WNADOQDlg.Open(vWnFieldsArray);
    FForm_WNADOQDlg.date_seperate := FDateSeperate;
    FForm_WNADOQDlg.Font.Size := FQryFormFontSize;  //* add by pely 20020325
    FForm_WNADOQDlg.Caption := FQryFormCaption;     //* add by pely 20020325
    FForm_WNADOQDlg.ShowModal;
    Result := FForm_WNADOQDlg.ISOK;
    QueryTerm := FForm_WNADOQDlg.QueryStr;
  finally
    FreeAndNil(FForm_WNADOQDlg);
  end;
end;

procedure TLkSearch.SetDataSet(const Value: TDataSet);
//var
//  iIndex: Integer;
//  vLkCollectionItem: TLkCollectionItem;
begin
{  FDataSet := Value;
  for iIndex := 0 to Value.FieldCount - 1 do
  begin
    vLkCollectionItem := Fields.Add;
    vLkCollectionItem.FieldName := Value.Fields[iIndex].FieldName;
    vLkCollectionItem.DisplayText := Value.Fields[iIndex].DisplayLabel;
    vLkCollectionItem.FieldType := lftString;
  end;}
end;

procedure TLkSearch.SetDateSeperate(const Value: Char);
begin
  FDateSeperate := Value;
end;

procedure TLkSearch.SetItems(const Value: TLkCollection);
begin
  FItems.Assign(Value);
end;

{ TLkCollectionItem }

constructor TLkCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FItemsList := TStringList.Create;
  FFieldItems := CreateFieldItems;
end;

function TLkCollectionItem.CreateFieldItems: TFieldCollection;
begin
  Result := TFieldCollection.Create(Self, TFieldCollectionItem);
end;

destructor TLkCollectionItem.Destroy;
begin
  FItemsList.Free;
  FFieldItems.Free;  
  inherited;
end;

function TLkCollectionItem.GetItems: TStrings;
begin
  Result := FItemsList;
end;

procedure TLkCollectionItem.SetFieldItems(const Value: TFieldCollection);
begin
  FFieldItems.Assign(Value);
end;

procedure TLkCollectionItem.SetItems(const Value: TStrings);
begin
  FItemsList.Assign(Value);
end;

{ TTieldCollectionItem }

constructor TFieldCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  if Assigned(Collection) and (Collection is TFieldCollection) then
    FLkCollectionItem := TFieldCollection(Collection).LkCollectionItem;
end;

constructor TFieldCollectionItem.CreateApart(
  ALkCollectionItem: TLkCollectionItem);
begin
  inherited Create(nil);
  FLkCollectionItem := ALkCollectionItem;
end;

{ TFieldCollection }

function TFieldCollection.Add: TFieldCollectionItem;
begin
  Result := TFieldCollectionItem(inherited Add);
end;

constructor TFieldCollection.Create(ALkCollectionItem: TLkCollectionItem;
  FieldCollectionItemClass: TFieldCollectionItemClass);
begin
  inherited Create(FieldCollectionItemClass);
  FLkCollectionItem := ALkCollectionItem;
end;

function TFieldCollection.GetFieldItem(
  Index: Integer): TFieldCollectionItem;
begin
  Result := TFieldCollectionItem(inherited Items[Index]);
end;

function TFieldCollection.GetOwner: TPersistent;
begin
  Result := FLkCollectionItem; 
end;

procedure TFieldCollection.SetFieldItem(Index: Integer;
  const Value: TFieldCollectionItem);
begin
  Items[Index].Assign(Value);
end;

procedure TFieldCollection.Update(Item: TCollectionItem);
begin
  inherited;
end;

end.