dxpagecontrol.pas

PageControl 2.0 与1.0兼营版控件 ,TPageControl的扩展。增强了一些功能。

  end;
end;

function DistanceGetter(const Distance: TcxPCDistance; const LongitudinalDistance: Boolean): Integer;
begin
  with Distance do
    if LongitudinalDistance then Result := dw else Result := dh;
end;

function GetButtonCount(NavigatorButtons: TcxPCNavigatorButtons): Integer;
var
  NavigatorButton: TcxPCNavigatorButton;
begin
  Result := 0;
  for NavigatorButton := Low(TcxPCNavigatorButton) to High(TcxPCNavigatorButton) do
    if NavigatorButton in NavigatorButtons then
      Inc(Result);
end;

function GetTextRotationAngle(TabControl: TcxCustomTabControl): TcxPCRotationAngle;
begin
  with TabControl do
    if IsVerticalText(TabControl) then
      if pcoTopToBottomText in Options then
        Result := raMinus90
      else
        Result := raPlus90
    else
      Result := ra0;
end;

procedure InitializeLineBoundsArray(TabControl: TcxCustomTabControl; var LineIndexBoundsA: TcxPCLineIndexBoundsArray);
var
  LineCount, I: Integer;
  FirstIndex, LastIndex: Integer;
begin
  with TabControl do
  begin
    SetLength(LineIndexBoundsA, RowCount);
    if RowCount = 0 then
      Exit;
    for LineCount := 0 to RowCount - 1 do
      LineIndexBoundsA[LineCount].Left := -1;
    InitializeVisibleTabRange(TabControl, FirstIndex, LastIndex);
    for I := FirstIndex to LastIndex do
      with LineIndexBoundsA[FVisibleTabList[I].VisibleRow] do
        if Left = -1 then
        begin
          Left := I;
          Right := I;
        end else
        begin
          if I < Left then Left := I;
          if I > Right then Right := I;
        end;
  end;
end;

procedure InitializeVisibleTabRange(TabControl: TcxCustomTabControl; var FirstIndex,
  LastIndex: Integer);
begin
  with TabControl do
    if MultiLine then
    begin
      FirstIndex := 0;
      LastIndex := FVisibleTabList.Count - 1;
    end
    else
    begin
      FirstIndex := FFirstVisibleTab;
      if FFirstVisibleTab = -1 then
        LastIndex := -2
      else
        LastIndex := FLastVisibleTab;
    end;
end;

function InternalGetTextRotationAngle(TabControl: TcxCustomTabControl): TcxPCRotationAngle;
begin
  if TabControl.Painter.IsNativePainting then
    Result := ra0
  else
    Result := GetTextRotationAngle(TabControl);
end;

function InternalIsVerticalText(TabControl: TcxCustomTabControl): Boolean;
begin
  Result := not TabControl.Painter.IsNativePainting and
    IsVerticalText(TabControl);
end;

function InternalGetCursorPos: TPoint;
begin
{$IFDEF VCL}
  GetCursorPos(Result);
{$ELSE}
  QCursor_pos(@Result);
{$ENDIF}
end;

function IsBottomToTopAlignment(TabControl: TcxCustomTabControl): Boolean;
begin
  with TabControl do
  begin
    Result := (TabPosition in [tpLeft, tpRight]) and (not Rotate) and
      not(pcoTopToBottomText in Options);
  end;
end;

function IsRightToLeftAlignment(TabControl: TcxCustomTabControl): Boolean;
begin
  with TabControl do
  begin
    Result := (TabPosition in [tpTop, tpBottom]) and Rotate and
      (pcoTopToBottomText in Options);
  end;
end;

function IsVerticalText(TabControl: TcxCustomTabControl): Boolean;
begin
  with TabControl do
  begin
    Result := (TabPosition in [tpLeft, tpRight]) and (not Rotate);
    Result := Result or (TabPosition in [tpTop, tpBottom]) and Rotate;
  end;
end;

{$IFNDEF VCL}
function MouseButtonToShift(Button: TMouseButton): TShiftState;
begin
  case Button of
    mbLeft:
      Result := [ssLeft];
    mbMiddle:
      Result := [ssMiddle];
    mbRight:
      Result := [ssRight];
  end;
end;
{$ENDIF}

function PointGetter(APoint: TPoint; GetY: Boolean): Longint;
begin
  with APoint do
    if GetY then Result := Y else Result := X;
end;

procedure PointSetter(var APoint: TPoint; SetY: Boolean; Value: Longint);
begin
  with APoint do
    if SetY then Y := Value else X := Value;
end;

procedure PrepareBitmap(Bitmap: TBitmap; ParametersSource: TcxCanvas; Size: TSize;
  BackgroundColor: TColor; ATransparent: Boolean);
begin
  with Bitmap, Bitmap.Canvas do
  begin
    Width := Size.cx;
    Height := Size.cy;
    Brush := ParametersSource.Brush;
    Font.Assign(ParametersSource.Font);
    Pen := ParametersSource.Pen;

    if ATransparent then
      Transparent := True
    else
    begin
      Brush.Color := BackgroundColor;
      Brush.Style := bsSolid;
      FillRect(Rect(0, 0, Width, Height));
      Brush := ParametersSource.Brush;
    end;
  end;
