cxcontainer.pas

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

    procedure LockDeactivate(ALock: Boolean);
    procedure Popup(AFocusedControl: TWinControl); reintroduce; virtual;
    function SetFocusedControl(Control: TWinControl): Boolean; override;
    property CaptureFocus: Boolean read FCaptureFocus write SetCaptureFocus default True;
    property FocusedControl: TWinControl read FFocusedControl write FFocusedControl;
    property IsTopMost: Boolean read FIsTopMost write SetIsTopMost;
    property JustClosed: Boolean read GetJustClosed;
    property ModalMode: Boolean read FModalMode write FModalMode default True;
    property OwnerControl: TWinControl read FOwnerControl;
    property TerminateOnDestroy: Boolean read FTerminateOnDestroy write FTerminateOnDestroy;
    property OnClosed: TNotifyEvent read FOnClosed write FOnClosed;
    property OnClosing: TNotifyEvent read FOnClosing write FOnClosing;
    property OnCloseQuery;
    property OnShowed: TNotifyEvent read FOnShowed write FOnShowed;
    property OnShowing: TNotifyEvent read FOnShowing write FOnShowing;
  end;

  { TcxCustomInnerListBox }

  TcxCustomInnerListBox = class(TListBox, IUnknown,
    IcxContainerInnerControl)
  private
  {$IFNDEF DELPHI6}
    FAutoComplete: Boolean;
  {$ENDIF}
  {$IFNDEF DELPHI8}
    FAutoCompleteDelay: Cardinal;
  {$ENDIF}
    FAutoCompleteFilter: string;
    FCanvas: TcxCanvas;
    FHScrollBar: TcxScrollBar;
    FIsRedrawLocked: Boolean;
    FLookAndFeel: TcxLookAndFeel;
    FPrevBrushColor: TColor;
    FPrevFontColor: TColor;
    FPrevKeyPressTime: DWORD;
    FScrollBarsCalculating: Boolean;
    FScrollBarsLockCount: Integer;
    FVScrollBar: TcxScrollBar;
    procedure CreateScrollBars;
    function FindAutoCompleteString(const S: string): Integer;
    function GetControlContainer: TcxContainer;
    function GetControl: TWinControl;
    procedure HScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure SetLookAndFeel(Value: TcxLookAndFeel);
    procedure VScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
{$IFNDEF DELPHI6}
    function GetScrollWidth: Integer;
    procedure SetScrollWidth(const Value: Integer);
{$ENDIF}
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMPrint(var Message: TWMPrint); message WM_PRINT;
    procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSetRedraw(var Message: TWMSetRedraw); message WM_SETREDRAW;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  protected
    FContainer: TcxContainer;
    procedure Click; override;
    procedure DblClick; override;
    procedure DestroyWindowHandle; override;
    procedure DoAutoComplete(var Key: Char); virtual;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    function GetPopupMenu: TPopupMenu; override;
    function GetSizeGripRect: TRect;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(AControl: TControl); dynamic;
    procedure MouseLeave(AControl: TControl); dynamic;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DrawSizeGrip(ADC: HDC);
    function NeedDrawFocusRect: Boolean; virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure RestoreCanvasParametersForFocusRect;
    procedure SaveCanvasParametersForFocusRect;
    procedure WndProc(var Message: TMessage); override;
    property Container: TcxContainer read FContainer write FContainer;
    property IsRedrawLocked: Boolean read FIsRedrawLocked;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultHandler(var Message); override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure SetExternalScrollBarsParameters; virtual;
{$IFNDEF DELPHI6}
    procedure AddItem(AItem: string; AObject: TObject);
    procedure ClearSelection;
    procedure DeleteSelected;
    procedure SelectAll;
{$ENDIF}
    function ItemVisible(Index: Integer): Boolean;
    property Canvas: TcxCanvas read FCanvas;
    property HScrollBar: TcxScrollBar read FHScrollBar;
    property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel;
    property VScrollBar: TcxScrollBar read FVScrollBar;
{$IFNDEF DELPHI6}
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
{$ENDIF}
  published
  {$IFNDEF DELPHI6}
    property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
  {$ENDIF}
  {$IFNDEF DELPHI8}
    property AutoCompleteDelay: Cardinal read FAutoCompleteDelay
      write FAutoCompleteDelay default cxDefaultAutoCompleteDelay;
  {$ENDIF}
  end;

  TcxCustomListBox = TcxCustomInnerListBox; // TODO Remove

  { _TWinControlAccess }

  _TWinControlAccess = class
  public
    class procedure _RecreateWnd(AInstance: TWinControl);
  end;

  { _TcxContainerAccess }

  _TcxContainerAccess = class
  public
    class procedure BeginAutoDrag(AInstance: TcxContainer);
    class procedure Click(AInstance: TcxContainer);
    class procedure DblClick(AInstance: TcxContainer);
    class function DoMouseWheel(AInstance: TcxContainer; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint): Boolean;
    class procedure DragOver(AInstance: TcxContainer; Source: TObject;
      X, Y: Integer; State: TDragState; var Accept: Boolean);
    class procedure KeyDown(AInstance: TcxContainer; var Key: Word;
      Shift: TShiftState);
    class procedure KeyPress(AInstance: TcxContainer; var Key: Char);
    class procedure KeyUp(AInstance: TcxContainer; var Key: Word;
      Shift: TShiftState);
    class procedure MouseDown(AInstance: TcxContainer; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    class procedure MouseMove(AInstance: TcxContainer; Shift: TShiftState;
      X, Y: Integer);
    class procedure MouseUp(AInstance: TcxContainer; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

procedure AssignFonts(AFont1, AFont2: TFont);
function ButtonTocxButton(Button: TMouseButton): TcxMouseButton;
function CanShowHint(AControl: TWinControl): Boolean;
function CheckParentsNativeHandle(AControl: TWinControl;
  ANativeHandle: TcxNativeHandle): Boolean;
function cxGetScrollBarInfo(hwnd: HWND; idObject: Longint;
  var psbi: TcxScrollBarInfo): BOOL;
function DefaultContainerStyleController: TcxStyleController;
procedure DrawContainerShadow(ACanvas: TcxCanvas; const ARect: TRect);
procedure ExtendRectByBorders(var R: TRect; ABorderWidth: Integer; AEdges: TcxBorders);
function FindFirstNonChildParentWindow(AWnd: HWND): HWND;
function GetContainerBorderWidth(ABorderStyle: TcxContainerBorderStyle): Integer; overload;
function GetContainerBorderWidth(ALookAndFeelKind: TcxLookAndFeelKind): Integer; overload;
function GetControlRect(AControl: TControl): TRect;
function GetcxContainer(AControl: TWinControl): TcxContainer;
function GetInnerControlContainer(AControl: TWinControl): TWinControl;
function GetPopupOwnerControl(AWnd: HWND): HWND;
function HasHandle(AControl: TWinControl; AHandle: TcxHandle): Boolean;
function HasNativeHandle(AControl: TWinControl;
  ANativeHandle: TcxNativeHandle; ACheckChildren: Boolean = False): Boolean;
function HasOpenedPopupWindow(AControl: TWinControl): Boolean;
procedure InflateRectByBorders(var R: TRect; ABorderWidth: Integer;
  AEdges: TcxBorders);
function InternalCompareString(const S1, S2: TCaption;
  ACaseSensitive: Boolean): Boolean;
function InternalGetCursorPos: TPoint;
function InternalGetShiftState: TShiftState;
procedure InternalInvalidate(AHandle: TcxHandle; const AOuterRect, AInternalRect: TRect;
  AEraseBackground: Boolean = False);
procedure InternalInvalidateRect(AControl: TWinControl; const R: TRect;
  AEraseBackground: Boolean);
function InternalIsWindowVisible(AControl: TWinControl): Boolean;
function IsChildWindow(AParent: TWinControl; AChildHandle: TcxNativeHandle): Boolean;
function KillMessages(AWnd: HWND; AMsgFilterMin, AMsgFilterMax: UINT;
  AKillAllMessages: Boolean = True): Boolean;
procedure LockCMActivateMessages(ALock: Boolean);
function MouseButtonToShift(Button: TMouseButton): TShiftState;
function NativeHandle(Handle: TcxHandle): TcxNativeHandle;
procedure SetWindowRegion(AControl: TWinControl;
  const ABounds: TcxContainerInnerControlBounds);
procedure SetWindowShadowRegion(AWindowHandle: TcxHandle; const R: TRect;
  ANativeStyle, AShadow: Boolean; const AExcludeRect: TRect);
function UsecxScrollBars: Boolean;
function AreVisualStylesMustBeUsed(ANativeStyle: Boolean; AThemedObjectType:
  TdxThemedObjectType): Boolean;
function GetSizeGripRect(AControl: IcxContainerInnerControl): TRect;
procedure SetHooksSettingMode(ASetHooksOnlyWhenPopupsAreVisible: Boolean);

procedure DisableWindow(AWindowList: TList; AWnd: HWND);
procedure EnableWindows(AWindowList: TList);

procedure DisableAppWindows(ANeedDisable: Boolean = True);
procedure EnableAppWindows;
function IsInternalWindowsDisabled: Boolean;
function IsInternalWindowsDisabling: Boolean;

//vista extension
procedure DrawWindowOnGlass(ADC: HDC; const ABounds: TRect; AWnd: HWND);
procedure RepaintWindowOnGlass(AWnd: HWND);
procedure WMPaintWindowOnGlass(AWnd: HWND);

var
  cxContainerDefaultStyleController: TcxStyleController;
  cxContainerShadowColor: TColor = clBtnShadow;
  TopMostComboBoxes: Boolean = True;

implementation

uses
  dxThemeConsts, dxOffice11, cxDWMApi;

const
  cxContainerBorderWidthA1: array [TcxContainerBorderStyle] of Integer =
    (0, 1, 2, 2, 2, 1, 1);
  cxContainerBorderWidthA2: array [TcxLookAndFeelKind] of Integer =
    (2, 2, 1, 1);

type
  TCanvasAccess = class(TCanvas);
  TCustomFormAccess = class(TCustomForm);
  TWinControlAccess = class(TWinControl);

  TGetScrollBarInfo = function(hwnd: HWND; idObject: Longint;
    var psbi: TScrollBarInfo): BOOL; stdcall;

var
  FBeingShownPopupWindow: TcxPopupWindow;
  FCMActivateMessagesLockCount: Integer = 0;
  FPopupWindowShowing: Boolean = False;
  FShiftState: TShiftState;
  FUsecxScrollBars: Boolean;
  FVisiblePopupWindowList: TList;
  FApplicationCallWndProcHook: HHOOK = 0;
  FApplicationGetMessageMsgHook: HHOOK = 0;
  FApplicationMouseMsgHook: HHOOK = 0;
  FCaptionInactivationLocked: Boolean;
  FOldWndProc: Pointer;
  FSetHooksOnlyWhenPopupsAreVisible: Boolean;
  GetScrollBarInfoProc: TGetScrollBarInfo = nil;

procedure RemoveHooks; forward;
procedure SetHooks; forward;

procedure RegisterVisiblePopupWindow(AWindow: TcxCustomPopupWindow);
begin
  // Requires
  Assert((AWindow <> nil) and (FVisiblePopupWindowList.IndexOf(AWindow) = -1));
  //
  FVisiblePopupWindowList.Add(AWindow);
  if FSetHooksOnlyWhenPopupsAreVisible and (FVisiblePopupWindowList.Count = 1) then
    SetHooks;
end;

procedure UnregisterVisiblePopupWindow(AWindow: TcxCustomPopupWindow);
begin
  // Requires
  Assert((AWindow <> nil) and (FVisiblePopupWindowList.IndexOf(AWindow) <> -1));
  //
  FVisiblePopupWindowList.Remove(AWindow);
  if FSetHooksOnlyWhenPopupsAreVisible and (FVisiblePopupWindowList.Count = 0) then
    RemoveHooks;
end;

{ _TWinControlAccess }

class procedure _TWinControlAccess._RecreateWnd(AInstance: TWinControl);
begin
  TWinControlAccess(AInstance).RecreateWnd;
end;

{ _TcxContainerAccess }

class procedure _TcxContainerAccess.BeginAutoDrag(AInstance: TcxContainer);
begin
  AInstance.BeginAutoDrag;
end;

class procedure _TcxContainerAccess.Click(AInstance: TcxContainer);
begin
  AInstance.Click;
end;

class procedure _TcxContainerAccess.DblClick(AInstance: TcxContainer);
begin
  AInstance.DblClick;
end;

class function _TcxContainerAccess.DoMouseWheel(AInstance: TcxContainer;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  Result := AInstance.DoMouseWheel(Shift, WheelDelta, MousePos);
end;

class procedure _TcxContainerAccess.DragOver(AInstance: TcxContainer;
  Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  AInstance.DragOver(Source, X, Y, State, Accept);
end;

class procedure _TcxContainerAccess.KeyDown(AInstance: TcxContainer;
  var Key: Word; Shift: TShiftState);
begin
  AInstance.KeyDown(Key, Shift);
end;

class procedure _TcxContainerAccess.KeyPress(AInstance: TcxContainer;
  var Key: Char);
begin
  AInstance.KeyPress(Key);
end;

class procedure _TcxContainerAccess.KeyUp(AInstance: TcxContainer; var Key: Word;
  Shift: TShiftState);
begin
  AInstance.KeyUp(Key, Shift);
end;

class procedure _TcxContainerAccess.MouseDown(AInstance: TcxContainer;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  AInstance.MouseDown(Button, Shift, X, Y);
end;

class procedure _TcxContainerAccess.MouseMove(AInstance: TcxContainer;
  Shift: TShiftState; X, Y: Integer);
begin
  AInstance.MouseMove(Shift, X, Y);
end;

class procedure _TcxContainerAccess.MouseUp(AInstance: TcxContainer;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin