cxpc.pas

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

function PointGetter(const APoint: TPoint; AIsY: Boolean): Longint;
begin
  if AIsY then
    Result := APoint.Y
  else
    Result := APoint.X;
end;

procedure PointSetter(var APoint: TPoint; AIsY: Boolean; AValue: Longint);
begin
  if AIsY then
    APoint.Y := AValue
  else
    APoint.X := AValue;
end;

procedure PrepareBitmap(ABitmap: TBitmap; AParametersSource: TcxCanvas;
  ASize: TSize; ABackgroundColor: TColor);
begin
  ABitmap.Width := ASize.cx;
  ABitmap.Height := ASize.cy;
  with ABitmap.Canvas do
  begin
    Font.Assign(AParametersSource.Font);
    Pen := AParametersSource.Pen;

    Brush := AParametersSource.Brush;
    Brush.Color := ABackgroundColor;
    Brush.Style := bsSolid;
    FillRect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
    Brush := AParametersSource.Brush;
  end;
end;

procedure RectSetter(var ARect: TRect; AIsLeftTop, AIsY: Boolean;
  AValue: Longint);
begin
  if AIsLeftTop then
  begin
    if AIsY then
      ARect.Top := AValue
    else
      ARect.Left := AValue;
  end
  else
  begin
    if AIsY then
      ARect.Bottom := AValue
    else
      ARect.Right := AValue;
  end;
end;

