Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d3456/ALEXSOFT.ZIP/DBSEARCH.PAS

Pascal/Delphi Source File | 2001-09-29 | 8.3 KB | 273 lines

(*////////////////////////////////////////////////////////////////////////////
//   Part of AlexSoft VCL/DLL Library.                                      //
//   All rights reserved. (c) Copyright 1998.                               //
//   Created by: Alex Rabichooc                                             //
//**************************************************************************//
//  Users of this unit must accept this disclaimer of warranty:             //
//    "This unit is supplied as is. The author disclaims all warranties,    //
//    expressed or implied, including, without limitation, the warranties   //
//    of merchantability and of fitness for any purpose.                    //
//    The author assumes no liability for damages, direct or                //
//    consequential, which may result from the use of this unit."           //
//                                                                          //
//  This Unit is donated to the public as public domain.                    //
//                                                                          //
//  This Unit can be freely used and distributed in commercial and          //
//  private environments provided this notice is not modified in any way.   //
//                                                                          //
//  If you do find this Unit handy and you feel guilty for using such a     //
//  great product without paying someone - sorry :-)                        //
//                                                                          //
//  Please forward any comments or suggestions to Alex Rabichooc at:        //
//                                                                          //
//  [e-mail] or [e-mail]                         //
/////////////////////////////////////////////////////////////////////////////*)

unit DBSearch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db,
 {$IFDEF VER140}
  DesignEditors, Designintf
 {$ELSE}
  Dsgnintf
 {$ENDIF};

type
  TSearchKind = (skNormal, skExtended, skContext);

  TFields = class;

  TFieldItem = class(TCollectionItem)
  private
    FFieldName: String;
    function GetField: TField;
  public
    property Field: TField read GetField;
  published
    property FieldName: String read FFieldName write FFieldName;
  end;

  TFieldItemClass = class of TFieldItem;
  TRaDBSearch = class;

  TFields = class(TCollection)
  private
    FDBSearch: TRaDBSearch;
    function GetField(Index: Integer): TFieldItem;
    procedure SetField(Index: Integer; Value: TFieldItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(ADBSearch: TRaDBSearch; AClass: TFieldItemClass);
    function Add: TFieldItem;
    property SearchComp: TRaDBSearch read FDBSearch;
    property Fields[Index: Integer]: TFieldItem read GetField
                                                write SetField; default;
  end;

  TRaDBSearch = class(TComponent)
  private
    FFields: TFields;
    FDataSet: TDataSet;
    FSearchKind: TSearchKind;
    function GetDataSet: TDataSet;
    procedure SetDataSet(Value: TDataSet);
    procedure SetSearchKind(const Value: TSearchKind);
  protected
    procedure Notification(AComponent: TComponent;
                                          Operation: TOperation); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadFields(Reader: TReader);
    procedure WriteFields(Writer: TWriter);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute(DefaultField: TField): Boolean;
    property Fields: TFields read FFields;
  published
    property DataSet: TDataSet read GetDataSet write SetDataSet;
    property SearchKind: TSearchKind read FSearchKind write SetSearchKind;
  end;

  TFieldsEditor = class(TComponentEditor)
  public
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): String; override;
    procedure ExecuteVerb(Index: Integer); override;
  end;

implementation

uses fmFields, DBTools;

{TFieldItem}
function TFieldItem.GetField: TField;
var ADataSet: TDataSet;
begin
  if Collection is TFields then
     ADataSet := (Collection as TFields).FDBSearch.DataSet
    else
     ADataSet := nil;
  if (ADataSet <> nil) then
     Result := ADataSet.FindField(FFieldName)
    else
     Result := nil;
end;

{TFields}
constructor TFields.Create(ADBSearch: TRaDBSearch; AClass: TFieldItemClass);
begin
  inherited Create(AClass);
  FDBSearch := ADBSearch;
end;

function TFields.GetOwner: TPersistent;
begin
  Result := FDBSearch;
end;

function TFields.Add: TFieldItem;
begin
  Result := TFieldItem(inherited Add);
end;

function TFields.GetField(Index: Integer): TFieldItem;
begin
  Result := TFieldItem(inherited Items[Index]);
end;

procedure TFields.SetField(Index: Integer; Value: TFieldItem);
begin
   TFieldItem(inherited Items[Index]).Assign(Value);
end;

{TRaDBSearch}
constructor TRaDBSearch.Create(AOwner: TComponent);
begin
   Inherited;
   FFields := TFields.Create(Self, TFieldItem);
end;

destructor TRaDBSearch.Destroy;
begin
   if FFields <> nil then
     FFields.Free;
   Inherited;
end;

procedure TRaDBSearch.Notification(AComponent: TComponent;
                                             Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataSet <> nil) and
    (AComponent = FDataSet) then
      FDataSet := nil;
end;

procedure TRaDBSearch.DefineProperties(Filer: TFiler);
begin
   Inherited;
   Filer.DefineProperty('Fields', ReadFields, WriteFields, True);
end;

procedure TRaDBSearch.ReadFields(Reader: TReader);
begin
  FFields.Clear;
  Reader.ReadValue;
  Reader.ReadCollection(FFields);
end;

procedure TRaDBSearch.WriteFields(Writer: TWriter);
begin
  Writer.WriteCollection(FFields);
end;

function TRaDBSearch.GetDataSet: TDataSet;
begin
   Result := FDataSet;
end;

procedure TRaDBSearch.SetDataSet(Value: TDataSet);
begin
   if Value <> FDataSet then
     FDataSet := Value;
end;

function TRaDBSearch.Execute(DefaultField: TField): Boolean;
var AList: TList;
    i: Integer;
begin
   AList := TList.Create;
   try
      for i := 0 to FFields.Count-1 do
        if FFields[i].Field <> nil then
           AList.Add(FFields[i].Field);
      Result := DBTools.DBSearch(FDataSet, AList, DefaultField, Owner, SearchKind);
   finally
      AList.Free;
   end;
end;

procedure TRaDBSearch.SetSearchKind(const Value: TSearchKind);
begin
  FSearchKind := Value;
end;

{TFieldsEditor}
function TFieldsEditor.GetVerbCount: Integer;
begin
   Result := 1;
end;

function TFieldsEditor.GetVerb(Index: Integer): String;
begin
   case Index of
     0: Result := '&Define fields';
   end;
end;

procedure TFieldsEditor.ExecuteVerb(Index: Integer);
var Dialog: TfmGetFields;
    SearchComponent: TRaDBSearch;
    i: Integer;
    AList: TList;
begin
   case Index of
      0:
        begin
           SearchComponent := Component as TRaDBSearch;
           AList := TList.Create;
           try
             for i := 0 to SearchComponent.FFields.Count-1 do
               if SearchComponent.FFields[i].Field <> nil then
                 AList.Add(SearchComponent.FFields[i].Field);
               Dialog := TFmGetFields.CreateWithDataSet(Application,
                                                    SearchComponent.FDataSet,
                                                    AList);
             Dialog.Caption := Format('%s.%sFields', [Component.Owner.Name,
                                                    Component.Name]);
             try
               if Dialog.ShowModal = mrOk then
               with Dialog.lbSelFields do
               begin
                  SearchComponent.FFields.Clear;
                  for i := 0 to Items.Count-1 do
                     SearchComponent.FFields.Add.FieldName := Items[i];
                  Designer.Modified;
               end;
             finally
               Dialog.Free;
             end;
           finally
             AList.Free;
           end;
        end;
   end;
end;

end.