afilter.pas

来自「delphi编程控件」· PAS 代码 · 共 921 行 · 第 1/2 页

    Name := Macro.Name;
    MacroOptions := Macro.MacroOptions;
  end;
end;


{TAutoComponentsRegister}
procedure AddFilterToComponentsRegister(AutoFilter : TAutoFilter);
begin
  if(AutoComponentsRegister = Nil) then
    AutoComponentsRegister := TAutoComponentsRegister.Create;
  AutoComponentsRegister.Add(AutoFilter);
end;

procedure AddFilterLinkToComponentsRegister(FilterLink : TFilterLink);
begin
  if(AutoComponentsRegister = Nil) then
    AutoComponentsRegister := TAutoComponentsRegister.Create;
  AutoComponentsRegister.AddFilterLink(FilterLink);
end;

procedure RemoveFilterFromComponentsRegister(AutoFilter : TAutoFilter);
begin
  if(AutoComponentsRegister <> Nil) then begin
    AutoComponentsRegister.Remove(AutoFilter);
    if(AutoComponentsRegister.Count = 0) And (AutoComponentsRegister.FilterLinkCount = 0)then begin
      AutoComponentsRegister.Free;
      AutoComponentsRegister := Nil;
    end;
  end;
end;

procedure RemoveFilterLinkFromComponentsRegister(FilterLink : TFilterLink);
begin
  if(AutoComponentsRegister <> Nil) then begin
    AutoComponentsRegister.RemoveFilterLink(FilterLink);
    if(AutoComponentsRegister.Count = 0) And (AutoComponentsRegister.FilterLinkCount = 0)then begin
      AutoComponentsRegister.Free;
      AutoComponentsRegister := Nil;
    end;
  end;
end;

constructor TAutoComponentsRegister.Create;
begin
  inherited;
  List := TList.Create;
  ComponentList := TList.Create;
  FilterLinkList := TList.Create;
end;

destructor TAutoComponentsRegister.Destroy;
begin
  List.Free;
  ComponentList.Free;
  FilterLinkList.Free;

  inherited;
end;

procedure TAutoComponentsRegister.Add(AutoFilter : TAutoFilter);
begin
  if(AutoFilter <> Nil) And (List.IndexOf(AutoFilter) = -1) then begin
    List.Add(AutoFilter);
    if(ComponentList.IndexOf(AutoFilter.Owner) < 0) then
      ComponentList.Add(AutoFilter.Owner);
  end;
end;

procedure TAutoComponentsRegister.AddFilterLink(FilterLink : TFilterLink);
begin
  if(FilterLink <> Nil) And (FilterLinkList.IndexOf(FilterLink) = -1) then
    FilterLinkList.Add(FilterLink);
end;

procedure TAutoComponentsRegister.Remove(AutoFilter : TAutoFilter);
Var
  i : Integer;
  Flag : Boolean;
begin
  Flag := True;
  List.Remove(AutoFilter);
  for i := 0 to Count - 1 do
    if(Items[i] <> Nil) And (Items[i].Owner = AutoFilter.Owner) then begin
      Flag := False;
      break;
    end;
  if (flag) then
    ComponentList.Remove(AutoFilter.Owner);
end;

procedure TAutoComponentsRegister.RemoveFilterLink(FilterLink : TFilterLink);
begin
  FilterLinkList.Remove(FilterLink);
end;

function TAutoComponentsRegister.ComponentIndexOf(Component : TComponent) : Integer;
begin
  Result := ComponentList.IndexOf(Component);
end;

function TAutoComponentsRegister.Count : Integer;
begin
  Result := List.Count;
end;

function TAutoComponentsRegister.ComponentCount : Integer;
begin
  Result := ComponentList.Count;
end;

function TAutoComponentsRegister.FilterLinkCount : Integer;
begin
  Result := FilterLinkList.Count;
end;

function TAutoComponentsRegister.GetAutoFilter(Index : Integer) : TAutoFilter;
begin
  Result := Nil;
  if(Index >= 0) And (Index < Count) then
    Result := TAutoFilter(List.List^[Index]);
end;

procedure TAutoComponentsRegister.GetAutoFilters(FList : TList; Component : TComponent);
Var
  I : Integer;
begin
  FList.Clear;
  for i := 0 to Count - 1 do
    if(Items[i].Owner = Component) then
      FList.Add(List[i]);
end;

function TAutoComponentsRegister.GetComponent(Index : Integer) : TComponent;
begin
  Result := Nil;
  if(Index >= 0) And (Index < Count) then
    Result := TComponent(ComponentList.List^[Index]);
end;

function TAutoComponentsRegister.GetFilterLink(Index : Integer) : TFilterLink;
begin
  Result := Nil;
  if(Index >= 0) And (Index < FilterLinkCount) then
    Result := TFilterLink(FilterLinkList.List^[Index]);
