afforms.pas

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

PAS
1,231 行
字号
function TAutoFilterControls.GetMaxWidth : Integer;
Var
  AWidth : Integer;
  i : Integer;
begin
  Result := 0;
  for i := 0 to Count - 1 do begin
    if(Items[i].FControl2 <> Nil) then
      AWidth := Items[i].FControl2.Left
    else AWidth := Items[i].FControl1.Left;
    Inc(AWidth, Items[i].FControl1.Width + FormBorderSize);
    if(Result < AWidth) then
      Result := AWidth;
  end;
end;

function TAutoFilterControls.GetMaxHeight : Integer;
Var
  Index : Integer;
begin
  Result := 0;
  if(Count > 0) then begin
    if(Items[Count - 1].FControl1 = Nil) then
      Index := Count - 2
    else Index := Count - 1;
    if(Index > -1) then
      Result := Items[Index].FControl1.Top +
             Items[Index].FControl1.Height + FormBorderSize;
  end;
end;

{TCustomAutoFilterForm}
constructor TCustomAutoFilterForm.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FActive := False;
  FFilterFields := TAutoFilterFields.Create(self);
  FLabelAlignment := taLeftJustify;
  FLabelFont := TFont.Create;
  FMaxPageNumber := 10;
end;

destructor TCustomAutoFilterForm.Destroy;
begin
  Active := False;
  FFilterFields.Free;
  FLabelFont.Free;
  
  inherited Destroy;
end;

procedure TCustomAutoFilterForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if(AComponent = FDataSet) And (Operation = opRemove) then
    DataSet := Nil;
end;

procedure TCustomAutoFilterForm.BeforeShow;
begin
  if Assigned(FShowEvent) then
    FShowEvent(self);
end;

procedure TCustomAutoFilterForm.CloseUp(Accept : Boolean);
begin
  if Assigned(FCloseEvent) then
    FCloseEvent(self, Accept);
end;

procedure TCustomAutoFilterForm.Show;
var
  AForm : TForm;
  bPanel : TPanel;
  okButton, cButton : TButton;
  CreatedInfoFlag : Boolean;
  p1, p2 : TPoint;
begin
  if(FDataSet = Nil) Or Not FDataSet.Active then
    exit;

  FActive := True;
  AForm := TForm.Create(NIl);
  with AForm do begin
    BorderIcons := [];
    BorderStyle := bsDialog;
    Position := poScreenCenter;
    Caption := FCaption;
  end;
  bPanel := TPanel.Create(AForm);
  with bPanel do begin
    Parent := AForm;
    Align := alBottom;
    BevelInner := bvNone;
    BevelOuter := bvNone;
  end;
  TabControl := TFilterTabControl.Create(AForm);
  with TabControl do begin
    Parent := AForm;
    Align := alClient;
  end;
  ScrollBox := TFilterScrollBox.Create(AForm);
  with ScrollBox do begin
    Parent := TabControl;
    Align := alClient;
    AutoScroll := False;
  end;

  okButton := TButton.Create(bPanel);
  with okButton do begin
    Parent := bPanel;
    ModalResult := mrOk;
    Default := True;
    Caption := LoadStr(ACB_OK);
  end;

  cButton := TButton.Create(bPanel);
  with cButton do begin
    Parent := bPanel;
    ModalResult := mrCancel;
    Cancel := True;
    Caption := LoadStr(ACB_CANCEL);
  end;
  bPanel.Height := okButton.Height + 2 * FormBorderSize;
  okButton.Top := FormBorderSize;
  cButton.Top := FormBorderSize;

  CreatedInfoFlag := FilterFields.Count = 0;
  if(CreatedInfoFlag) then
    FilterFields.RebuildFields;

  FControls := TAutoFilterControls.Create(self);

  BeforeShow;
  p1 := AForm.ClientOrigin;
  p2 := ScrollBox.ClientToScreen(ScrollBox.ClientOrigin);
  AForm.ClientWidth := fControls.MaxWidth + p2.x - p1.x;
  AForm.ClientHeight := fControls.MaxHeight + 3 * FormBorderSize + p2.y - p1.y;

  if(AForm.Width > Trunc(Screen.Width*3/4)) then begin
    AForm.Width := Trunc(Screen.Width*3/4);
    ScrollBox.AutoScroll := True;
  end;
  if(AForm.Height > Trunc(Screen.Height*3/4)) then begin
    AForm.Height := Trunc(Screen.Height*3/4);
    ScrollBox.AutoScroll := True;
  end;
  cButton.Left := bPanel.Width - cButton.Width - FormBorderSize;
  okButton.Left := bPanel.Width - 2*(cButton.Width + FormBorderSize);

  if(FControls.Count > 0) then
    AForm.ActiveControl := FControls[0].FControl1;

  AForm.ShowModal;
  FControls.DoControlExit;
  CloseUp(AForm.ModalResult = mrOk);
  FControls.Free;

  if(CreatedInfoFlag) then
    FilterFields.Clear;

  okButton.Free;
  cButton.Free;
  ScrollBox.Free;
  TabControl.Free;
  bPanel.Free;
  AForm.Free;
  FActive := False;
