rm_tb97.pas

进销存·完整的·有数据库的·非常完整·只得参考

    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    function PaletteChanged(Foreground: Boolean): Boolean; override;
    procedure SetParent(AParent: TWinControl); override;

    { Methods accessible to descendants }
    procedure ArrangeControls;
    function ChildControlTransparent(Ctl: TControl): Boolean; dynamic;
    procedure CustomArrangeControls(const PreviousDockType: TDockType;
      const DockingTo: TDock97; const Resize: Boolean);
    procedure DoDockChangingHidden(DockingTo: TDock97); dynamic;
    procedure DoMove; dynamic;
    procedure GetBarSize(var ASize: Integer; const DockType: TDockType); virtual; abstract;
    procedure GetDockRowSize(var AHeightOrWidth: Integer);
    procedure GetMinimumSize(var AClientWidth, AClientHeight: Integer); virtual; abstract;
    procedure GetParams(var Params: TToolWindowParams); dynamic;
    procedure InitializeOrdering; dynamic;
    function OrderControls(CanMoveControls: Boolean; PreviousDockType: TDockType;
      DockingTo: TDock97): TPoint; virtual; abstract;
    procedure ResizeBegin(SizeHandle: TToolWindowSizeHandle); dynamic;
    procedure ResizeEnd(Accept: Boolean); dynamic;
    procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); dynamic;
    procedure SizeChanging(const AWidth, AHeight: Integer); virtual;
  public
    property Docked: Boolean read FDocked;
    property DockedTo: TDock97 read FDockedTo write SetDockedTo stored False;
    property DockPos: Integer read FDockPos write SetDockPos default -1;
    property DockRow: Integer read FDockRow write SetDockRow default 0;
    property FloatingPosition: TPoint read FFloatingTopLeft write FFloatingTopLeft;
    property NonClientWidth: Integer read FNonClientWidth;
    property NonClientHeight: Integer read FNonClientHeight;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure AddDockForm(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF});
    procedure AddDockedNCAreaToSize(var S: TPoint; const LeftRight: Boolean);
    procedure AddFloatingNCAreaToSize(var S: TPoint);
    procedure BeginMoving(const InitX, InitY: Integer);
    procedure BeginSizing(const ASizeHandle: TToolWindowSizeHandle);
    procedure BeginUpdate;
    procedure DoneReadingPositionData(const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
    procedure EndUpdate;
    procedure GetDockedNCArea(var TopLeft, BottomRight: TPoint;
      const LeftRight: Boolean);
    function GetFloatingBorderSize: TPoint;
    procedure GetFloatingNCArea(var TopLeft, BottomRight: TPoint);
    procedure ReadPositionData(const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
    procedure RemoveDockForm(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF});
    procedure WritePositionData(const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); dynamic;
  published
    property Height stored False;
    property Width stored False;
  end;

procedure RegLoadToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const BaseRegistryKey: string);
procedure RegLoadToolbarPositionsEx(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const RootKey: DWORD; const BaseRegistryKey: string);
procedure RegSaveToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const BaseRegistryKey: string);
procedure RegSaveToolbarPositionsEx(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const RootKey: DWORD; const BaseRegistryKey: string);
procedure IniLoadToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const Filename, SectionNamePrefix: string);
procedure IniSaveToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}; const Filename, SectionNamePrefix: string);

procedure CustomLoadToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
  const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
procedure CustomSaveToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
  const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);

function GetDockTypeOf(const Control: TDock97): TDockType;
function GetToolWindowParentForm(const ToolWindow: TCustomToolWindow97):
{$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
function ValidToolWindowParentForm(const ToolWindow: TCustomToolWindow97):
{$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};

{$ENDIF}
implementation
{$IFDEF USE_INTERNALTB97}

uses
  Registry, IniFiles, SysUtils, Consts,
  RM_TB97Cmn, RM_TB97Cnst;

const
  DockedBorderSize = 2;
  DockedBorderSize2 = DockedBorderSize * 2;
  DragHandleSizes: array[Boolean, TDragHandleStyle] of Integer =
  ((9, 0, 6), (14, 14, 14));
  DragHandleOffsets: array[Boolean, TDragHandleStyle] of Integer =
  ((2, 0, 1), (3, 0, 5));

  DefaultBarWidthHeight = 8;

  ForceDockAtTopRow = 0;
  ForceDockAtLeftPos = -8;

  PositionLeftOrRight = [dpLeft, dpRight];

  twrdAll = [Low(TToolWindowNCRedrawWhatElement)..High(TToolWindowNCRedrawWhatElement)];

  { Constants for TCustomToolWindow97 registry values/data.
    Don't localize any of these names! }
  rvRev = 'Rev';
  rdCurrentRev = 3;
  rvVisible = 'Visible';
  rvDockedTo = 'DockedTo';
  rdDockedToFloating = '+';
  rvLastDock = 'LastDock';
  rvDockRow = 'DockRow';
  rvDockPos = 'DockPos';
  rvFloatLeft = 'FloatLeft';
  rvFloatTop = 'FloatTop';

var
  FloatingToolWindows: TList = nil;


{ Misc. functions }

function GetSmallCaptionHeight: Integer;
{ Returns height of the caption of a small window }
begin
  if NewStyleControls then
    Result := GetSystemMetrics(SM_CYSMCAPTION)
  else
    { Win 3.x doesn't support small captions, so, like Office 97, use the size
      of normal captions minus one }
    Result := GetSystemMetrics(SM_CYCAPTION) - 1;
end;

function GetPrimaryDesktopArea: TRect;
{ Returns a rectangle containing the "work area" of the primary display
  monitor, which is the area not taken up by the taskbar. }
begin
  if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then
    { SPI_GETWORKAREA is only supported by Win95 and NT 4.0. So it fails under
      Win 3.x. In that case, return a rectangle of the entire screen }
    Result := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN),
      GetSystemMetrics(SM_CYSCREEN));
