cxcontainer.pas

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

  AInstance.MouseUp(Button, Shift, X, Y);
end;

procedure AssignFonts(AFont1, AFont2: TFont);
begin
{$IFDEF DELPHI9}
{$ENDIF}
      AFont1.Assign(AFont2);
end;

function ButtonTocxButton(Button: TMouseButton): TcxMouseButton;
const
  AButtonMap: array[TMouseButton] of TcxMouseButton = (cxmbLeft, cxmbRight, cxmbMiddle);
begin
  Result := AButtonMap[Button];
end;

function CanShowHint(AControl: TWinControl): Boolean;

  function GetForm(AWnd: HWND; out AForm: TCustomForm;
    out AFormStyle: TFormStyle): Boolean;
  var
    AControl: TWinControl;
  begin
    AControl := FindControl(AWnd);
    Result := AControl is TCustomForm;
    if Result then
    begin
      AForm := TCustomForm(AControl);
      AFormStyle := TCustomFormAccess(AForm).FormStyle;
    end;
  end;

  function GetRootParent(AWnd: HWND): HWND;
  var
    AFormStyle: TFormStyle;
    AParentForm: TCustomForm;
  begin
    repeat
      Result := GetParent(AWnd);
      if Result = 0 then
        Break;
      AWnd := Result;
      if GetForm(AWnd, AParentForm, AFormStyle) and
        (AFormStyle = fsMDIChild) then
          Break;
    until False;
    Result := AWnd;
  end;

var
  AForm: TCustomForm;
  AFormStyle: TFormStyle;
  ARootParent: HWND;
begin
  Result := Application.Active and AControl.HandleAllocated and
    IsWindowVisible(AControl.Handle) and
    (FindVCLWindow(GetMouseCursorPos) = AControl);
  if Result then
  begin
    ARootParent := GetRootParent(AControl.Handle);
    Result := not GetForm(ARootParent, AForm, AFormStyle) or
      AForm.Active or (AFormStyle = fsMDIForm) or (FVisiblePopupWindowList.Count > 0) and
      IsChild(ARootParent, TcxCustomPopupWindow(FVisiblePopupWindowList[0]).OwnerControl.Handle);
  end;
end;

function CheckParentsNativeHandle(AControl: TWinControl;
  ANativeHandle: TcxNativeHandle): Boolean;
var
  AParentForm: TCustomForm;
  AParentHandle, AParentHandle1: HWND;
begin
  Result := False;
  if AControl = nil then
    Exit;
  AParentForm := GetParentForm(AControl);
  if AParentForm = nil then
    Exit;
  Result := HasNativeHandle(AParentForm, ANativeHandle, True);
  if not Result and (AParentForm.Parent = nil) then
  begin
    AParentHandle := AParentForm.Handle;
    repeat
      AParentHandle1 := GetParent(AParentHandle);
      if (AParentHandle1 = 0) or not IsChild(AParentHandle1, AParentHandle) then
        Break;
      AParentHandle := AParentHandle1;
    until False;
    if AParentHandle <> AParentForm.Handle then
      Result := (AParentHandle = ANativeHandle) or IsChild(AParentHandle, ANativeHandle);
  end;
end;

function cxGetScrollBarInfo(hwnd: HWND; idObject: Longint;
  var psbi: TcxScrollBarInfo): BOOL;
begin
  psbi.cbSize := SizeOf(psbi);
  Result := GetScrollBarInfoProc(hwnd, idObject, psbi);
end;

function DefaultContainerStyleController: TcxStyleController;
begin
  Result := cxContainerDefaultStyleController;
end;

procedure DrawContainerShadow(ACanvas: TcxCanvas; const ARect: TRect);
var
  R: TRect;
begin
  with ACanvas do
  begin
    Brush.Color := cxContainerShadowColor;
    with R do
    begin
      Left := ARect.Left + cxContainerShadowWidth;
      Top := ARect.Bottom;
      Right := ARect.Right;
      Bottom := Top + cxContainerShadowWidth;
      FillRect(R);
      ExcludeClipRect(R);

      Left := ARect.Right;
      Top := ARect.Top + cxContainerShadowWidth;
      Right := Left + cxContainerShadowWidth;
      Bottom := ARect.Bottom + cxContainerShadowWidth;
      FillRect(R);
      ExcludeClipRect(R);
    end;
  end;
