cxpcgodialog.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressPageControl                                           }
{                                                                    }
{       Copyright (c) 1998-2004 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSPAGECONTROL AND ALL            }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxPCGoDialog;

{$I cxPCVer.inc}

interface

uses
{$IFDEF VCL}
  Windows,
{$ELSE}
  Types, QTypes,
{$ENDIF}
  Classes, Controls, Forms, StdCtrls, cxContainer, cxGraphics,
  cxLookAndFeelPainters;

type

  { TcxPCGoDialogListBox }

  TcxPCGoDialogListBox = class(TcxCustomListBox)
  private
    FOnSelect: TNotifyEvent;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoSelect(ANewItemIndex: Integer);
  public
{$IFNDEF VCL}
    constructor Create(AOwner: TComponent); override;
{$ENDIF}
    property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
  end;

  { TcxPCGoDialogViewInfo }

  TcxPCGoDialogViewInfo = class(TcxContainerViewInfo)
  private
    function GetClientExtent: TRect;
  public
    procedure Paint(ACanvas: TcxCanvas); override;
  end;

  { TcxPCGoDialog }

  TcxPCGoDialog = class(TcxCustomPopupWindow)
  private
    FList: TcxPCGoDialogListBox;
    FTabIndex: Integer;
    procedure CalculateViewInfo;
    function GetListSize: TSize;
    function GetSorted: Boolean;
    function GetViewInfo: TcxPCGoDialogViewInfo;
    procedure ListSelectHandler(Sender: TObject);
    procedure SetSorted(const Value: Boolean);
  protected
    procedure CalculateSize; override;
    procedure Resize; override;
{$IFNDEF VCL}
  {$IFDEF MSWINDOWS}
    function WidgetFlags: Integer; override;
  {$ENDIF}
{$ENDIF}
    procedure ClearItems;
    property ViewInfo: TcxPCGoDialogViewInfo read GetViewInfo;
  public
    constructor Create(AOwner: TWinControl); reintroduce;
    destructor Destroy; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
    procedure InitializeItems;
    procedure Popup; reintroduce;
    property Sorted: Boolean read GetSorted write SetSorted;
    property TabIndex: Integer read FTabIndex write FTabIndex;
  end;

  TcxTabIndex = class
  public
    TabIndex: Integer;
  end;

implementation

uses
{$IFNDEF VCL}
  Qt,
{$ENDIF}
  Graphics, dxPageControl, cxControls;

type
  TcxCustomTabControlAccess = class(TcxCustomTabControl);
  TcxPCCustomPainterAccess = class(TcxPCCustomPainter);
  TWinControlAccess = class(TWinControl);

const
  cxPCGoDialogFrameWidth = 2;

function GetScrollBarSize: TSize;
begin
  {$IFDEF VCL}
  Result.cx := GetSystemMetrics(SM_CXVSCROLL);
  Result.cy := GetSystemMetrics(SM_CYHSCROLL);
  {$ELSE}
  QStyle_scrollBarExtent(QApplication_style, @Result);
  {$ENDIF}
end;

{ TcxPCGoDialogListBox }

{$IFNDEF VCL}
constructor TcxPCGoDialogListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  InputKeys := InputKeys + [ikReturns];
end;
{$ENDIF}

procedure TcxPCGoDialogListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_ESCAPE:
      DoSelect(-1);
    VK_RETURN:
      DoSelect(ItemIndex);
  end;
end;

procedure TcxPCGoDialogListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  AItemIndex: Integer;
begin
  inherited MouseMove(Shift, X, Y);
  if GetCaptureControl <> Self then
  begin
    AItemIndex := ItemAtPos(Point(X, Y), True);
    if (AItemIndex <> -1) and (ItemIndex <> AItemIndex) then
    begin
      ItemIndex := AItemIndex;
{$IFNDEF VCL}
      QListBox_ensureCurrentVisible(Handle);
{$ENDIF}
    end;
  end;
end;

procedure TcxPCGoDialogListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AItemIndex: Integer;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button <> mbLeft then
    Exit;
  AItemIndex := ItemAtPos(Point(X, Y), True);
  if AItemIndex <> -1 then
  begin
    SetCaptureControl(nil);
    DoSelect(AItemIndex);
  end;
