afforms.pas

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

PAS
1,231
字号
end;

procedure TAutoFilterFields.RestoreDefaults;
Var
  i : Integer;
begin
  BeginUpdate;
  try
    for i := 0 to Count - 1 do
      Items[i].RestoreDefaults;
  finally
    EndUpdate;
  end;
end;

procedure TAutoFilterFields.RebuildFields;
var
  i : Integer;
  AField : TAutoFilterField;
begin
  if Assigned(FFilterForm.Dataset) then begin
    Clear;
    with FFilterForm.Dataset do
      for i := 0 to FieldCount - 1 do
        if Not (FFilterForm.Dataset.Fields[i] is TBlobField)
        And Not  FFilterForm.Dataset.Fields[i].Lookup then begin
          AField := Add;
          AField.FieldName := Fields[i].FieldName;
        end;
  end;
end;

{TAutoFilterRecord}
type
TAutoFilterControls = class;

TAutoFilterRecord = class
  ComboIndex : Integer;
  Value1 : Variant;
  Value2 : Variant;
public
  constructor Create;
end;

{TAutoFilterControl}
TAutoFilterControl = class(TCollectionItem)
private
  FRecords : TList;
  FField : TAutoFilterField;
  FControl1 : TWinControl;
  FControl2 : TWinControl;
  FComboBox : TComboBox;
  FLabel : TLabel;

  function GetControls : TAutoFilterControls;
  function GetFilterForm : TCustomAutoFilterForm;
  function GetRecordCount : Integer;
  function GetRecords(Index : Integer) : TAutoFilterRecord;
protected
  procedure ComboBoxChange(Sender : TObject);
  procedure Control1Exit(Sender : TObject);
  procedure Control2Exit(Sender : TObject);

  property Controls : TAutoFilterControls read GetControls;
  property FilterForm : TCustomAutoFilterForm read GetFilterForm;
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;

  property RecordCount : Integer read GetRecordCount;
  property Records[Index : Integer] : TAutoFilterRecord read GetRecords;
end;

{TAutoFilterControls}
TAutoFilterControls = class(TCollection)
private
  FFilterForm : TCustomAutoFilterForm;
  FCreatedIndex : Integer;
  FLabelWidth : Integer;
  FCurrentRecordIndex : Integer;
  FDestroyTab : Integer;

  function GetControl(Index : Integer) : TAutoFilterControl;
  function GetMaxWidth : Integer;
  function GetMaxHeight : Integer;
protected
  procedure TabChange(Sender: TObject);
  procedure TabChanging(Sender: TObject; var AllowChange : Boolean);
  procedure RestoreValues;
public
  constructor Create(AFilterForm : TCustomAutoFilterForm);
  destructor Destroy; override;
  function Add : TAutoFilterControl;
  function GetControlIndex(AField : TField) : Integer;
  procedure DoControlExit;

  property CurrentRecordIndex : Integer read FCurrentRecordIndex;
  property Items[Index : Integer] : TAutoFilterControl read GetControl; default;
  property MaxWidth : Integer read GetMaxWidth;
  property MaxHeight : Integer read GetMaxHeight;
end;

Var
  FControls : TAutoFilterControls;
  
{TAutoFilterRecord}
constructor TAutoFilterRecord.Create;
begin
  inherited Create;
  ComboIndex := 0;
  Value1 := Null;
  Value2 := Null;
end;

type
TDummyWinControl = class(TWinControl)
public
  property OnExit;
end;  

{TAutoFilterControl}
constructor TAutoFilterControl.Create(Collection : TCollection);
Var
  AMaxHeight : Integer;
begin
  inherited Create(Collection);
  FRecords := TList.Create;
  FRecords.Add(TAutoFilterRecord.Create);
  FField := FilterForm.FilterFields[Controls.FCreatedIndex];
  AMaxHeight := Controls.MaxHeight;
  FLabel := TLabel.Create(FilterForm.ScrollBox);
  with FLabel do begin
    Parent := FilterForm.ScrollBox;
    Caption := FField.Caption;
    Font.Assign(FilterForm.LabelFont);
    case FField.Alignment of
       taLeftJustify: Left := FormBorderSize;
       taCenter: Left := (Controls.FLabelWidth - Width) div 2;
       taRightJustify : Left := Controls.FLabelWidth - Width - FormBorderSize;
    end;
    Top := AMaxHeight;
  end;
  FComboBox := TComboBox.Create(FilterForm.ScrollBox);
  with FComboBox, FComboBox.Items do begin
    Parent := FilterForm.ScrollBox;
    Left := self.Controls.FLabelWidth;
    Top := AMaxHeight;
    Width := FormComboBoxWidth;
    OnChange := ComboBoxChange;
    Style := csDropDownList;
    Add(LoadStr(ACDB_ANY));
    Add('=');
    if(FField.Field.DataType <> ftBoolean) then begin
      Add('<');
      Add('>');
      Add('<=');
      Add('>=');
      Add(LoadStr(ACDB_BETWEEN));
      Add('<>');
    end;
    ItemIndex := 0;
  end;
  FControl1 := FField.DBDefControl.CreateFilterControl(FilterForm.ScrollBox, FField.Field);
  with FControl1 do begin
    Left := FComboBox.Left + FComboBox.Width + FormBorderSize;
    Top := AMaxHeight;
    Visible := True;
  end;
  TDummyWinControl(FControl1).OnExit := Control1Exit;
  FControl2 := FField.DBDefControl.CreateFilterControl(FilterForm.ScrollBox, FField.Field);
  if(FField.Field.DataType <> ftBoolean) then begin
    with FControl2 do begin
      Left := FControl1.Left + FControl1.Width + FormBorderSize;
      Top := AMaxHeight;
      Enabled := False;
      Visible := True;
    end;
    TDummyWinControl(FControl2).OnExit := Control2Exit;
  end;  
