afforms.pas

来自「delphi编程控件」· PAS 代码 · 共 1,231 行 · 第 1/3 页

unit afforms;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface

uses Classes, SysUtils, Windows, Controls, adbtempl, stdctrls, DB, Graphics,
  ExtCtrls, ComCtrls, Forms;

{$I aclver.inc}

type
TCustomAutoFilterForm = class;
TAutoFilterFields = class;
TAutoFilterField = class;

TFilterFieldValue = (ffvFont, ffvAlignment, ffvCaption);
TFilterFieldValues = set of TFilterFieldValue;

TFilterFieldClass = class of TAutoFilterField;

TAutoFilterField = class(TCollectionItem)
private
  FField : TField;
  FFieldName : string;
  FFont : TFont;
  FAlignment : TAlignment;
  FCaption : String;
  FAssignedValues : TFilterFieldValues;

  function GetAlignment : TAlignment;
  function GetCaption : String;
  function GetField : TField;
  function GetFont : TFont;

  function GetDBDefControl : TAutoDBDefControl;

  function IsAlignmentStored : Boolean;
  function IsCaptionStored : Boolean;
  function IsFontStored : Boolean;

  procedure SetAlignment(Value : TAlignment);
  procedure SetCaption(Value : String);
  procedure SetField(Value : TField);
  procedure SetFieldName(const Value : String);
  procedure SetFont(Value : TFont);
protected
  function  GetFilterForm : TCustomAutoFilterForm;
  procedure RefreshDefaultFont;
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source : TPersistent); override;

  function DefaultAlignment : TAlignment;
  function DefaultCaption : String;
  function DefaultFont : TFont;

  procedure RestoreDefaults;

  property AssignedValues : TFilterFieldValues read FAssignedValues;
  property DBDefControl : TAutoDBDefControl read GetDBDefControl;
  property Field : TField read GetField write SetField;
  property FilterForm : TCustomAutoFilterForm read GetFilterForm;
published
  property  Alignment : TAlignment read GetAlignment write SetAlignment
     stored IsAlignmentStored;
  property Caption : String read GetCaption write SetCaption stored IsCaptionStored;
  property FieldName : String read FFieldName write SetFieldName;
  property Font : TFont read GetFont write SetFont stored IsFontStored;
end;

TAutoFilterFields = class(TCollection)
private
  FFilterForm : TCustomAutoFilterForm;

  function GetField(Index : Integer): TAutoFilterField;
  procedure SetField(Index : Integer; Value : TAutoFilterField);
public
  constructor Create(AFilterForm : TCustomAutoFilterForm);
  function Add : TAutoFilterField;
  procedure Assign(Source: TPersistent); override;
  procedure RestoreDefaults;
  procedure RebuildFields;
  property FilterForm : TCustomAutoFilterForm read FFilterForm;
  property Items[Index : Integer]: TAutoFilterField read GetField write SetField; default;
end;

TAutoFilterFormCloseEvent = procedure(Sender : TObject; AClose : Boolean) of object;

TFilterTabControl = class(TTabControl);
TFilterScrollBox = class(TScrollBox);

TCustomAutoFilterForm = class(TComponent)
private
  FCaption : String;
  FDataSet : TDataSet;
  FActive : Boolean;
  FFilterFields : TAutoFilterFields;
  FLabelAlignment : TAlignment;
  FLabelFont : TFont;
  FRepository : TAutoRepository;
  TabControl : TFilterTabControl;
  ScrollBox : TFilterScrollBox;
  FMaxPageNumber : Integer;
  FShowEvent : TNotifyEvent;
  FCloseEvent : TAutoFilterFormCloseEvent;

  function GetIsFilterForm : Boolean;
  procedure SetActive(Value : Boolean);
  procedure SetDataSet(Value : TDataSet);
  procedure SetLabelFont(Value : TFont);
  procedure SetFilterFields(Value : TAutoFilterFields);
