cxfiltercontrol.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,067 行 · 第 1/5 页

    begin
      Result := False;
      break;
    end;
end;

function TcxCustomFilterControl.HasItems: Boolean;
begin
  Result := (FilterLink <> nil) and (FilterLink.Count > 0);
end;

procedure TcxCustomFilterControl.LayoutChanged;
begin
  if (FLockCount <> 0) or IsDestroying or IsLoading or not HandleAllocated or
    ((FComboBox <> nil) and FComboBox.DroppedDown) then Exit;
  Inc(FLockCount);
  try
    DoLayoutChange;
  finally
    Dec(FLockCount);
  end;
end;

procedure TcxCustomFilterControl.Localize;
var
  AOperator: TcxFilterControlOperator;
  ABoolOperator: TcxFilterBoolOperatorKind;
begin
  RefreshMenuCaptions;
  FRoot.Group.Caption := cxGetResourceString(@cxSFilterRootGroupCaption);
  FViewInfo.FAddConditionCaption := cxGetResourceString(@cxSFilterFooterAddCondition);
  for AOperator := Low(AOperator) to High(AOperator) do
    cxConditionText[AOperator] := GetFilterControlOperatorText(AOperator);
  for ABoolOperator := fboAnd to fboNotOr do
    cxBoolOperatorText[ABoolOperator] := cxStrFromBoolOperator(ABoolOperator);
  FNullString := cxGetResourceString(@cxSFilterControlNullString);
  LayoutChanged;
end;

