cxcontainer.pas

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

end;

function IsChildWindow(AParent: TWinControl; AChildHandle: TcxNativeHandle): Boolean;

  function InternalNativeIsChildWindow(AParent: TWinControl): Boolean;
  begin
    Result := IsChild(NativeHandle(AParent.Handle), AChildHandle);
  end;

  function InternalIsChildWindow(AParent: TWinControl): Boolean;
  var
    I: Integer;
    APopupWindow: TcxCustomPopupWindow;
  begin
    with AParent do
      for I := 0 to ControlCount - 1 do
        if Controls[I] is TWinControl then
        begin
          if HasNativeHandle(TWinControl(Controls[I]), AChildHandle) then
          begin
            Result := True;
            Exit;
          end else
          begin
            Result := InternalIsChildWindow(TWinControl(Controls[I]));
            if Result then
              Exit;
          end;
          Result := InternalNativeIsChildWindow(TWinControl(Controls[I]));
          if Result then
            Exit;
        end;
    if AParent is TcxCustomPopupWindow then
      for I := 0 to FVisiblePopupWindowList.Count - 1 do
      begin
        APopupWindow := TcxCustomPopupWindow(FVisiblePopupWindowList[I]);
        if (APopupWindow = AParent) or (GetParentForm(APopupWindow.OwnerControl) <> AParent) then
          Continue;
        if HasNativeHandle(APopupWindow, AChildHandle) then
        begin
          Result := True;
          Exit;
        end else
        begin
          Result := InternalIsChildWindow(APopupWindow);
          if Result then Exit;
        end;
      end;
    for I := 0 to FVisiblePopupWindowList.Count - 1 do
    begin
      APopupWindow := TcxCustomPopupWindow(FVisiblePopupWindowList[I]);
      if APopupWindow.OwnerControl = AParent then
      begin
        Result := HasNativeHandle(APopupWindow, AChildHandle) or
          InternalIsChildWindow(APopupWindow);
        if Result then Exit;
      end;
    end;
    Result := False;
  end;

begin
  Result := False;
  if (AParent = nil) or (AChildHandle = 0) or HasNativeHandle(AParent, AChildHandle) then
    Exit;
  Result := InternalNativeIsChildWindow(AParent);
  if not Result then
    Result := InternalIsChildWindow(AParent);
end;

function KillMessages(AWnd: HWND; AMsgFilterMin, AMsgFilterMax: UINT;
  AKillAllMessages: Boolean = True): Boolean;
var
  AMsg: TMsg;
begin
  Result := False;
  while PeekMessage(AMsg, AWnd, AMsgFilterMin, AMsgFilterMax, PM_REMOVE) do
    if AMsg.message = WM_QUIT then
    begin
      PostQuitMessage(AMsg.wParam);
      Break;
    end
    else
    begin
      Result := True;
      if not AKillAllMessages then
        Break;
    end;
end;

procedure LockCMActivateMessages(ALock: Boolean);
begin
  if ALock then
    Inc(FCMActivateMessagesLockCount)
  else
    Dec(FCMActivateMessagesLockCount);
end;

function MouseButtonToShift(Button: TMouseButton): TShiftState;
begin
  case Button of
    mbLeft:
      Result := [ssLeft];
    mbMiddle:
      Result := [ssMiddle];
    mbRight:
      Result := [ssRight];
  end;
end;

function NativeHandle(Handle: TcxHandle): TcxNativeHandle;
begin
  Result := Handle;
end;

procedure SetUsecxScrollBars;
var
  ALibrary: HMODULE;
begin
{$IFDEF USETCXSCROLLBAR}
  ALibrary := GetModuleHandle('User32');
  if ALibrary <> 0 then
  begin
    @GetScrollBarInfoProc := GetProcAddress(ALibrary, 'GetScrollBarInfo');
    FUsecxScrollBars := Assigned(GetScrollBarInfoProc);
  end;
{$ELSE}
  FUsecxScrollBars := False;
{$ENDIF}
end;

procedure SetWindowRegion(AControl: TWinControl;
  const ABounds: TcxContainerInnerControlBounds);
begin
  if ABounds.IsEmpty then
    Windows.SetWindowRgn(AControl.Handle, 0, True)
  else
    Windows.SetWindowRgn(AControl.Handle, CreateRectRgnIndirect(ABounds.Rect), True);
end;

procedure SetWindowShadowRegion(AWindowHandle: TcxHandle; const R: TRect;
  ANativeStyle: Boolean; AShadow: Boolean; const AExcludeRect: TRect);
var
  ARgnChanged: Boolean;
  ARgnType: Integer;
  ATempRegion, AWindowRegion: HRGN;
begin
  AWindowRegion := GetWindowShadowRegion(AWindowHandle, R, ANativeStyle,
    AShadow, AExcludeRect);
  ATempRegion := CreateRectRgn(0, 0, 0, 0);
  ARgnType := Integer(GetWindowRgn(AWindowHandle, ATempRegion));
  ARgnChanged := not((AWindowRegion = 0) and ((ARgnType = NULLREGION) or
    (ARgnType = ERROR))) and not EqualRgn(AWindowRegion, ATempRegion);
  DeleteObject(ATempRegion);
  if ARgnChanged then
    SetWindowRgn(AWindowHandle, AWindowRegion, True)
  else
    if AWindowRegion <> 0 then
      DeleteObject(AWindowRegion);
end;

function UsecxScrollBars: Boolean;
begin
  Result := FUsecxScrollBars;
end;

function AreVisualStylesMustBeUsed(ANativeStyle: Boolean;
  AThemedObjectType: TdxThemedObjectType): Boolean;