end;


{TAutoFilter}
constructor TAutoFilter.Create(AOwner : TComponent);
begin
  inherited Create;
  Owner := AOwner;
  FFilterLink := TList.Create;
  Name := 'Auto';

  AddFilterToComponentsRegister(self);
end;

destructor TAutoFilter.Destroy;
Var
  i : Integer;
begin
  for i := 0 to FFilterLink.Count - 1 do
    if(TFilterLink(FFilterLink.List^[i]) <> Nil)
    and not (csDestroying in TFilterLink(FFilterLink.List^[i]).ComponentState) then
      TFilterLink(FFilterLink.List^[i]).Filter := Nil;
  FFilterLink.Free;

  RemoveFilterFromComponentsRegister(self);
  inherited Destroy;
end;

procedure TAutoFilter.Assign(Source : TPersistent);
Var
  af : TAutoFilter;
begin
  if(Source is TAutoFilter) then begin
    af := TAutoFilter(Source);
    FValue := af.FValue;
    FTextBefore := af.FTextBefore;
    FTextAfter := af.FTextAfter;
    FAssignEmpty := af.FAssignEmpty;
    OnBeforeChange := af.OnBeforeChange;
    OnAfterChange := af.OnAfterChange;
  end else inherited Assign(Source); 

end;

function TAutoFilter.GetText : String;
begin
  if(Length(FValue) > 0)  then
    Result := FTextBefore + FValue + FTextAfter
  else Result := '';
end;

procedure TAutoFilter.RefreshDataSets;
Var
  i : Integer;
begin
  if((Length(Text) > 0) Or (FAssignEmpty)) then
    for i := 0 to FFilterLink.Count - 1 do
      TFilterLink(FFilterLink.List^[i]).RefreshDataSet;
end;

procedure TAutoFilter.SetValue(Value : String);
begin
  if(FValue = Value) then exit;
  FValue := Value;
  if Assigned(OnBeforeChange) then OnBeforeChange(Self);
  RefreshDataSets;
  if Assigned(OnAfterChange) then OnAfterChange(Self);
end;

procedure TAutoFilter.SetTextBefore(Value : String);
begin
  if(FTextBefore = Value) then exit;
  FTextBefore := Value;
  RefreshDataSets;
end;

procedure TAutoFilter.SetTextAfter(Value : String);
begin
  if(FTextAfter = Value) then exit;
  FTextAfter := Value;
  RefreshDataSets;
end;

{TFilterLink}

constructor TFilterLink.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  AddFilterLinkToComponentsRegister(self);
  List := TList.Create;
  FAutoRefresh := True;
end;

destructor TFilterLink.Destroy;
begin
  if(AutoFilter <> Nil) And (AutoFilter.Owner <> Nil)
  And Not (csDestroying in AutoFilter.Owner.ComponentState) then
    AutoFilter.FFilterLink.Remove(self);
  RemoveFilterLinkFromComponentsRegister(self);
  List.Free;
  inherited;
end;

procedure TFilterLink.Loaded;
begin
  inherited;
  FilterName := FLoadFilterName;
end;

procedure TFilterLink.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if(Operation = opRemove) and (FDataSet = AComponent) then
    FDataSet := Nil;
  if(Operation = opRemove) and (FComponent = AComponent) then
    FComponent := Nil;
end;

function TFilterLink.GetFilterComponent : TComponent;
begin
  Result := FComponent;
end;

procedure TFilterLink.RefreshDataSet;
Var
  Flag : Boolean;
  IntFlag : Integer;
  Macro : TMacro;
  Param : TParam;
  Macros : TMacros;
  Params : TParams;
  PropInfo : PPropInfo;
  mFreeze : TMacrosFreeze;
  i : Integer;