end;

function RemoveAccelChars(S: TCaption): TCaption;
const
  AccelChar: {$IFDEF VCL}Char{$ELSE}WideChar{$ENDIF} = '&';
var
  I, LastIndex: Integer;
begin
  Result := '';
  I := 1;
  LastIndex := Length(S);
  while I <= LastIndex do
  begin
    if S[I] = AccelChar then
      if I < LastIndex then Inc(I)
{$IFDEF VCL}
      else
      begin
        Result := Result + '_';
        Break;
      end;
{$ENDIF}
      ;
    Result := Result + S[I];
    Inc(I);
  end;
end;

{$IFDEF VCL}
procedure RetrieveWindowsVersion;
var
  Info: TOSVersionInfo;
begin
  Info.dwOSVersionInfoSize := SizeOf(Info);
  GetVersionEx(Info);
  IsWin98Or2000 :=
    (Info.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and (Info.dwMinorVersion <> 0) or
    (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and (Info.dwMajorVersion = 5);
end;
{$ENDIF}

{$IFDEF VCL}
procedure RotateBitmap(Bitmap: TBitmap; Angle: TcxPCRotationAngle);
var
  PDest, PDestStart: ^DWord;
  PSource: ^DWord;
  PBuffer: Pointer;
  XSource, YSource: Integer;
  LineCopyingDirection: Integer;
  TempVar: Integer;
begin
  case Angle of
    ra180:
      with Bitmap do
      begin
        GetMem(PBuffer, Width * 4);
        PDestStart := ScanLine[Height - 1];
        PDest := PDestStart;
        Integer(PSource) := Integer(PDest) + Height * Width * 4;
        for YSource := 0 to Height div 2 - 1 do
        begin
          Move(PDest^, PBuffer^, Width * 4);
          for XSource := 0 to Width - 1 do
          begin
            Dec(PSource);
            PDest^ := PSource^;
            Inc(PDest);
          end;

          PDest := Pointer(PSource);
          Integer(PSource) := Integer(PBuffer) + Width * 4;
          for XSource := 0 to Width - 1 do
          begin
            Dec(PSource);
            PDest^ := PSource^;
            Inc(PDest);
          end;

          Integer(PSource) := Integer(PDest) - Width * 4;
          Inc(PDestStart, Width);
          PDest := PDestStart;
        end;
        if Height mod 2 <> 0 then
          for XSource := 0 to Width div 2 - 1 do
          begin
            Dec(PSource);
            PDest^ := PSource^;
            Inc(PDest);
          end;

        Width := Width + 1;
        Width := Width - 1;
        FreeMem(PBuffer);
      end;
    raPlus90, raMinus90:
      with Bitmap do
      begin
        GetMem(PBuffer, Width * Height * 4);

        LineCopyingDirection := 0;
        PDestStart := PBuffer;
        case Angle of
          raPlus90:
            begin
              Inc(PDestStart, Height * (Width - 1));
              LineCopyingDirection := 1;
            end;
          raMinus90:
            begin
              Inc(PDestStart, Height - 1);
              LineCopyingDirection := -1;
            end;
        end;

        PSource := ScanLine[0];
        for YSource := 0 to Height - 1 do
        begin
          PDest := PDestStart;
          for XSource := 0 to Width - 1 do
          begin
            PDest^ := PSource^;
            Dec(PDest, Height * LineCopyingDirection);
            Inc(PSource);
          end;
          Inc(PDestStart, LineCopyingDirection);
          Dec(PSource, Width * 2);
        end;

        TempVar := Width;
        Width := Height;
        Height := TempVar;
        if Width = Height then
        begin
          Width := Width + 1;
          Width := Width - 1;
        end;

        PSource := PBuffer;
        PDest := ScanLine[0];
        for YSource := 0 to Height - 1 do
        begin
          Move(PSource^, PDest^, Width * 4);
          Inc(PSource, Width);
          Dec(PDest, Width);
        end;

        FreeMem(PBuffer);
      end;
  end;
end;
{$ELSE}
procedure RotateBitmap(Bitmap: TBitmap; Angle: TcxPCRotationAngle);
var
  PDest, PDestStart: ^DWord;
  PSource: ^DWord;
  PBuffer: Pointer;
  XSource, YSource: Integer;
  LineCopyingDirection: Integer;
  TempVar: Integer;
begin
  case Angle of
    raPlus90, raMinus90:
      with Bitmap do
      begin
        GetMem(PBuffer, Width * Height * 4);

        LineCopyingDirection := 0;
        PDestStart := PBuffer;
        case Angle of
          raPlus90:
            begin
              Inc(PDestStart, Height * (Width - 1));
              LineCopyingDirection := 1;
            end;
          raMinus90:
            begin
              Inc(PDestStart, Height - 1);
              LineCopyingDirection := -1;
            end;
        end;

        for YSource := 0 to Height - 1 do