end;

procedure TcxPCGoDialogListBox.DoSelect(ANewItemIndex: Integer);
begin
  ItemIndex := ANewItemIndex;
  if Assigned(FOnSelect) then
    FOnSelect(Self);
end;

{ TcxPCGoDialogViewInfo }

procedure TcxPCGoDialogViewInfo.Paint(ACanvas: TcxCanvas);
var
  R: TRect;
begin
  with ACanvas do
  begin
    R := Bounds;
    DrawEdge(R, False, True);
    InflateRect(R, -1, -1);
    DrawEdge(R, False, False);
  end;
end;

function TcxPCGoDialogViewInfo.GetClientExtent: TRect;
begin
  with Result do
  begin
    Left := cxPCGoDialogFrameWidth;
    Top := cxPCGoDialogFrameWidth;
    Right := cxPCGoDialogFrameWidth;
    Bottom := cxPCGoDialogFrameWidth;
  end;
end;

{ TcxPCGoDialog }

constructor TcxPCGoDialog.Create(AOwner: TWinControl);
begin
  inherited Create(AOwner);
  CaptureFocus := True;
  IsTopMost := True;
  FList := TcxPCGoDialogListBox.Create(Self);
  FList.BorderStyle := bsNone;
  FList.LookAndFeel.MasterLookAndFeel := TcxCustomTabControlAccess(OwnerControl).LookAndFeel;
  FList.Parent := Self;
  FList.OnSelect := ListSelectHandler;

  Adjustable := False;
  Width := 125;
  Height := 101;
  CalculateViewInfo;
end;

destructor TcxPCGoDialog.Destroy;
begin
  ClearItems;
  FList.Free;
  inherited Destroy;
end;

class function TcxPCGoDialog.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxPCGoDialogViewInfo;
end;

procedure TcxPCGoDialog.InitializeItems;
var
  ANewItemIndex: Integer;
  ATab: TcxTab;
  ATabIndex: TcxTabIndex;
  I: Integer;
  S: TCaption;
{$IFDEF VCL}
  AScrollWidth: Integer;
{$ENDIF}
begin
  ClearItems;
  with TcxCustomTabControlAccess(OwnerControl) do
  begin
    {$IFDEF VCL}AScrollWidth := 0;{$ENDIF}
    for I := 0 to Tabs.VisibleTabsCount - 1 do
    begin
      ATab := Tabs.VisibleTabs[I];
      if ATab.RealEnabled then
      begin
        ATabIndex := TcxTabIndex.Create;
        ATabIndex.TabIndex := ATab.Index;
        S := RemoveAccelChars(ATab.Caption);
{$IFDEF VCL}
        if FList.Canvas.TextWidth(S) > AScrollWidth then
          AScrollWidth := FList.Canvas.TextWidth(S);
{$ENDIF}
        FList.Items.AddObject(S, ATabIndex);
      end;
    end;
    ANewItemIndex := -1;
    with FList do
      for I := 0 to Items.Count - 1 do
        if TcxTabIndex(Items.Objects[I]).TabIndex = FTabIndex then
        begin
          ANewItemIndex := I;
          Break;
        end;
    FList.ItemIndex := ANewItemIndex;
    {$IFNDEF VCL}FList.MakeCurrentVisible;{$ENDIF}
    FTabIndex := -1;
{$IFDEF DELPHI6}
  {$IFDEF VCL}
    FList.ScrollWidth := AScrollWidth;
  {$ENDIF}
{$ENDIF}
  end;
end;

procedure TcxPCGoDialog.Popup;
begin
  with TcxCustomTabControlAccess(OwnerControl) do
  begin
    case TabPosition of
      tpLeft:
        AlignHorz := pahLeft;
      tpRight:
        AlignHorz := pahRight;
      else
        if NavigatorPosition in [npLeftTop, npLeftBottom] then
          AlignHorz := pahLeft
        else
          AlignHorz := pahRight;
    end;

    case TabPosition of
      tpTop:
        AlignVert := pavBottom;
      tpBottom:
        AlignVert := pavTop;
      else
        if NavigatorPosition in [npLeftTop, npRightTop] then
          AlignVert := pavBottom
        else
          AlignVert := pavTop;
    end;

    OwnerBounds := TcxPCCustomPainterAccess(Painter).GetGoDialogButtonBounds;
  end;
  OwnerParent := OwnerControl;
  FList.Visible := True;
  CalculateSize;
  CalculateViewInfo;
  with ViewInfo.ClientRect do
    FList.SetBounds(Left, Top, Right - Left, Bottom - Top);
  inherited Popup(FList);