begin
  if(DataSet = Nil) Or (AutoFilter = Nil)
  Or (csLoading in ComponentState) then exit;

  PropInfo := GetPropInfo(DataSet.ClassInfo, 'Macros');
  if(PropInfo <> Nil) then
    Macros := TMacros(GetOrdProp(DataSet, PropInfo))
  else Macros := Nil;
  PropInfo := GetPropInfo(DataSet.ClassInfo, 'Params');
  if(PropInfo <> Nil) then
    Params := TParams(GetOrdProp(DataSet, PropInfo))
  else Params := Nil;
  if(Params = Nil) And (Macros = Nil) then exit;

  PropInfo := GetPropInfo(DataSet.ClassInfo, 'MacrosFreeze');
  if(PropInfo <> Nil) then
    mFreeze := TMacrosFreeze(GetOrdProp(DataSet, PropInfo))
  else mFreeze := mfNever;

  Macro := Nil;
  Param := Nil;
  if(Params <> Nil) And (Length(FParam) > 0) then
    for i := 0 to Params.Count - 1 do
      if(CompareText(FParam, Params[i].Name) = 0) then begin
        Param := Params[i];
        break;
      end;
  if(Macros <> Nil) And (Length(FMacro) > 0) then
    for i := 0 to Macros.Count - 1 do
      if(CompareText(FMacro, Macros[i].Name) = 0) then begin
        Macro := Macros[i];
        break;
      end;

  if(Param <> Nil) And (Length(AutoFilter.Text) > 0)
  And (Param.Text <> AutoFilter.Text) then begin
    Param.Text := AutoFilter.Text;
    Flag := True;
    IntFlag := 0;
  end else begin
    Flag := False;
    IntFlag := -1;
  end;
  if(Macro <> Nil) And (Macro.Text <> AutoFilter.Text)
  And Not ((mFreeze = mfAlways) Or ((mFreeze = mfDesigning)
    And (csDesigning in ComponentState))) then begin
    Macro.Text := AutoFilter.Text;
    if moSQL in Macro.MacroOptions then IntFlag := 0;
    if moFilter in Macro.MacroOptions then IntFlag := 1;
    if [moSQL, moFilter] = Macro.MacroOptions then IntFlag := 2;
    Flag := True;
  end;

  if Flag And DataSet.Active And FAutoRefresh And (IntFlag mod 2 = 0) then begin
    DataSet.Close;
    DataSet.Open;
  end;

  if Flag  And FAutoRefresh And (IntFlag > 0) then begin
    PropInfo := GetPropInfo(DataSet.ClassInfo, 'Filtered');
    if(PropInfo <> Nil) then begin
      SetOrdProp(DataSet, PropInfo, Integer(False));
      SetOrdProp(DataSet, PropInfo, Integer(True));      
    end;
  end;
end;

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

procedure TFilterLink.SetFilter(Value : TComponent);
Var
  i : Integer;
begin
  if(Value = FComponent) then exit;

  if(Value = Nil) then begin
    FComponent := Nil;
    FilterName := '';
  end
  else
    if (AutoComponentsRegister <> nil) then begin
      i := AutoComponentsRegister.ComponentIndexOf(Value);
      if i <> -1 then begin
        FComponent := Value;
        if Not (csLoading in FComponent.ComponentState) then begin
          AutoComponentsRegister.GetAutoFilters(List, Value);
          FilterName := TAutoFilter(List[0]).Name;
        end;  
      end;
    end;

end;

procedure TFilterLink.SetFilterName(Value : String);
Var
  i : Integer;
  Flag : Boolean;

  procedure AutoFilterAssign;
  begin
     FFilterName := TAutoFilter(List[i]).Name;
     AutoFilter := TAutoFilter(List[i]);
     RefreshDataSet;
     Flag := True;
  end;

begin
  FLoadFilterName := Value;
  if(AutoFilter <> Nil) then
    AutoFilter.FFilterLink.Remove(self);

  Flag := False;
  if(AutoComponentsRegister <> nil) And (FComponent <> Nil) then begin
    i := AutoComponentsRegister.ComponentIndexOf(FComponent);
    if i <> -1 then begin
      AutoComponentsRegister.GetAutoFilters(List, FComponent);
      for i := 0 to List.Count - 1 do
        if(Value = TAutoFilter(List[i]).Name) then begin
          AutoFilterAssign;
          break;
        end;
       if(List.Count > 0) And Not Flag then begin
         i := 0;
         AutoFilterAssign;
       end;  
     end;
  end;

  if Not Flag then begin
     FFilterName := '';
     AutoFilter := Nil;
  end;   

  if(AutoFilter <> Nil) then
    AutoFilter.FFilterLink.Add(self);
end;

procedure TFilterLink.SetMacro(Value : String);
begin
  if(FMacro <> Value) then begin
    FMacro := Value;
    RefreshDataSet;
  end;
end;

procedure TFilterLink.SetParam(Value : String);
begin
  if(FParam <> Value) then begin
    FParam := Value;
    RefreshDataSet;
  end;  
end;

{$IFDEF UNREGISTEREDACL}
procedure CheckProtection;
const
  PROT_MESSAGE = 'You have not permission to use ACL 2.0. See order.txt and license.txt';
begin
  if (FindWindow('TPropertyInspector', 'Object Inspector') = 0) then begin
    MessageDlg(PROT_MESSAGE, mtWarning, [mbOK], 0);
    exit;
  end;
end;
{$ENDIF}

initialization
  AutoComponentsRegister := Nil;

{$IFDEF UNREGISTEREDACL}
  CheckProtection;
{$ENDIF}

end.