end;

procedure ExtendRectByBorders(var R: TRect; ABorderWidth: Integer; AEdges: TcxBorders);
begin
  if bLeft in AEdges then
    Dec(R.Left, ABorderWidth);
  if bTop in AEdges then
    Dec(R.Top, ABorderWidth);
  if bRight in AEdges then
    Inc(R.Right, ABorderWidth);
  if bBottom in AEdges then
    Inc(R.Bottom, ABorderWidth);
end;

function FindFirstNonChildParentWindow(AWnd: HWND): HWND;
begin
  Result := 0;
  while (AWnd <> 0) and (Result = 0) do
  begin
    if (GetWindowLong(AWnd, GWL_STYLE) and WS_CHILD) = 0 then
      Result := AWnd;
    AWnd := GetParent(AWnd);
  end;
end;

function GetContainerBorderWidth(ABorderStyle: TcxContainerBorderStyle): Integer;
begin
  Result := cxContainerBorderWidthA1[ABorderStyle];
end;

function GetContainerBorderWidth(ALookAndFeelKind: TcxLookAndFeelKind): Integer;
begin
  Result := cxContainerBorderWidthA2[ALookAndFeelKind];
end;

function GetControlRect(AControl: TControl): TRect;
begin
  Result := Rect(0, 0, AControl.Width, AControl.Height);
end;

function GetcxContainer(AControl: TWinControl): TcxContainer;
var
  AIContainerInnerControl: IcxContainerInnerControl;
begin
  Result := nil;
  if AControl is TcxContainer then
    Result := TcxContainer(AControl)
  else
    if (AControl <> nil) and Supports(AControl, IcxContainerInnerControl, AIContainerInnerControl) then
      Result := AIContainerInnerControl.ControlContainer;
end;

function GetInnerControlContainer(AControl: TWinControl): TWinControl;
var
 AInnerControl: IcxContainerInnerControl;
begin
 if Supports(AControl, IcxContainerInnerControl, AInnerControl) then
   Result := AInnerControl.ControlContainer
 else
   Result := AControl;
end;

function GetWindowShadowRegion(AWindowHandle: TcxHandle;
  R: TRect; ANativeStyle, AShadow: Boolean;
  const AExcludeRect: TRect): TcxRegionHandle;
var
  ATempRegion: TcxRegionHandle;
begin
  if ANativeStyle then
    Result := 0
  else
  begin
    Result := CreateRectRgnIndirect(R);
    if AShadow then
    begin
      OffsetRect(R, cxContainerShadowWidth, cxContainerShadowWidth);
      ATempRegion := CreateRectRgnIndirect(R);
      CombineRgn(Result, Result, ATempRegion, RGN_OR);
      DeleteObject(ATempRegion);
    end;
    if not IsRectEmpty(AExcludeRect) then
    begin
      ATempRegion := CreateRectRgnIndirect(AExcludeRect);
      CombineRgn(Result, Result, ATempRegion, RGN_DIFF);
      DeleteObject(ATempRegion);
    end;
  end;
end;

function GetPopupOwnerControl(AWnd: HWND): HWND;
var
  AControl: TWinControl;
begin
  Result := AWnd;
  while AWnd <> 0 do
  begin
    AControl := FindControl(AWnd);
    if AControl is TcxCustomPopupWindow then
    begin
      if TcxCustomPopupWindow(AControl).OwnerControl.HandleAllocated then
        Result := TcxCustomPopupWindow(AControl).OwnerControl.Handle;
      Break;
    end;
    AWnd := GetParent(AWnd);
  end;
end;

function HasHandle(AControl: TWinControl; AHandle: TcxHandle): Boolean;
begin
  Result := HasNativeHandle(AControl, NativeHandle(AHandle));
end;

function HasNativeHandle(AControl: TWinControl; ANativeHandle: TcxNativeHandle;
  ACheckChildren: Boolean = False): Boolean;