protected
  function GetFilter : String;
  procedure BeforeShow; virtual;
  procedure DataSetChanged; virtual;

  property Active : Boolean read FActive write SetActive;
  property Caption : String read FCaption write FCaption;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  procedure CloseUp(Accept : Boolean); virtual;
  procedure Show;

  property DataSet : TDataSet read FDataSet write SetDataSet;
  property FilterFields : TAutoFilterFields read FFilterFields write SetFilterFields;
  property LabelAlignment : TAlignment read FLabelAlignment write FLabelAlignment;
  property LabelFont : TFont read FLabelFont write SetLabelFont;
  property Repository : TAutoRepository read FRepository write FRepository;
  property OnShow : TNotifyEvent read FShowEvent write FShowEvent;
  property OnClose : TAutoFilterFormCloseEvent read FCloseEvent write FCloseEvent;


  property IsFilterForm : Boolean read GetIsFilterForm;
end;

TAutoLocateForm = class(TCustomAutoFilterForm)
public
  procedure CloseUp(Accept : Boolean); override;
published
  property Active;
  property Caption;
  property DataSet;
  property FilterFields;
  property LabelAlignment;
  property LabelFont;
  property Repository;
  property OnShow;
  property OnClose;
end;

TAutoFilterForm = class;

TAutoFilterFormDataLink = class(TDataLink)
private
  FFilterForm : TAutoFilterForm;
protected
  procedure ActiveChanged; override;
end;

TAutoFilterForm = class(TCustomAutoFilterForm)
private
  FListValues : TList;
  FDataLink : TAutoFilterFormDataLink;
  FDataSource : TDataSource;

  procedure SaveFieldValues;
  procedure RestoreFieldValues;
  procedure ClearValues;  
protected
  procedure BeforeShow; override;
  procedure DataSetChanged; override;  
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure CloseUp(Accept : Boolean); override;
published
  property Active;
  property Caption;
  property DataSet;
  property FilterFields;
  property LabelAlignment;
  property LabelFont;
  property Repository;
  property OnShow;
  property OnClose;
end;

implementation

uses agraphic, autostrs, adefctrl, audbstrs
  {$IFNDEF DELPHI3_0}, DBTables {$ENDIF};

Const
  FormBorderSize = 10;
  FormComboBoxWidth = 75;

type
TAutoFilterFieldValue = class
public
  Field : TField;
  PageIndex : Integer;
  ComboIndex : Integer;
  Value1 : Variant;
  Value2 : Variant;  
end;  

{TAutoFilterField}
constructor TAutoFilterField.Create(Collection : TCollection);
begin
  inherited Create(Collection);

  FCaption := LoadStr(ACDB_NEWFIELD);
  FFont := TFont.Create;
  RestoreDefaults;
end;

destructor TAutoFilterField.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TAutoFilterField.Assign(Source : TPersistent);
Var
  AField : TAutoFilterField;
begin
  if(Source is TAutoFilterField) then begin
    AField := Source as TAutoFilterField;
    FField := AField.FField;
    FFieldName := AField.FFieldName;
    FFont.Assign(AField.FFont);
    FAlignment := AField.FAlignment;
    FCaption := AField.FCaption;
    FAssignedValues := AField.FAssignedValues;
  end else inherited Assign(Source);
end;

function  TAutoFilterField.DefaultAlignment : TAlignment;
begin
  if Assigned(Field) then
    Result := FField.Alignment
  else
    Result := FilterForm.LabelAlignment;
end;

function  TAutoFilterField.DefaultCaption : String;
begin
  if Assigned(Field) then
    Result := FField.DisplayLabel
  else Result := LoadStr(ACDB_NEWFIELD);
end;

function  TAutoFilterField.DefaultFont : TFont;
begin
  Result := FilterForm.LabelFont;
end;

procedure TAutoFilterField.RestoreDefaults;
begin
  FAssignedValues := [];
  RefreshDefaultFont;
  FAlignment := DefaultAlignment;
end;

function  TAutoFilterField.GetFilterForm : TCustomAutoFilterForm;
begin
  Result := TAutoFilterFields(Collection).FilterForm;
