cxgeometry.pas

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

begin
  Right := Left + AValue;
end;

{ TcxSize }

constructor TcxSize.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TcxSize.Assign(Source: TPersistent);
begin
  if Source is TcxSize then
    Size := TcxSize(Source).Size
  else
    inherited Assign(Source);
end;

function TcxSize.GetValue(Index: Integer): Integer;
begin
  if Index = 0 then
    Result := FSize.cy
  else
    Result := FSize.cx;
end;

function TcxSize.GetSize: TSize;
begin
  Result.cx := Width;
  Result.cy := Height;
end;

procedure TcxSize.SetValue(Index, Value: Integer);
var
  ASize: TSize;
begin
  ASize := Size;
  if Index = 0 then
    ASize.cy := Value
  else
    ASize.cx := Value;
  Size := ASize;
end;

function TcxSize.IsEmpty: Boolean;
begin
  Result := (FSize.cx = 0) and (FSize.cy = 0);
end;

function TcxSize.IsEqual(const ASize: TSize): Boolean;
begin
  Result := cxSizeIsEqual(ASize, FSize);
end;

function TcxSize.IsEqual(ASize: TcxSize): Boolean;
begin
  Result := IsEqual(ASize.Size);
end;

procedure TcxSize.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

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

function TcxSize.GetData: Pointer;
begin
  Result := @FSize;
end;

function TcxSize.IsSizeStored(Index: Integer): Boolean;
begin
  if Index = 0 then
    Result := FSize.cy <> 0
  else
    Result := FSize.cx <> 0;
end;

procedure TcxSize.SetSize(const Value: TSize);
var
  ASize: TSize;
begin
  ASize.cx := Max(0, Value.cx);
  ASize.cy := Max(0, Value.cy);
  if not IsEqual(ASize) then
  begin
    FSize := ASize;
    DoChange;
  end;
end;

function cxRectHeight(const R: TRect): Integer;
begin
  Result := R.Bottom - R.Top;
end;

function cxRectIntersect(const R1, R2: TRect): Boolean;
var
  R: TRect;
begin
  Result := cxRectIntersect(R, R1, R2);
end;

function cxRectIntersect(out R: TRect; const R1,
  R2: TRect): Boolean;
begin
  R := R1;
  with R do
  begin
    if R2.Left > R1.Left then Left := R2.Left;
    if R2.Top > R1.Top then Top := R2.Top;
    if R2.Right < R1.Right then Right := R2.Right;
    if R2.Bottom < R1.Bottom then Bottom := R2.Bottom;
    Result := not ((Right <= Left) or (Bottom <= Top));
  end;
  if not Result then R := cxNullRect;
end;

function cxRectInflate(const R: TRect; DX, DY: Integer): TRect;
begin
  Result := cxRectInflate(R, DX, DY, DX, DY);
end;

function cxRectInflate(const R: TRect; DX1, DY1, DX2, DY2: Integer): TRect;
begin
  Result := R;
  with Result do
  begin
    Dec(Left, DX1);
    Dec(Top, DY1);
    Inc(Right, DX2);
    Inc(Bottom, DY2);
  end;
end;

function cxRectInvert(const R: TRect): TRect;
begin
  Result.TopLeft := cxPointInvert(R.TopLeft);
  Result.BottomRight := cxPointInvert(R.BottomRight);
end;

function cxRectIsEmpty(const R: TRect): Boolean;
begin
  with R do
    Result := (Right <= Left) or (Bottom <= Top);
end;

function cxRectIsEqual(const R, R1: TRect): Boolean;
begin
  Result := (R.Left = R1.Left) and (R.Top = R1.Top) and
    (R.Right = R1.Right) and (R.Bottom = R1.Bottom);
end;

function cxRectIsInvalid(const R: TRect): Boolean;
begin
  Result := cxRectIsEqual(R, cxInvalidRect);
end;

function cxRectIsNull(const R: TRect): Boolean;
begin
  Result := (R.Left = 0) and (R.Top = 0) and (R.Right = 0) and (R.Bottom = 0);
end;

function cxRectGetItem(const ARect: TRect; AIndex: Integer): Integer;
begin
  case AIndex of
    0:
      Result := ARect.Left;
    1:
      Result := ARect.Top;
    2:
      Result := ARect.Right;
    3:
      Result := ARect.Bottom;
  else
    Result := 0
  end;
end;

function cxRectGetSize(const ARect: TRect; AIndex: Integer): Integer;
begin
  if AIndex = 0 then
    Result := ARect.Right - ARect.Left
  else
    Result := ARect.Bottom - ARect.Top;
