cxgrid.pas

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

  FreeAndNil(FDesignController);
  inherited;
end;

function TcxGridController.GetDesignController: TcxGridDesignController;
begin
  if (FDesignController = nil) and Control.IsDesigning then
    FDesignController := GetDesignControllerClass.Create(Control);
  Result := FDesignController;
end;

procedure TcxGridController.DragOpenTimerHandler(Sender: TObject);
begin
  FDragOpenTimer.Enabled := False;
  try
    FDragOpenInfo.Run;
  finally
    StopDragOpen;
  end;
end;

function TcxGridController.GetDesignControllerClass: TcxGridDesignControllerClass;
begin
  Result := TcxGridDesignController;
end;

procedure TcxGridController.DoCancelMode;
begin
  if ActiveController <> nil then
    ActiveController.DoCancelMode;
end;

procedure TcxGridController.FocusChanged;
begin
  if ActiveController <> nil then
    ActiveController.DoControlFocusChanged;
end;

function TcxGridController.GetCursor(X, Y: Integer): TCursor;
begin
  Result := crDefault;
end;

procedure TcxGridController.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AHitTest: TcxCustomGridHitTest;
begin
  AHitTest := ViewInfo.GetHitTest(X, Y);
  if AHitTest.ViewInfo <> nil then
    AHitTest.ViewInfo.MouseDown(AHitTest, Button, Shift);
end;

procedure TcxGridController.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  AHitTest: TcxCustomGridHitTest;
begin
  AHitTest := ViewInfo.GetHitTest(X, Y);
  if AHitTest.ViewInfo <> nil then
    AHitTest.ViewInfo.MouseMove(AHitTest, Shift);
end;

procedure TcxGridController.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TcxGridController.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);

  procedure ProcessOpening;
  var
    AHitTest: TcxCustomGridHitTest;
    ADragOpenInfo: TcxCustomGridDragOpenInfo;
  begin
    AHitTest := ViewInfo.GetHitTest(X, Y);
    if (State <> dsDragLeave) and IsDragOpenHitTest(AHitTest, ADragOpenInfo) then
      StartDragOpen(ADragOpenInfo)
    else
      StopDragOpen;
  end;

begin
  if Control.DragOpening then
    ProcessOpening;
end;

procedure TcxGridController.EndDrag(Target: TObject; X, Y: Integer);
begin
  StopDragOpen;
end;

procedure TcxGridController.StartDrag(var DragObject: TDragObject);
begin
end;

function TcxGridController.GetDragOpenInfo(AHitTest: TcxCustomGridHitTest): TcxCustomGridDragOpenInfo;
begin
  if AHitTest.HitTestCode = htTab then
    with TcxGridDetailsSiteTabHitTest(AHitTest) do
      Result := TcxGridDragOpenInfoTab.Create(Level)
  else
    Result := nil;
end;

function TcxGridController.IsDragOpenHitTest(AHitTest: TcxCustomGridHitTest;
  out ADragOpenInfo: TcxCustomGridDragOpenInfo): Boolean;
begin
  ADragOpenInfo := GetDragOpenInfo(AHitTest);
  Result := ADragOpenInfo <> nil;
end;

procedure TcxGridController.StartDragOpen(ADragOpenInfo: TcxCustomGridDragOpenInfo);
begin
  if (FDragOpenInfo <> nil) and FDragOpenInfo.Equals(ADragOpenInfo) then
  begin
    ADragOpenInfo.Free;
    Exit;
  end;
  FDragOpenInfo.Free;
  FDragOpenInfo := ADragOpenInfo;
  if FDragOpenTimer = nil then
  begin
    FDragOpenTimer := TcxTimer.Create(nil);
    with FDragOpenTimer do
    begin
      Interval := Control.DragOpeningWaitTime;
      OnTimer := DragOpenTimerHandler;
    end;
  end
  else
    with FDragOpenTimer do
    begin
      Enabled := False;
      Enabled := True;
    end;
end;

procedure TcxGridController.StopDragOpen;
begin
  FreeAndNil(FDragOpenTimer);
  FreeAndNil(FDragOpenInfo);
end;

{ TcxGridPainter }

function TcxGridPainter.GetCanvas: TcxCanvas;
begin
  Result := Control.ActiveCanvas;
end;