procedure TcxCustomFilterControl.LoadFromFile(const AFileName: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(AFileName, fmOpenRead);
  try
    LoadFromStream(F);
  finally
    F.Free;
  end;
end;

procedure TcxCustomFilterControl.LoadFromStream(AStream: TStream);
begin
  if not HasItems then
    FilterControlError(cxGetResourceString(@cxSFilterErrorBuilding));
  Clear;
  ReadData(AStream);
  BuildFromCriteria;
end;

procedure TcxCustomFilterControl.SaveToFile(const AFileName: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(F);
  finally
    F.Free;
  end;
end;

procedure TcxCustomFilterControl.SaveToStream(AStream: TStream);
begin
  BuildFromRows;
  WriteData(AStream);
end;

procedure TcxCustomFilterControl.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
//TODO design-time editor ??  
//  Filer.DefineBinaryProperty('FilterCriteria', ReadData, WriteData, FCriteria.Root.Count > 0);
end;

procedure TcxCustomFilterControl.Loaded;
begin
  inherited Loaded;
  LayoutChanged;
end;

procedure TcxCustomFilterControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_LEFT: FocusPrev(False);
    VK_RIGHT: FocusNext(False);
    VK_TAB:
      begin
        if ssCtrl in Shift then
           TWinControlAccess(Parent).SelectNext(Self, not (ssShift in Shift), True)
        else
          if Shift = [] then
            FocusNext(True)
          else
            if ssShift in Shift then FocusPrev(True);
        Key := 0;
      end;
    VK_UP: FocusUp(False);
    VK_DOWN: FocusDown(False);
    VK_DELETE: if ssCtrl in Shift then Remove;
    VK_INSERT: if Shift = [] then AddCondition(FocusedRow);
  end;
end;

procedure TcxCustomFilterControl.KeyPress(var Key: Char);
begin
  inherited;
  if (Key = #13) or (Key = ' ') then
    ProcessHitTest(FFocusedInfo.HitTest, False)
  else
    if (Key <> #27) and (FFocusedInfo.HitTest = fhtValue) then
      SelectValue(aveKey, Key);
end;

procedure TcxCustomFilterControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if FWasError or not HasItems then Exit;
  ViewInfo.GetHitTestInfo(Shift, Point(X, Y), FHotTrack);
  if (FHotTrack.HitTest <> fhtNone) and (FState = fcsNormal) and (Button = mbLeft) then
  begin
    FFocusedInfo := FHotTrack;
    EnsureRowVisible;
    ProcessHitTest(FHotTrack.HitTest, True);
  end;
end;

procedure TcxCustomFilterControl.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  Cursors: array[Boolean] of TCursor = (crDefault, crHandPoint);
  NonHot = [fhtNone, fhtBoolOperator, fhtItem, fhtOperator];
var
  APrevHotTrack: TcxFilterControlHitTestInfo;

  function SameRow: Boolean;
  begin
    Result := APrevHotTrack.Row = FHotTrack.Row;
  end;

  function SameHitTest: Boolean;
  begin
    Result := (APrevHotTrack.HitTest = FHotTrack.HitTest) and
      (APrevHotTrack.ValueIndex = FHotTrack.ValueIndex);
  end;

begin
  inherited MouseMove(Shift, X, Y);
  BeginMouseTracking(Self, Bounds, Self);
  APrevHotTrack := FHotTrack;
  ViewInfo.GetHitTestInfo(Shift, Point(X, Y), FHotTrack);
  Cursor := Cursors[HasHotTrack and (FHotTrack.HitTest <> fhtNone)];
  if (APrevHotTrack.HitTest in NonHot) and (FHotTrack.HitTest in NonHot) then Exit;
  if SameRow then
    if SameHitTest then Exit else ViewInfo.InvalidateRow(FHotTrack.Row)
  else
  begin
    if not (APrevHotTrack.HitTest in NonHot) then
      ViewInfo.InvalidateRow(APrevHotTrack.Row);
    if not (FHotTrack.HitTest in NonHot) then
      ViewInfo.InvalidateRow(FHotTrack.Row);
  end;
  ViewInfo.Update;
end;

procedure TcxCustomFilterControl.Paint;
begin
  ViewInfo.Paint;
end;

procedure TcxCustomFilterControl.SetEnabled(Value: Boolean);
begin
  inherited;
  LayoutChanged;
end;

procedure TcxCustomFilterControl.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  LayoutChanged;
end;

procedure TcxCustomFilterControl.BoundsChanged;
begin
  inherited BoundsChanged;
  if HandleAllocated then
    LayoutChanged;
end;

procedure TcxCustomFilterControl.DoLayoutChange;

  procedure CheckVertical;
  begin
    while (TopVisibleRow > 0) and
      (ClientBounds.Bottom - ViewInfo.AddConditionRect.Bottom >= ViewInfo.RowHeight + 2) do
    begin
      Dec(FTopVisibleRow);
      ViewInfo.Calc;
    end;
  end;

  procedure CheckHorizontal;
  var
    ADelta: Integer;
  begin
    ADelta := ClientBounds.Right - (ViewInfo.MaxRowWidth - LeftOffset) - 2;
    if (LeftOffset > 0) and (ADelta > 0) then
    begin
      FLeftOffset := Max(0, FLeftOffset - ADelta);
      ViewInfo.Calc;
    end;
  end;

begin
  ViewInfo.Calc;
  CheckVertical;
  CheckHorizontal;
  UpdateScrollBars;
  Invalidate;
end;

procedure TcxCustomFilterControl.FocusChanged;
begin
  inherited FocusChanged;
  ViewInfo.GetHitTestInfo([], ScreenToClient(GetMouseCursorPos), FHotTrack);
  LayoutChanged;
end;

procedure TcxCustomFilterControl.FontChanged;
var
  AFont: TcxFilterControlFont;
begin
  inherited;
  if not IsLoading or (csReading in ComponentState) or IsDesigning then
  begin
    BeginUpdate;
    try
      for AFont := fcfBoolOperator to fcfValue do
      begin
        FFonts[AFont].Name := Font.Name;
        FFonts[AFont].Height := Font.Height;
        FFonts[AFont].Charset := Font.Charset;
      end;
    finally
      EndUpdate;
    end;
  end;
end;

function TcxCustomFilterControl.GetBorderSize: Integer;
begin
  Result := LookAndFeel.Painter.BorderSize;
end;

procedure TcxCustomFilterControl.InitControl;
begin
  inherited;
  FComboBox.Parent := Self;
  Localize;
end;

procedure TcxCustomFilterControl.InitScrollBarsParameters;
var
  APageSize: Integer;
begin
  if ViewInfo.RowHeight = 0 then Exit;
  APageSize := HeightOf(ClientBounds) div ViewInfo.RowHeight;
  SetScrollBarInfo(sbVertical, 0, RowCount - 1, 1, APageSize - 1, TopVisibleRow, True, True);
  SetScrollBarInfo(sbHorizontal, 0, ViewInfo.MaxRowWidth, 1,
    WidthOf(ClientBounds), FLeftOffset, True, True);
end;

procedure TcxCustomFilterControl.LookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues);
begin
  inherited;
  LayoutChanged;
  CheckInplaceControlsColor;
end;

procedure TcxCustomFilterControl.MouseEnter(AControl: TControl);
begin
  inherited MouseEnter(AControl);
  BeginMouseTracking(Self, Bounds, Self);
end;

procedure TcxCustomFilterControl.MouseLeave(AControl: TControl);
begin
  inherited MouseLeave(AControl);
  EndMouseTracking(Self);
  FHotTrack.HitTest := fhtNone;
  LayoutChanged;
end;

procedure TcxCustomFilterControl.Scroll(AScrollBarKind: TScrollBarKind;
  AScrollCode: TScrollCode; var AScrollPos: Integer);

  procedure ScrollVertical;
  begin
    case AScrollCode of
      scLineUp:
        TopVisibleRow := TopVisibleRow - 1;
      scLineDown:
        TopVisibleRow := TopVisibleRow + 1;
      scTrack:
        TopVisibleRow := AScrollPos;
      scPageUp:
        TopVisibleRow := TopVisibleRow - VScrollBar.PageSize;
      scPageDown:
        TopVisibleRow := TopVisibleRow + VScrollBar.PageSize;
    end;
    AScrollPos := TopVisibleRow;
  end;

  procedure ScrollHorizontal;
  begin
    case AScrollCode of
      scLineUp:
        LeftOffset := LeftOffset - 8;
      scLineDown:
        LeftOffset := LeftOffset + 8;
      scTrack:
        LeftOffset := AScrollPos;
      scPageUp:
        LeftOffset := LeftOffset - HScrollBar.PageSize;
      scPageDown:
        LeftOffset := LeftOffset + HScrollBar.PageSize;
    end;
    AScrollPos := LeftOffset;
  end;

begin
  if AScrollBarKind = sbVertical then
    ScrollVertical
  else
    ScrollHorizontal;
end;

procedure TcxCustomFilterControl.AddCondition(ARow: TcxCustomRowViewInfo);
var
  ARowParent: TcxCustomRowViewInfo;
begin
  if not HasItems then Exit;
  if ARow <> nil then ARowParent := ARow else ARowParent := Rows[RowCount - 1];
  while not (ARowParent is TcxGroupViewInfo) do
    ARowParent := ARowParent.Parent;
  with FFocusedInfo do
    Row := TcxConditionViewInfo.Create(Self, ARowParent, nil);
  RecalcRows;
  FFocusedInfo.HitTest := fhtAddCondition; // make sure last button visible
  ViewInfo.Calc;
  UpdateScrollBars;
  EnsureRowVisible;
  FFocusedInfo.HitTest := fhtItem;
  ViewInfo.CalcFocusRect;
  Invalidate;
end;

procedure TcxCustomFilterControl.AddGroup;
var
  AGroup: TcxGroupViewInfo;
  ARowParent: TcxCustomRowViewInfo;
begin
  if not HasItems then Exit;
  ARowParent := FocusedRow;
  while not (ARowParent is TcxGroupViewInfo) do
    ARowParent := ARowParent.Parent;
  AGroup := TcxGroupViewInfo.Create(Self, ARowParent, nil);
  RecalcRows;
  AddCondition(AGroup);
end;

procedure TcxCustomFilterControl.AddValue;
begin
  if not HasItems then Exit;
  FocusedRow.Condition.Values.AddValue;
  FFocusedInfo.HitTest := fhtValue;
  FFocusedInfo.ValueIndex := FocusedRow.Condition.Values.Count - 1;
  ViewInfo.Calc;
  FLeftOffset := Max((ViewInfo.MaxRowWidth + 2) - ClientBounds.Right, 0);
  LayoutChanged;
end;

procedure TcxCustomFilterControl.ClearRows;
begin
  BeginUpdate;
  try
    with FRoot.Group do
    begin
      while RowCount > 0 do Rows[0].Free;
      FRows.Clear;
    end;
    FRows.Clear;
    FRows.Add(FRoot);
    FFocusedInfo.Row := FRoot;
    FRoot.Group.BoolOperator := fboAnd;
    FFocusedInfo.HitTest := fhtBoolOperator;
    FTopVisibleRow := 0;
    FLeftOffset := 0;
  finally
    End