end;

function UsingMultipleMonitors: Boolean;
{ Returns True if the system has more than one display monitor configured. }
var
  NumMonitors: Integer;
begin
  NumMonitors := GetSystemMetrics(80 {SM_CMONITORS});
  Result := (NumMonitors <> 0) and (NumMonitors <> 1);
  { ^ NumMonitors will be zero if not running Win98, NT 5, or later }
end;

type
  HMONITOR = type Integer;
  PMonitorInfoA = ^TMonitorInfoA;
  TMonitorInfoA = record
    cbSize: DWORD;
    rcMonitor: TRect;
    rcWork: TRect;
    dwFlags: DWORD;
  end;
const
  MONITOR_DEFAULTTONEAREST = $2;
type
  TMultiMonApis = record
    funcMonitorFromRect: function(lprcScreenCoords: PRect; dwFlags: DWORD): HMONITOR; stdcall;
    funcMonitorFromPoint: function(ptScreenCoords: TPoint; dwFlags: DWORD): HMONITOR; stdcall;
    funcGetMonitorInfoA: function(hMonitor: HMONITOR; lpMonitorInfo: PMonitorInfoA): BOOL; stdcall;
  end;

{ Under D4 I could be using the MultiMon unit for the multiple monitor
  function imports, but its stubs for MonitorFromRect and MonitorFromPoint
  are seriously bugged... So I chose to avoid the MultiMon unit entirely. }

function InitMultiMonApis(var Apis: TMultiMonApis): Boolean;
var
  User32Handle: THandle;
begin
  User32Handle := GetModuleHandle(user32);
  Apis.funcMonitorFromRect := GetProcAddress(User32Handle, 'MonitorFromRect');
  Apis.funcMonitorFromPoint := GetProcAddress(User32Handle, 'MonitorFromPoint');
  Apis.funcGetMonitorInfoA := GetProcAddress(User32Handle, 'GetMonitorInfoA');
  Result := Assigned(Apis.funcMonitorFromRect) and
    Assigned(Apis.funcMonitorFromPoint) and Assigned(Apis.funcGetMonitorInfoA);
end;

function GetDesktopAreaOfMonitorContainingRect(const R: TRect): TRect;
{ Returns the work area of the monitor which the rectangle R intersects with
  the most, or the monitor nearest R if no monitors intersect. }
var
  Apis: TMultiMonApis;
  M: HMONITOR;
  MonitorInfo: TMonitorInfoA;
begin
  if UsingMultipleMonitors and InitMultiMonApis(Apis) then begin
    M := Apis.funcMonitorFromRect(@R, MONITOR_DEFAULTTONEAREST);
    MonitorInfo.cbSize := SizeOf(MonitorInfo);
    if Apis.funcGetMonitorInfoA(M, @MonitorInfo) then begin
      Result := MonitorInfo.rcWork;
      Exit;
    end;
  end;
  Result := GetPrimaryDesktopArea;
end;

function GetDesktopAreaOfMonitorContainingPoint(const P: TPoint): TRect;
{ Returns the work area of the monitor containing the point P, or the monitor
  nearest P if P isn't in any monitor's work area. }
var
  Apis: TMultiMonApis;
  M: HMONITOR;
  MonitorInfo: TMonitorInfoA;
begin
  if UsingMultipleMonitors and InitMultiMonApis(Apis) then begin
    M := Apis.funcMonitorFromPoint(P, MONITOR_DEFAULTTONEAREST);
    MonitorInfo.cbSize := SizeOf(MonitorInfo);
    if Apis.funcGetMonitorInfoA(M, @MonitorInfo) then begin
      Result := MonitorInfo.rcWork;
      Exit;
    end;
  end;
  Result := GetPrimaryDesktopArea;