end;

function cxRectLeftBottom(const R: TRect): TPoint;
begin
  Result := cxPoint(R.Left, R.Bottom);
end;

procedure cxRectMinMaxHeight(const R: TRect; var AMax, AMin: Integer);
begin
  with R do
  begin
    if AMax < Bottom then AMax := Bottom;
    if AMin > Top then AMin := Top;
  end;
end;

procedure cxRectMinMaxInit(var AMin, AMax: Integer);
begin
  AMin := MaxInt;
  AMax := -1;
end;

procedure cxRectMinMaxWidth(const R: TRect; var AMax, AMin: Integer);
begin
  with R do
  begin
    if AMax < Right then AMax := Right;
    if AMin > Left then AMin := Left;
  end;
end;

function cxRectOffset(const R: TRect; const P: TPoint): TRect;
begin
  Result := cxRectOffset(R, P.X, P.Y);
end;

function cxRectOffset(const R: TRect; DX, DY: Integer): TRect;
begin
  Result := R;
  with Result do
  begin
    Inc(Left, DX);
    Inc(Top, DY);
    Inc(Right, DX);
    Inc(Bottom, DY);
  end;
end;

function cxRectOffset(const R: TRect; const Ps: array of TPoint): TRect;
begin
  with cxPointSum(Ps) do
    Result := cxRectOffset(R, X, Y);
end;

function cxRectOffsetHorz(const R: TRect; DX: Integer): TRect;
begin
  Result := R;
  Inc(Result.Left, DX);
  Inc(Result.Right, DX);
end;

function cxRectOffsetVert(const R: TRect; DY: Integer): TRect;
begin
  Result := R;
  Inc(Result.Top, DY);
  Inc(Result.Bottom, DY);
end;

function GetRectCoordinate(const R: TRect; ABottomRight, AVertCoordinate: Boolean): Integer;
begin
  if ABottomRight then
    if AVertCoordinate then
      Result := R.Bottom
    else
      Result := R.Right
  else
    if AVertCoordinate then
      Result := R.Top
    else
      Result := R.Left;
end;

procedure SetRectCoordinate(var R: TRect; ABottomRight, AVertCoordinate: Boolean; AValue: Integer);
begin
  if ABottomRight then
    if AVertCoordinate then
      R.Bottom := AValue
    else
      R.Right := AValue
  else
    if AVertCoordinate then
      R.Top := AValue
    else
      R.Left := AValue;
end;

procedure cxRectOverlapped(const Src, Dst: TRect; out SrcH, SrcV, DstH, DstV: TRect);
var
  H, W: Integer;

  procedure IncV(const ARect: TRect; AVertCoordinate, ABottomRight: Boolean;
    Value: Integer; out AResult: TRect);
  begin
    if Value <> 0 then
    begin
      AResult := ARect;
      SetRectCoordinate(AResult, ABottomRight, AVertCoordinate,
        GetRectCoordinate(AResult, not ABottomRight, AVertCoordinate) + Value);
    end
    else
      AResult := cxNullRect;
  end;

begin
  H := Src.Bottom - Dst.Bottom;
  W := Src.Right - Dst.Right;
  IncV(Src, True, H < 0, -H, SrcH);
  IncV(Dst, True, H > 0, H, DstH);
  IncV(Src, False, W < 0, -W, SrcV);
  IncV(Dst, False, W > 0, W, DstV);
end;

function cxRectPtIn(const R: TRect; const P: TPoint): Boolean;
begin
  Result := cxRectPtIn(R, P.X, P.Y);
end;

function cxRectPtIn(const R: TRect; const X, Y: Integer): Boolean;
begin
  with R do
    Result := (X >= Left) and (X < Right) and (Y >= Top) and (Y < Bottom);
end;

function cxRectPtInEx(const R: TRect;
  const X, Y: Integer; DL, DT, DR, DB: Integer): TcxPtInRectType;

  function InRange(V, V1, V2: Integer): Boolean;
  begin
    V := V - V1;
    Result := (V >= -V2) and (V < V2);
  end;

begin
  if cxRectPtIn(R, X, Y) then
    Result := ptrtArea
  else
    if cxRectPtIn(cxRectInflate(R, DL, DT, DR, DB), X, Y) then
    begin
      with R do
      begin
        if InRange(X, Right, DR) then
          Result := ptrtRight
        else
          if InRange(Y, Bottom, DB) then
            Result := ptrtBottom
          else
            if InRange(X, Left, DL) then
              Result := ptrtLeft
            else
              Result := ptrtTop;
      end;
    end
    else
      Result := ptrtNone;
end;