procedure RetrieveWindowsVersion;
begin
  IsWin98Or2000 :=
    (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (Win32MinorVersion <> 0) or
    (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion = 5);
end;

function RotateRect(const ARect: TRect; ATabPosition: TcxTabPosition): TRect;
begin
  case ATabPosition of
    tpLeft: Result := Rect(ARect.Top, ARect.Right, ARect.Bottom, ARect.Left);
    tpTop: Result := ARect;
    tpRight: Result := Rect(ARect.Bottom, ARect.Left, ARect.Top, ARect.Right);
    tpBottom: Result := Rect(ARect.Right, ARect.Bottom, ARect.Left, ARect.Top);
  end;
end;

function RotateRectBack(const ARect: TRect; ATabPosition: TcxTabPosition): TRect;
begin
  case ATabPosition of
    tpLeft: Result := RotateRect(ARect, tpRight);
    tpTop: Result := ARect;
    tpRight: Result := RotateRect(ARect, tpLeft);
    tpBottom: Result := RotateRect(ARect, tpBottom);
  end;
end;

function TextSize(ATab: TcxTab; const AText: string; AFont: TFont = nil): TSize;
begin
  if AFont = nil then
    ATab.ParentControl.PrepareTabCanvasFont(ATab, cxScreenCanvas)
  else
    cxScreenCanvas.Font := AFont;
  Result := cxTextSize(cxScreenCanvas.Handle, AText);
end;

procedure ValidateRect(var R: TRect);
begin
  with R do
  begin
    if Right < Left then
      Right := Left;
    if Bottom < Top then
      Bottom := Top;
  end;
end;

function VerifyImageList(Images: TCustomImageList): Boolean;
begin
  Result := (Images <> nil) and (Images.Count > 0);
end;

function GetPCStyleName(AStyleID: TcxPCStyleID): string;
var
  APainterClass: TcxPCPainterClass;
begin
  if AStyleID = cxPCDefaultStyle then
    Result := cxPCDefaultStyleName
  else
  begin
    APainterClass := PaintersFactory.GetPainterClass(AStyleID);
    if APainterClass = nil then
      Result := ''
    else
      Result := APainterClass.GetStyleName;
  end;
end;

function PageControlDependsControls: TList;
begin
  Result := FDependsControls;
end;

{ TcxTabSlants }

constructor TcxTabSlants.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FKind := skSlant;
  FPositions := [spLeft];
end;

procedure TcxTabSlants.Assign(Source: TPersistent);
begin
  if Source is TcxTabSlants then
  begin
    Kind := TcxTabSlants(Source).Kind;
    Positions := TcxTabSlants(Source).Positions;
  end
  else
    inherited Assign(Source);
end;

function TcxTabSlants.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TcxTabSlants.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TcxTabSlants.SetKind(Value: TcxTabSlantKind);
begin
  if Value <> FKind then
  begin
    FKind := Value;
    Changed;
  end;
end;

procedure TcxTabSlants.SetPositions(Value: TcxTabSlantPositions);
begin
  if Value <> FPositions then
  begin
    FPositions := Value;
    Changed;
  end;
end;

procedure TcxCustomTabControl.ArrowButtonClick(
  NavigatorButton: TcxPCNavigatorButton);
var
  SpecialAlignment: Boolean;
  Direction: Integer;
begin
  if FNavigatorButtonStates[NavigatorButton] = nbsDisabled then Exit;
  SpecialAlignment := IsRightToLeftAlignment(Self) or IsBottomToTopAlignment(Self);
  if (SpecialAlignment and (NavigatorButton = nbTopLeft)) or
     ((not SpecialAlignment) and (NavigatorButton = nbBottomRight)) then
    Direction := 1
  else
    Direction := -1;
  Inc(FFirstVisibleTab, Direction);
  RequestLayout;
end;

procedure TcxCustomTabControl.Calculate;

var
  cTabsDistance: Integer; // c - longitudinal coordinate

  function InitializeVariables: Boolean;
  begin
    FNavigatorButtons := [];
    SynchronizeNavigatorButtons;
    FTabsPosition := FPainter.GetTabsPosition([]);
    Result := FTabsPosition.NormalRowWidth > 0;
    if not Result then Exit;
    cTabsDistance := DistanceGetter(FPainter.GetTabsNormalDistance, not Rotate{along "c" axis});
  end;

  procedure MultiLineCalculate;
  begin
    if not InitializeVariables then Exit;

    PlaceVisibleTabsOnRows(FTabsPosition.NormalRowWidth, cTabsDistance);
    CalculateLongitudinalTabPositions;
    CalculateRowHeight;
    RearrangeRows;
  end;

  procedure NotMultiLineCalculate;

    procedure SetTabRows;
    var
      FirstIndex, LastIndex, I: Integer;
    begin
      InitializeVisibleTabRange(Self, FirstIndex, LastIndex);
      for I := FirstIndex to LastIndex do
        with FVisibleTabList[I] do
        begin
          FRow := 0;
          FVisibleRow := 0;
        end;
    end;

  begin
    FRowCount := 1;
    if TabPosition in [tpTop, tpLeft] then FTopOrLeftPartRowCount := 1
    else FTopOrLeftPartRowCount := 0;
    CalculateLongitudinalTabPositions;
    if IsTooSmallControlSize then Exit;
    SetTabRows;
    CalculateRowHeight;
    CalculateRowPositions;
  end;

  procedure ResetControlInternalVariables;
  var
    VisibleTabCount: Integer;

    procedure ValidateTabVisibleIndex(var TabVisibleIndex: Integer);
    begin
      if TabVisibleIndex >= VisibleTabCount then
        TabVisibleIndex := -1;
    end;

  begin
    VisibleTabCount := FVisibleTabList.Count;

    FExtendedBottomOrRightTabsRect := cxEmptyRect;
    FExtendedTopOrLeftTabsRect := cxEmptyRect;

    if (FFirstVisibleTab = -1) and (VisibleTabCount > 0) then
      FFirstVisibleTab := 0;
    if FFirstVisibleTab >= VisibleTabCount then
      FFirstVisibleTab := VisibleTabCount - 1;
    FLastVisibleTab := FFirstVisibleTab;

    ValidateTabVisibleIndex(FHotTrackTabVisibleIndex);
    ValidateTabVisibleIndex(FMainTabVisibleIndex);
    ValidateTabVisibleIndex(FPressedTabVisibleIndex);

    FRowCount := 0;

    if FTabIndex >= Tabs.Count then
      FTabIndex := Tabs.Count - 1;

    FTopOrLeftPartRowCount := 0;
  end;

begin
  ResetControlInternalVariables;
  if FVisibleTabList.Count = 0 then
  begin
    InitializeVariables;
    Exit;
  end;
  CalculateTabNormalSizes;
  if MultiLine then MultiLineCalculate else NotMultiLineCalculate;
end;

procedure TcxCustomTabControl.CalculateLongitudinalTabPositions;

  procedure InternalCalculateLongitudinalTabPositions(
    AFirstIndex, ALastIndex: Integer; ACalculateAll: Boolean = False; Row: Integer = 0);
  var
    I: Integer;
    ALineStartPosition, ALineFinishPosition: Integer;
    ATabStartPosition, ATabFinishPosition, ATabWidth: Integer;
    ADistanceBetweenTabs: Integer;
    AIsY: Boolean;
    ASign: Integer;
  begin
    AIsY := TabPosition in [tpLeft, tpRight];
    ALineStartPosition := PointGetter(FTabsPosition.NormalTabsRect.TopLeft, AIsY);
    ASign := 1;
    if IsRightToLeftAlignment(Self) or IsBottomToTopAlignment(Self) then
    begin
      ALineFinishPosition := -ALineStartPosition;
      Inc(ALineStartPosition, FTabsPosition.NormalRowWidth - 1);
      ASign := -1;
    end
    else
      ALineFinishPosition := ALineStartPosition + FTabsPosition.NormalRowWidth - 1;
    ADistanceBetweenTabs := DistanceGetter(FPainter.GetTabsNormalDistance, not Rotate);

    ATabStartPosition := ALineStartPosition;
    ATabFinishPosition := ATabStartPosition;
    for I := AFirstIndex to ALastIndex do
    begin
      FLastVisibleTab := I;
      ATabWidth := FVisibleTabList[I].NormalLongitudinalSize;
      ATabFinishPosition := ATabStartPosition + (ATabWidth - 1) * ASign;
      with FVisibleTabList[I] do
        if ASign > 0 then
          PointSetter(FTab