procedure TcxGridPainter.DrawDetailsSite;
begin
  with TcxGridTopDetailsSiteViewInfo(ViewInfo.DetailsSiteViewInfo) do
    if Visible then Paint(Self.Canvas);
end;

{procedure TcxGridPainter.DrawEmptyArea;
begin
  Canvas.Brush.Color := ViewInfo.EmptyAreaColor;
  Canvas.FillRect(ViewInfo.ClientBounds);
end;}

procedure TcxGridPainter.Invalidate(AInvalidateDetails: Boolean);
var
  I: Integer;
  AControl: TControl;
begin
  Control.Invalidate;
  if AInvalidateDetails then
    for I := 0 to Control.ControlCount - 1 do
    begin
      AControl := Control.Controls[I];
      if AControl is TcxGridSite then
        AControl.Invalidate;
    end;
end;

procedure TcxGridPainter.Invalidate(const R: TRect);
begin
  Control.InvalidateRect(R, False);
end;

procedure TcxGridPainter.Paint;
begin
  DrawDetailsSite;
  //DrawEmptyArea;
end;

{ TcxGridTopDetailsSiteViewInfo }

function TcxGridTopDetailsSiteViewInfo.GetControl: TcxCustomGrid;
begin
  Result := TcxCustomGrid(Level.Control);
end;

function TcxGridTopDetailsSiteViewInfo.CalculateHeight: Integer;
begin
  Result := MaxHeight;
end;

function TcxGridTopDetailsSiteViewInfo.CalculateWidth: Integer;
begin
  Result := MaxWidth;
end;

function TcxGridTopDetailsSiteViewInfo.GetActiveGridView: TcxCustomGridView;
begin
  Result := Control.ActiveView;
end;

function TcxGridTopDetailsSiteViewInfo.GetActiveLevel: TcxGridLevel;
begin
  Result := Control.ActiveLevel;
end;

function TcxGridTopDetailsSiteViewInfo.GetCanvas: TcxCanvas;
begin
  Result := Control.Painter.Canvas;
end;

function TcxGridTopDetailsSiteViewInfo.GetContainer: TcxControl;
begin
  Result := Control;
end;

function TcxGridTopDetailsSiteViewInfo.GetDesignController: TcxCustomGridDesignController;
begin
  Result := Control.Controller.DesignController;
end;

function TcxGridTopDetailsSiteViewInfo.GetMasterRecord: TObject;
begin
  Result := nil;
end;

function TcxGridTopDetailsSiteViewInfo.GetMaxHeight: Integer;
begin
  with Control.ViewInfo.ClientBounds do
    Result := Bottom - Top;
end;

function TcxGridTopDetailsSiteViewInfo.GetMaxWidth: Integer;
begin
  with Control.ViewInfo.ClientBounds do
    Result := Right - Left;
end;

procedure TcxGridTopDetailsSiteViewInfo.InitTabHitTest(AHitTest: TcxGridDetailsSiteTabHitTest);
begin
  AHitTest.Owner := Control;
end;

procedure TcxGridTopDetailsSiteViewInfo.ChangeActiveTab(ALevel: TcxGridLevel;
  AFocusView: Boolean = False);
begin
  Control.ActiveLevel := ALevel;
end;

function TcxGridTopDetailsSiteViewInfo.DetailHasData(ALevel: TcxGridLevel): Boolean;
begin
  Result := (ALevel.GridView <> nil) and not ALevel.GridView.ViewData.IsEmpty;
end;

function TcxGridTopDetailsSiteViewInfo.SupportsTabAccelerators: Boolean;
begin
  Result := True;
end;

procedure TcxGridTopDetailsSiteViewInfo.VisibilityChanged(AVisible: Boolean);
begin
  if not Control.IsDestroying then inherited;
end;

{ TcxGridViewInfo }

constructor TcxGridViewInfo.Create(AControl: TcxCustomGrid);
begin
  inherited;
  CreateViewInfos;
end;

destructor TcxGridViewInfo.Destroy;
begin
  DestroyViewInfos;
  FDetailsSiteViewInfoCachedInfo.Free;
  inherited;
end;

function TcxGridViewInfo.GetBounds: TRect;
begin
  Result := Control.Bounds;
end;

function TcxGridViewInfo.GetClientBounds: TRect;
begin
  Result := Control.ClientBounds;
end;