end;

destructor TAutoFilterControl.Destroy;
Var
  i : Integer;
begin
  for i := 0 to FRecords.Count - 1 do
    TAutoFilterRecord(FRecords[i]).Free;
  FRecords.Free;
  if(FField <> Nil) And (FField.DBDefControl <> Nil) then begin
    if(FControl1 <> Nil) then
      FField.DBDefControl.DestroyControl(FControl1);
    if(FControl2 <> Nil) then
      FField.DBDefControl.DestroyControl(FControl2);
  end;
  if(FComboBox <> Nil) then
    FComboBox.Free;
  inherited Destroy;
end;

function TAutoFilterControl.GetControls : TAutoFilterControls;
begin
  Result := TAutoFilterControls(Collection);
end;

function TAutoFilterControl.GetFilterForm : TCustomAutoFilterForm;
begin
  Result := Controls.FFilterForm;
end;

function TAutoFilterControl.GetRecordCount : Integer;
begin
  Result := FRecords.Count;
end;

function TAutoFilterControl.GetRecords(Index : Integer) : TAutoFilterRecord;
begin
  if(Index > -1) And (Index < RecordCount) then
    Result := TAutoFilterRecord(FRecords[Index])
  else Result := Nil;
end;

procedure TAutoFilterControl.ComboBoxChange(Sender : TObject);
begin
  if(FControl2 <> NIl) then
    FControl2.Enabled := FComboBox.ItemIndex = 6;
  Records[Controls.CurrentRecordIndex].ComboIndex := FComboBox.ItemIndex;  
end;

function VarEquals(const V1, V2: Variant): Boolean;
begin
  Result := False;
  try
    Result := V1 = V2;
  except
  end;
end;

procedure TAutoFilterControl.Control1Exit(Sender : TObject);
Var
  AValue : Variant;
begin
  AValue := FField.DBDefControl.GetFilterControlValue(FControl1);
  if Not VarEquals(Records[Controls.CurrentRecordIndex].Value1, AValue) then begin
    if(FComboBox.ItemIndex = 0) then
      FComboBox.ItemIndex := 1
    else
      if VarEquals(AValue, Null) then 
        FComboBox.ItemIndex := 0;
    ComboBoxChange(Sender);        
    Records[Controls.CurrentRecordIndex].Value1 := AValue;
  end;
end;

procedure TAutoFilterControl.Control2Exit(Sender : TObject);
Var
  AValue : Variant;
begin
  AValue := FField.DBDefControl.GetFilterControlValue(FControl2);
  if Not VarEquals(Records[Controls.CurrentRecordIndex].Value2, AValue) then
     Records[Controls.CurrentRecordIndex].Value2 := AValue;
end;

{TAutoFilterControls}
constructor TAutoFilterControls.Create(AFilterForm : TCustomAutoFilterForm);
Var
  i : Integer;
  AWidth : Integer;
begin
  inherited Create(TAutoFilterControl);
  FFilterForm := AFilterForm;
  FCurrentRecordIndex := 0;
  FLabelWidth := 0;
  FDestroyTab := -1;
  for i := 0 to FFilterForm.FilterFields.Count - 1 do
    if (FFilterForm.FilterFields[i].Field <> Nil)
    And Not (FFilterForm.FilterFields[i].Field is TBlobField)
    And Not FFilterForm.FilterFields[i].Field.Lookup then begin
      AWidth := GetTextWidth(FFilterForm.FilterFields[i].Font,
        FFilterForm.FilterFields[i].Caption);
      if(FLabelWidth < AWidth) then
        FLabelWidth := AWidth;
    end;
  Inc(FLabelWidth, FormBorderSize);
  FCreatedIndex := 0;
  for i := 0 to FFilterForm.FilterFields.Count - 1 do
    if (FFilterForm.FilterFields[i].Field <> Nil)
    And Not (FFilterForm.FilterFields[i].Field is TBlobField)
    And Not FFilterForm.FilterFields[i].Field.Lookup then begin
      Add;
      Inc(FCreatedIndex);
    end;
   FFilterForm.TabControl.OnChange := TabChange;
   FFilterForm.TabControl.OnChanging := TabChanging;
   FFilterForm.TabControl.Tabs.Add(LoadStr(ACDB_OR));
   FFilterForm.TabControl.Tabs.Add(LoadStr(ACDB_OR));
   for i := 0 to Count - 1 do
     Items[i].FRecords.Add(TAutoFilterRecord.Create);