begin
  Result := (AControl <> nil) and ((AControl.Handle = ANativeHandle) or
    ACheckChildren and IsChildWindow(AControl, ANativeHandle));
end;

function HasOpenedPopupWindow(AControl: TWinControl): Boolean;
var
  AContainer: TcxContainer;
begin
  AContainer := GetcxContainer(AControl);
  Result := (AContainer <> nil) and AContainer.HasPopupWindow;
end;

procedure InflateRectByBorders(var R: TRect; ABorderWidth: Integer;
  AEdges: TcxBorders);
begin
  if not(bLeft in AEdges) then
    Inc(R.Left, ABorderWidth);
  if not(bTop in AEdges) then
    Inc(R.Top, ABorderWidth);
  if not(bRight in AEdges) then
    Dec(R.Right, ABorderWidth);
  if not(bBottom in AEdges) then
    Dec(R.Bottom, ABorderWidth);
end;

function InternalCompareString(const S1, S2: TCaption; ACaseSensitive: Boolean): Boolean;
begin
  if ACaseSensitive then
    Result := AnsiCompareStr(S1, S2) = 0
  else
    Result := AnsiUpperCase(S1) = AnsiUpperCase(S2);
end;

procedure InternalFillRect(ACanvas: TcxCanvas; const AOuterRect, AInternalRect: TRect;
  AColor: TColor);
begin
  if IsRectEmpty(AOuterRect) or EqualRect(AOuterRect, AInternalRect) then
    Exit;
  with ACanvas do
  begin
    Brush.Color := AColor;
    if IsRectEmpty(AInternalRect) then
      FillRect(AOuterRect)
    else
    begin
      FillRect(Rect(AOuterRect.Left, AOuterRect.Top,
        AInternalRect.Left, AOuterRect.Bottom));
      FillRect(Rect(AInternalRect.Left, AOuterRect.Top,
        AInternalRect.Right, AInternalRect.Top));
      FillRect(Rect(AInternalRect.Right, AOuterRect.Top,
        AOuterRect.Right, AOuterRect.Bottom));
      FillRect(Rect(AInternalRect.Left, AInternalRect.Bottom,
        AInternalRect.Right, AOuterRect.Bottom));
    end;
  end;
end;

function InternalGetCursorPos: TPoint;
begin
  GetCursorPos(Result);
end;

function InternalGetShiftState: TShiftState;
var
  AKeyState: TKeyBoardState;
begin
  GetKeyboardState(AKeyState);
  Result := KeyboardStateToShiftState(AKeyState);
end;

procedure InternalInvalidate(AHandle: TcxHandle; const AOuterRect, AInternalRect: TRect;
  AEraseBackground: Boolean = False);

  procedure InternalInvalidateRect(const R: TRect);
  begin
    InvalidateRect(AHandle, @R, AEraseBackground);
  end;

begin
  if IsRectEmpty(AInternalRect) then
    InternalInvalidateRect(AOuterRect)
  else
  begin
    InternalInvalidateRect(Rect(AOuterRect.Left, AOuterRect.Top, AInternalRect.Left,
      AOuterRect.Bottom));
    InternalInvalidateRect(Rect(AInternalRect.Left, AOuterRect.Top, AInternalRect.Right,
      AInternalRect.Top));
    InternalInvalidateRect(Rect(AInternalRect.Right, AOuterRect.Top, AOuterRect.Right,
      AOuterRect.Bottom));
    InternalInvalidateRect(Rect(AInternalRect.Left, AInternalRect.Bottom, AInternalRect.Right,
        AOuterRect.Bottom));
  end;
end;

procedure InternalInvalidateRect(AControl: TWinControl; const R: TRect;
  AEraseBackground: Boolean);
begin
  if AControl.HandleAllocated then
    InvalidateRect(AControl.Handle, @R, AEraseBackground);
end;

function InternalIsWindowVisible(AControl: TWinControl): Boolean;
begin
  with AControl do
  begin
    Result := HandleAllocated;
    Result := Result and IsWindowVisible(Handle);
  end;