function TcxGridViewInfo.GetEmptyAreaColor: TColor;
begin
  Result := Control.Color;
end;

procedure TcxGridViewInfo.CreateViewInfos;
begin
  FDetailsSiteViewInfo :=
    TcxGridTopDetailsSiteViewInfoClass(GetDetailsSiteViewInfoClass).Create(Control.Levels);
  if FDetailsSiteViewInfoCachedInfo <> nil then
    FDetailsSiteViewInfo.SetCachedInfo(FDetailsSiteViewInfoCachedInfo);
end;

procedure TcxGridViewInfo.DestroyViewInfos;
begin
  FDetailsSiteViewInfo.GetCachedInfo(FDetailsSiteViewInfoCachedInfo);
  FDetailsSiteViewInfo.Free;
end;

function TcxGridViewInfo.GetDetailsSiteViewInfoClass: TcxGridTopDetailsSiteViewInfoClass;
begin
  Result := TcxGridTopDetailsSiteViewInfo;
end;

procedure TcxGridViewInfo.RecreateViewInfos;
begin
  DestroyViewInfos;
  CreateViewInfos;
end;

procedure TcxGridViewInfo.Calculate;
begin
  RecreateViewInfos;
  with ClientBounds, TcxGridTopDetailsSiteViewInfo(FDetailsSiteViewInfo) do
    if Visible then Calculate(Left, Top);
end;

function TcxGridViewInfo.GetHitTest(X, Y: Integer): TcxCustomGridHitTest;
begin
  Result := TcxGridTopDetailsSiteViewInfo(FDetailsSiteViewInfo).GetHitTest(Point(X, Y));
  if Result = nil then
    Result := TcxGridNoneHitTest.Instance(Point(X, Y));
end;

{ TcxGridLevelTabs }

constructor TcxGridLevelTabs.Create(AOwner: TcxCustomGrid);
begin
  inherited Create;
  FOwner := AOwner;
  FCaptionAlignment := cxGridLevelTabsDefaultCaptionAlignment;
  FFreeNotificator := TcxFreeNotificator.Create(nil);
  FFreeNotificator.OnFreeNotification := FreeNotification;
  FImageBorder := cxGridLevelTabsDefaultImageBorder;
  FImagesChangeLink := TChangeLink.Create;
  FImagesChangeLink.OnChange := ImagesChanged;
  FSlants := TcxTabSlants.Create(Self);
  FSlants.OnChange := SlantsChanged;
  FStyle := cxPCDefaultStyle;
end;

destructor TcxGridLevelTabs.Destroy;
begin
  FSlants.Free;
  FImagesChangeLink.Free;
  FFreeNotificator.Free;
  inherited;
end;

procedure TcxGridLevelTabs.SetCaptionAlignment(Value: TAlignment);
begin
  if FCaptionAlignment <> Value then
  begin
    FCaptionAlignment := Value;
    Changed;
  end;
end;

procedure TcxGridLevelTabs.SetImageBorder(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FImageBorder <> Value then
  begin
    FImageBorder := Value;
    Changed;
  end;
end;

procedure TcxGridLevelTabs.SetImages(Value: TCustomImageList);
begin
  cxSetImageList(Value, FImages, FImagesChangeLink, FFreeNotificator);
end;

procedure TcxGridLevelTabs.SetSlants(Value: TcxTabSlants);
begin
  FSlants.Assign(Value);
end;

procedure TcxGridLevelTabs.SetStyle(Value: TcxPCStyleID);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Changed;
  end;
end;

procedure TcxGridLevelTabs.FreeNotification(Sender: TComponent);
begin
  if Sender = Images then Images := nil;
end;

procedure TcxGridLevelTabs.ImagesChanged(Sender: TObject);
begin
  Changed;
end;

procedure TcxGridLevelTabs.SlantsChanged(Sender: TObject);
begin
  Changed;
end;

procedure TcxGridLevelTabs.Changed;
begin
  FOwner.SizeChanged;
end;

procedure TcxGridLevelTabs.Assign(Source: TPersistent);
begin
  if Source is TcxGridLevelTabs then
    with TcxGridLevelTabs(Source) do
    begin
      Self.CaptionAlignment := CaptionAlignment;
      Self.ImageBorder := ImageBorder;
      Self.Images := Images;
      Self.Slants := Slants;
      Self.Style := Style;
    end
  else
    inherited;