end;

procedure TAutoFilterField.RefreshDefaultFont;
begin
  if Not (ffvFont in FAssignedValues) then
     FFont.Assign(DefaultFont);
end;

function  TAutoFilterField.GetAlignment : TAlignment;
begin
  if ffvAlignment in FAssignedValues then
    Result := FAlignment
  else Result := DefaultAlignment;
end;

function  TAutoFilterField.GetCaption : String;
begin
  if ffvCaption in FAssignedValues then
    Result := FCaption
  else Result := DefaultCaption;
end;

function  TAutoFilterField.GetField : TField;
begin
  if (FField = Nil) And (Length(FFieldName) > 0)
  And Assigned(FilterForm.DataSet) then
  with FilterForm.Dataset do
    if Active Or (Not DefaultFields) then
      SetField(FindField(FieldName));
  Result := FField;
end;

function  TAutoFilterField.GetFont : TFont;
begin
  if ffvFont in FAssignedValues then
    Result := FFont
  else Result := DefaultFont;
end;

function TAutoFilterField.GetDBDefControl : TAutoDBDefControl;
begin
  Result := adefctrl.GetDBDefControl(FilterForm.Repository, Field);
end;

function  TAutoFilterField.IsAlignmentStored : Boolean;
begin
  Result := (ffvAlignment in FAssignedValues) And (FAlignment <> DefaultAlignment);
end;

function  TAutoFilterField.IsCaptionStored : Boolean;
begin
  Result := (ffvCaption in FAssignedValues) And (FCaption <> DefaultCaption);
end;

function  TAutoFilterField.IsFontStored : Boolean;
begin
  Result := (ffvFont in FAssignedValues) And (FFont <> DefaultFont);
end;

procedure TAutoFilterField.SetAlignment(Value : TAlignment);
begin
  if Not ((ffvAlignment in FAssignedValues) And (Value = FAlignment)) then begin
    FAlignment := Value;
    Include(FAssignedValues, ffvAlignment);
  end;  
end;

procedure TAutoFilterField.SetCaption(Value : String);
begin
  if Not ((ffvCaption in FAssignedValues) And (Value = FCaption)) then begin
    FCaption := Value;
    Include(FAssignedValues, ffvCaption);
  end;
end;

procedure TAutoFilterField.SetField(Value : TField);
begin
  if FField = Value then exit;
  FField := Value;
  if Assigned(Value) then
    FFieldName := Value.FieldName;
end;

procedure TAutoFilterField.SetFieldName(const Value : String);
Var
  AField: TField;
begin
  AField := nil;
  if Assigned(FilterForm.DataSet) And (Length(Value) > 0)
  And Not (csLoading in FilterForm.ComponentState) then
   AField := FilterForm.DataSet.FindField(Value);
  FFieldName := Value;
  SetField(AField);
end;

procedure TAutoFilterField.SetFont(Value : TFont);
begin
  FFont.Assign(Value);
  Include(FAssignedValues, ffvFont);
end;

{TAutoFilterFields}
constructor TAutoFilterFields.Create(AFilterForm : TCustomAutoFilterForm);
begin
  inherited Create(TAutoFilterField);
  FFilterForm := AFilterForm;
end;

function TAutoFilterFields.Add : TAutoFilterField;
begin
  Result := TAutoFilterField(inherited Add);
end;

procedure TAutoFilterFields.Assign(Source: TPersistent);
Var
  AFields : TAutoFilterFields;
  AField : TAutoFilterField;
  i : Integer;
begin
  if(Source is TAutoFilterFields) then begin
    AFields := Source as TAutoFilterFields;
    Clear;
    for i := 0 to AFields.Count - 1 do begin
      AField := Add;
      AField.Assign(AFields[i]);
    end;
  end else inherited Assign(Source);
end;

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

procedure TAutoFilterFields.SetField(Index : Integer; Value : TAutoFilterField);
begin
  Items[Index].Assign(Value);