end;

procedure TcxPCGoDialog.CalculateSize;
var
  ASize: TSize;
  AClientExtent: TRect;
begin
  ASize := GetListSize;
  AClientExtent := ViewInfo.GetClientExtent;
  Width := ASize.cx + AClientExtent.Left + AClientExtent.Right;
  Height := ASize.cy + AClientExtent.Top + AClientExtent.Bottom;
  CalculateViewInfo;
  with ViewInfo.ClientRect do
    FList.SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

procedure TcxPCGoDialog.Resize;
begin
  inherited Resize;
  CalculateViewInfo;
end;

{$IFNDEF VCL}
  {$IFDEF MSWINDOWS}
function TcxPCGoDialog.WidgetFlags: Integer;
begin
  Result := inherited WidgetFlags and not Integer(WidgetFlags_WType_Popup);
end;
  {$ENDIF}
{$ENDIF}

procedure TcxPCGoDialog.ClearItems;
var
  I: Integer;
begin
  for I := 0 to FList.Items.Count - 1 do
    FList.Items.Objects[I].Free;
  FList.Clear;
end;

procedure TcxPCGoDialog.CalculateViewInfo;
begin
  with ViewInfo do
  begin
    Bounds := GetControlRect(Self);
    ClientRect := Bounds;
    ExtendRect(ClientRect, GetClientExtent);
  end;
end;

function TcxPCGoDialog.GetListSize: TSize;
var
  AClientWidth: Integer;
  AListRowCount, I: Integer;
  AItemWidth: Integer;
  AScrollBarSize: TSize;
  AScrollWidth: Integer;
  AVScrollBar: Boolean;
begin
  Result.cx := 125;
  FList.Canvas.Font := FList.Font;
  AListRowCount := 0;
  AScrollWidth := 0;
  with TcxCustomTabControlAccess(OwnerControl) do
    for I := 0 to Tabs.VisibleTabsCount - 1 do
      if Tabs.VisibleTabs[I].RealEnabled then
      begin
        AItemWidth := FList.Canvas.TextWidth(Tabs.VisibleTabs[I].VisibleCaption);
        if AItemWidth > AScrollWidth then
          AScrollWidth := AItemWidth;
        Inc(AListRowCount);
      end;
{$IFDEF MSWINDOWS}
  Inc(AScrollWidth, 4);
{$ENDIF}
{$IFDEF LINUX}
  Inc(AScrollWidth, 6);
{$ENDIF}
  AVScrollBar := AListRowCount > 7;
  if AVScrollBar then
    AListRowCount := 7;
  Result.cy := FList.ItemHeight * AListRowCount;
{$IFDEF VCL}
  TWinControlAccess(FList).RecreateWnd;
  FList.ScrollWidth := AScrollWidth;
{$ENDIF}
  AScrollBarSize := GetScrollBarSize;
  AClientWidth := Result.cx;
  if AVScrollBar then
    Dec(AClientWidth, AScrollBarSize.cx);
  if AScrollWidth > AClientWidth then
    Inc(Result.cy, AScrollBarSize.cy);
end;

function TcxPCGoDialog.GetSorted: Boolean;
begin
  Result := FList.Sorted;
end;

function TcxPCGoDialog.GetViewInfo: TcxPCGoDialogViewInfo;
begin
  Result := TcxPCGoDialogViewInfo(FViewInfo);
end;

procedure TcxPCGoDialog.ListSelectHandler(Sender: TObject);
begin
  with FList do
    if ItemIndex = -1 then
      FTabIndex := -1
    else
      FTabIndex := TcxTabIndex(Items.Objects[ItemIndex]).TabIndex;
  CloseUp;
end;

procedure TcxPCGoDialog.SetSorted(const Value: Boolean);
begin
  FList.Sorted := Value;
end;

end.