end;

function TCustomAutoFilterForm.GetFilter : String;

  function IsNeedChar(AField : TField) : Boolean;
  begin
    Result := AField.DataType in [ftString, ftDate, ftDateTime, ftTime];
  end;

  function GetConrolValue(AFControl : TAutoFilterControl; Index : Integer; IsFirst : Boolean) : String;
  Var
    AValue : Variant;
  begin
    Result := '';
    if(IsFirst) then
      AValue := AFControl.Records[Index].Value1
    else AValue := AFControl.Records[Index].Value2;
    if(IsNeedChar(AFControl.FField.Field)) then
      Result := Result + '''';
    Result := Result + VarToStr(AValue);
    if(IsNeedChar(AFControl.FField.Field)) then
      Result := Result + '''';
  end;

Var
  i, j : Integer;
  St : String;
begin
  Result := '';
  for i := 0 to FControls.Count - 1 do begin
    St := '';
    for j := 0 to FControls[i].RecordCount - 1 do
      if(FControls[i].Records[j].ComboIndex > 0) then begin
        if(St <> '') then
          St := St + ' OR ';
        if(FControls[i].FField.Field.DataType = ftBoolean) then begin
          if Not (FControls[i].Records[j].Value1) then
            St := St + ' NOT ';
          St := St + FControls[i].FField.FieldName;          
        end else begin
          St := St + FControls[i].FField.FieldName;
          case FControls[i].Records[j].ComboIndex of
            1: St := St + '=';
            2: St := St + '<';
            3: St := St + '>';
            4: St := St + '<=';
            5: St := St + '>=';
            6: St := St + '>=';
            7: St := St + '<>';
          end;
          St := St + GetConrolValue(FControls[i], j, True);
          if(FControls[i].Records[j].ComboIndex = 6) then
            St := St +  ' AND '+ FControls[i].FField.FieldName + '<=' +
              GetConrolValue(FControls[i], j, False);
        end;
      end;
    if(St <> '') then begin
      if(Result <> '') then
        Result := Result + ' AND ';
      Result := Result + '(' + St +')';
    end;
  end;
end;


function TCustomAutoFilterForm.GetIsFilterForm : Boolean;
begin
  Result := self is TAutoFilterForm;
end;

procedure TCustomAutoFilterForm.SetActive(Value : Boolean);
begin
  if(FActive <> Value) then begin
   if(DataSet <> Nil) then
      Show;
  end;
end;

procedure TCustomAutoFilterForm.SetDataSet(Value : TDataSet);
begin
  if(FDataSet <> Value) then begin
    FDataSet := Value;
    if(FDataSet = Nil) then
      Active := False;
    DataSetChanged;  
  end;
end;

procedure TCustomAutoFilterForm.DataSetChanged;
begin
end; 

procedure TCustomAutoFilterForm.SetLabelFont(Value : TFont);
begin
  FLabelFont.Assign(Value);
end;

procedure TCustomAutoFilterForm.SetFilterFields(Value : TAutoFilterFields);
begin
  FFilterFields.Assign(Value);
end;

{TAutoLacateForm}
procedure TAutoLocateForm.CloseUp(Accept : Boolean);
Var
  OldFiltered : Boolean;
  OldFilter, St : String;
  Flag : Boolean;
  bm : TBookmark;