end;

function GetMDIParent(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}):
{$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
{ Returns the parent of the specified MDI child form. But, if Form isn't a
  MDI child, it simply returns Form. }
var
  I, J: Integer;
begin
  Result := Form;
  if Form = nil then Exit;
  if {$IFDEF TB97D3}(Form is TForm) and {$ENDIF}
  (TForm(Form).FormStyle = fsMDIChild) then
    for I := 0 to Screen.FormCount - 1 do
      with Screen.Forms[I] do begin
        if FormStyle <> fsMDIForm then Continue;
        for J := 0 to MDIChildCount - 1 do
          if MDIChildren[J] = Form then begin
            Result := Screen.Forms[I];
            Exit;
          end;
      end;
end;

function GetDockTypeOf(const Control: TDock97): TDockType;
begin
  if Control = nil then
    Result := dtNotDocked
  else begin
    if not (Control.Position in PositionLeftOrRight) then
      Result := dtTopBottom
    else
      Result := dtLeftRight;
  end;
end;

function GetToolWindowParentForm(const ToolWindow: TCustomToolWindow97):
{$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
var
  Ctl: TWinControl;
begin
  Result := nil;
  Ctl := ToolWindow;
  while Assigned(Ctl.Parent) do begin
    if Ctl.Parent is {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF} then
      Result := {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF}(Ctl.Parent);
    Ctl := Ctl.Parent;
  end;
  { ^ for compatibility with ActiveX controls, that code is used instead of
    GetParentForm because it returns nil unless the form is the *topmost*
    parent }
  if Result is TFloatingWindowParent then
    Result := TFloatingWindowParent(Result).ParentForm;
end;

function ValidToolWindowParentForm(const ToolWindow: TCustomToolWindow97):
{$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
begin
  Result := GetToolWindowParentForm(ToolWindow);
  if Result = nil then
    raise EInvalidOperation.{$IFDEF TB97D3}CreateFmt{$ELSE}CreateResFmt{$ENDIF}
    (SParentRequired, [ToolWindow.Name]);
end;

procedure ToolbarHookProc(Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
var
  I: Integer;
  ToolWindow: TCustomToolWindow97;
  Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
begin
  case Code of
    hpSendActivateApp: begin
        if Assigned(FloatingToolWindows) then
          for I := 0 to FloatingToolWindows.Count - 1 do
            with TCustomToolWindow97(FloatingToolWindows.List[I]) do
              { Hide or restore toolbars when application is deactivated or activated.
                UpdateVisibility also sets caption state active/inactive }
              UpdateVisibility;
      end;
    hpSendWindowPosChanged: begin
        if Assigned(FloatingToolWindows) then
          for I := 0 to FloatingToolWindows.Count - 1 do begin
            ToolWindow := TCustomToolWindow97(FloatingToolWindows.List[I]);
            with ToolWindow do begin
              if (FFloatingMode = fmOnTopOfParentForm) and HandleAllocated then begin
                with PWindowPos(LParam)^ do
                  { Call UpdateVisibility if parent form's visibility has
                    changed, or if it has been minimized or restored }
                  if ((flags and (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0) or
                    (flags and SWP_FRAMECHANGED <> 0)) then begin
                    Form := GetToolWindowParentForm(ToolWindow);
                    if Assigned(Form) and Form.HandleAllocated and ((Wnd = Form.Handle) or IsChild(Wnd, Form.Handle)) then
                      UpdateVisibility;
                  end;
              end;
            end;
          end;
      end;
    hpPreDestroy: begin
        if Assigned(FloatingToolWindows) then
          for I := 0 to FloatingToolWindows.Count - 1 do begin
            with TCustomToolWindow97(FloatingToolWindows.List[I]) do
              { It must remove the form window's ownership of the tool window
                *before* the form gets destroyed, otherwise Windows will destroy
                the tool window's handle. }
              if HandleAllocated and (HWND(GetWindowLong(Handle, GWL_HWNDPARENT)) = Wnd) then
                SetWindowLong(Handle, GWL_HWNDPARENT, Longint(Parent.Handle));
                { ^ Restore GWL_HWNDPARENT back to the TFloatingWindowParent }
          end;
      end;
  end;
end;

procedure ProcessPaintMessages;
{ Dispatches all pending WM_PAINT messages. In effect, this is like an
  'UpdateWindow' on all visible windows }
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do begin
    case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of
      -1: Break; { if GetMessage failed }
      0: begin
           { Repost WM_QUIT messages }
          PostQuitMessage(Msg.WParam);
          Break;
        end;
    end;