begin
  Result := ANativeStyle and (OpenTheme(AThemedObjectType) <> 0);
end;

function GetSizeGripRect(AControl: IcxContainerInnerControl): TRect;
var
  R: TRect;
begin
  with AControl.ControlContainer do
    if HScrollBar.Visible and VScrollBar.Visible then
    begin
      Result.TopLeft := ClientToScreen(Point(VScrollBar.Left, HScrollBar.Top));
      GetWindowRect(AControl.Control.Handle, R);
      Dec(Result.Left, R.Left);
      Dec(Result.Top, R.Top);
      Result.Right := Result.Left + VScrollBar.Width;
      Result.Bottom := Result.Top + HScrollBar.Height;
    end
    else
      Result := cxEmptyRect;
end;

procedure SetHooksSettingMode(ASetHooksOnlyWhenPopupsAreVisible: Boolean);
begin
  if ASetHooksOnlyWhenPopupsAreVisible <> FSetHooksOnlyWhenPopupsAreVisible then
  begin
    FSetHooksOnlyWhenPopupsAreVisible := ASetHooksOnlyWhenPopupsAreVisible;
    if FVisiblePopupWindowList.Count = 0 then
      if ASetHooksOnlyWhenPopupsAreVisible then
        RemoveHooks
      else
        SetHooks;
  end;
end;

var
  FDisablingWindowsCounter: Integer;
  FTopLevelWindowList: TList;
  FInternalWindowsEnabling: Boolean;

procedure DisableWindow(AWindowList: TList; AWnd: HWND);
begin
  if IsWindowEnabled(AWnd) then
  begin
    AWindowList.Add(Pointer(AWnd));
    EnableWindow(AWnd, False);
  end;
end;

procedure EnableWindows(AWindowList: TList);
var
  I: Integer;
  AWnd: HWND;
begin
  if AWindowList <> nil then
    for I := 0 to AWindowList.Count - 1 do
    begin
      AWnd := HWND(AWindowList[I]);
      if IsWindow(AWnd) then
        EnableWindow(AWnd, True);
    end;
end;

function DisableTopLevelWindow(AWnd: HWND; AInfo: Pointer): BOOL; stdcall;
var
  AProcessId: Cardinal;
begin
  Result := True;
  GetWindowThreadProcessId(AWnd, @AProcessId);
  if (AProcessId = GetCurrentProcessId) then
    DisableWindow(FTopLevelWindowList, AWnd);
end;

procedure DisableAppWindows(ANeedDisable: Boolean = True);
begin
  Inc(FDisablingWindowsCounter);

  if (FDisablingWindowsCounter = 1) and ANeedDisable then
  try
    FInternalWindowsEnabling := True;
    FTopLevelWindowList := TList.Create;
    EnumWindows(@DisableTopLevelWindow, 0);
  finally
    FInternalWindowsEnabling := False;
  end;
end;

procedure EnableAppWindows;
begin
  Dec(FDisablingWindowsCounter);

  if FDisablingWindowsCounter = 0 then
  try
    FInternalWindowsEnabling := True;
    EnableWindows(FTopLevelWindowList);
    FreeAndNil(FTopLevelWindowList);
  finally
    FInternalWindowsEnabling := False;
  end;
end;

function IsInternalWindowsDisabled: Boolean;
begin
  Result := FDisablingWindowsCounter > 0;
end;

function IsInternalWindowsDisabling: Boolean;
begin
  Result := FInternalWindowsEnabling;
end;

procedure DrawWindowOnGlass(ADC: HDC; const ABounds: TRect; AWnd: HWND);
var
  AMemDC: HDC;
  APaintBuffer: THandle;
begin
  APaintBuffer := BeginBufferedPaint(ADC, @ABounds, BPBF_COMPOSITED, nil, AMemDC);
  try
    SendMessage(AWnd, WM_ERASEBKGND, AMemDC, AMemDC);
    SendMessage(AWnd, WM_PRINTCLIENT, AMemDC, PRF_CLIENT);
    BufferedPaintSetAlpha(APaintBuffer, @ABounds, 255);
  finally
    HideCaret(AWnd);
    EndBufferedPaint(APaintBuffer, True);
    ShowCaret(AWnd);
  end;
end;

procedure RepaintWindowOnGlass(AWnd: HWND);
var
  R: TRect;
  DC: HDC;
begin
  DC := GetDC(AWnd);
  try
    Windows.GetClientRect(AWnd, R);
    DrawWindowOnGlass(DC, R, AWnd);
  finally
    ReleaseDC(AWnd, DC);
  end;
end;

procedure WMPaintWindowOnGlass(AWnd: HWND);
var
  DC: HDC;
  PS: TPaintStruct;
begin
  DC := BeginPaint(AWnd, PS);
  try
    DrawWindowOnGlass(DC, PS.rcPaint, AWnd);
  finally
    EndPaint(AWnd, PS);
  end;
end;

function IsCMActivateMessagesLocked: Boolean;
begin
  Result := FCMActivateMessagesLockCount <> 0;
end;

{ TcxContainerViewInfo }

constructor TcxContainerViewInfo.Create;
begin
  inherited Create;
  ContainerState := [csNormal];
end;

procedure TcxContainerViewInfo.Assign(Source: TObject);
begin
  if Source is TcxContainerViewInfo then
    with Source as TcxContainerViewInfo do
      Self.ClientRect := ClientRect;
end;

function TcxContainerViewInfo.GetUpdateRegion(AViewInfo: TcxContainerViewInfo): TcxRegion;
begin
  Result := TcxRegion.Create;
end;

procedure TcxContainerVi