begin
  if(Accept) then begin
    St := GetFilter;
    OldFilter := DataSet.Filter;
    OldFiltered := DataSet.Filtered;
    DataSet.DisableControls;
    if(DataSet.Filter <> '') then
      DataSet.Filter := DataSet.Filter + '(' + St + ')'
    else DataSet.Filter := St;
    if Not OldFiltered then
      DataSet.Filtered := True;
    Flag :=  Not (DataSet.EOF And DataSet.BOF);
    if Flag then
      bm := DataSet.GetBookMark
    else bm := Nil;  
    DataSet.Filtered := OldFiltered;
    DataSet.Filter := OldFilter;  
    if(Flag) then begin
      DataSet.GotoBookMark(bm);
      DataSet.FreeBookMark(bm);      
    end;
    DataSet.EnableControls;
  end;
  inherited CloseUp(Accept);
end;

{TAutoFilterFormDataLink}
procedure TAutoFilterFormDataLink.ActiveChanged;
begin
  if(FFilterForm <> Nil) then
    FFilterForm.ClearValues;
end;


{TAutoFilterForm}
constructor TAutoFilterForm.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FListValues := TList.Create;
  FDataSource := TDataSource.Create(Nil);
  FDataLink := TAutoFilterFormDataLink.Create;
  FDataLink.FFilterForm := self;
  FDataLink.DataSource := FDataSource;
end;

destructor TAutoFilterForm.Destroy;
begin
  FDataLink.Free;
  FDataSource.Free;
  FListValues.Free;
  inherited Destroy;
end;

procedure TAutoFilterForm.SaveFieldValues;
Var
  i, j : Integer;
  afValue : TAutoFilterFieldValue;
begin
  for i := 0 to FControls.Count - 1 do
    for j := 0 to FControls[i].RecordCount - 1 do
      if(FControls[i].Records[j].ComboIndex > 0) then begin
        afValue := TAutoFilterFieldValue.Create;
        FListValues.Add(afValue);
        with afValue do begin
          PageIndex := j;
          if(FControls[i].FField <> Nil) then
            Field := FControls[i].FField.Field;
          ComboIndex := FControls[i].Records[j].ComboIndex;
          Value1 := FControls[i].Records[j].Value1;
          Value2 := FControls[i].Records[j].Value2;
        end;
      end;
end;

procedure TAutoFilterForm.RestoreFieldValues;
Var
  i, j, Index : Integer;
  afValue : TAutoFilterFieldValue;  
begin
  for i := 0 to FListValues.Count - 1 do begin
    afValue := TAutoFilterFieldValue(FListValues[i]);
    Index := FControls.GetControlIndex(afValue.Field);
    if(Index > -1) then begin
      while afValue.PageIndex >= FControls.FFilterForm.TabControl.Tabs.Count - 1 do begin
        if (FControls.FFilterForm.TabControl.Tabs.Count < FMaxPageNumber) then
          FControls.FFilterForm.TabControl.Tabs.Add(LoadStr(ACDB_OR));
        for j := 0 to FControls.Count - 1 do
          FControls.Items[Index].FRecords.Add(TAutoFilterRecord.Create);
      end;
      with FControls.Items[Index].Records[afValue.PageIndex] do begin
        ComboIndex := afValue.ComboIndex;
        Value1 := afValue.Value1;
        Value2 := afValue.Value2;              
      end;
    end;  
  end;
  FControls.RestoreValues;  
end;

procedure TAutoFilterForm.ClearValues;
begin
  while FListValues.Count > 0 do begin
    TAutoFilterFieldValue(FListValues[0]).Free;
    FListValues.Delete(0);
  end;
end;

procedure TAutoFilterForm.DataSetChanged;
begin
  ClearValues;
  FDataSource.DataSet := DataSet;
end;

procedure TAutoFilterForm.BeforeShow;
begin
  inherited BeforeShow;
  RestoreFieldValues;
end;

procedure TAutoFilterForm.CloseUp(Accept : Boolean);
begin
  if(Accept) then begin
    SaveFieldValues;
    DataSet.Filter := GetFilter;
    DataSet.Filtered := True;
  end;
  inherited CloseUp(Accept);
end;


end.

⌨️ 快捷键说明

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