end;

destructor TAutoFilterControls.Destroy;
begin
  inherited Destroy;
end;

procedure TAutoFilterControls.RestoreValues;
Var
  i, Index : Integer;
begin
  Index := FFilterForm.TabControl.TabIndex;
  for i := 0 to Count - 1 do begin
    Items[i].FField.DBDefControl.SetFilterControlValue(Items[i].FControl1,
      Items[i].Records[Index].Value1);
    Items[i].FField.DBDefControl.SetFilterControlValue(Items[i].FControl2,
      Items[i].Records[Index].Value2);
    Items[i].FComboBox.ItemIndex := Items[i].Records[Index].ComboIndex;
    Items[i].FControl2.Enabled := Items[i].FComboBox.ItemIndex = 6;    
  end;
end;

procedure TAutoFilterControls.TabChange(Sender: TObject);
Var
  i : Integer;
begin
  FCurrentRecordIndex := FFilterForm.TabControl.TabIndex;
  if(FDestroyTab > -1) then begin
    FFilterForm.TabControl.Tabs.Delete(FDestroyTab);
    if(FCurrentRecordIndex >= FFilterForm.TabControl.Tabs.Count) then
      Dec(FCurrentRecordIndex);
    FFilterForm.TabControl.TabIndex := FCurrentRecordIndex; 
  end;
  if(FFilterForm.TabControl.TabIndex = FFilterForm.TabControl.Tabs.Count - 1)
  And (FFilterForm.TabControl.Tabs.Count < FFilterForm.FMaxPageNumber) then begin
    FFilterForm.TabControl.Tabs.Add(LoadStr(ACDB_OR));
    for i := 0 to Count - 1 do
      Items[i].FRecords.Add(TAutoFilterRecord.Create);
  end;
  RestoreValues;
end;

procedure TAutoFilterControls.TabChanging(Sender: TObject; var AllowChange : Boolean);

  function IsAnyFilterSet : Boolean;
  Var
    i : Integer;
  begin
    for i := 0 to Count - 1 do
      if(Items[i].FComboBox.ItemIndex > 0) then    break;
        Result := i < Count;
  end;

Var
  i : Integer;
begin
  FDestroyTab := -1;
  DoControlExit;
  AllowChange := True;
  if(FFilterForm.TabControl.Tabs.Count < 3) then begin
    if(FFilterForm.TabControl.TabIndex = 0) then
      AllowChange := IsAnyFilterSet;
  end else
    if Not IsAnyFilterSet And (FFilterForm.TabControl.TabIndex <> FFilterForm.TabControl.Tabs.Count - 1) then begin
      for i := 0 to Count - 1 do begin
        Items[i].Records[FFilterForm.TabControl.TabIndex].Free;
        Items[i].FRecords.Delete(FFilterForm.TabControl.TabIndex);
      end;
      FDestroyTab := FFilterForm.TabControl.TabIndex;
    end;
end;

function TAutoFilterControls.Add : TAutoFilterControl;
begin
  Result := TAutoFilterControl(inherited Add);
end;

function TAutoFilterControls.GetControlIndex(AField : TField) : Integer;
Var
  i : Integer;
begin
  Result := -1;
  for i := 0 to Count - 1 do
    if(Items[i].FField <> Nil) and (Items[i].FField.Field  = AField) then begin
      Result := i;
      break;
    end;
end;

procedure TAutoFilterControls.DoControlExit;
Var
  AControl : TWinControl;
  i : Integer;
begin
  AControl := Screen.ActiveForm.ActiveControl;
  if(AControl <> Nil) then begin
    for i := 0 to Count - 1 do begin
      if(AControl = Items[i].FControl1) then begin
        Items[i].Control1Exit(self);
        break;
      end;
      if(AControl = Items[i].FControl2) then begin
        Items[i].Control2Exit(self);
        break;
      end;
    end;  
  end;
end;

function TAutoFilterControls.GetControl(Index : Integer) : TAutoFilterControl;
begin
  Result := TAutoFilterControl(inherited Items[Index]);
end;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?