cxcontrols.pas

Delphi DLL Form 与 TDxDockSite

  FList.Remove(AListener);
  if FList.Count = 0 then
    DeallocateHWnd(FWindow);
end;

procedure TcxSettingsController.NotifyListeners;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    if TCustomControl(FList[I]).HandleAllocated then
      SendNotifyMessage(TCustomControl(FList[I]).Handle, CM_NCSIZECHANGED, 0, 0);
end;

procedure TcxSettingsController.MainWndProc(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    Application.HandleException(Self);
  end;
end;

procedure TcxSettingsController.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_SETTINGCHANGE) and (Message.WParam = SPI_SETNONCLIENTMETRICS) then
  begin
    NotifyListeners;
    Message.Result := 0;
    Exit;
  end;
  with Message do Result := DefWindowProc(FWindow, Msg, wParam, lParam);
end;

var
  FSettingsController: TcxSettingsController;

function cxSettingsController: TcxSettingsController;
begin
  if FSettingsController = nil then
    FSettingsController := TcxSettingsController.Create;
  Result := FSettingsController;
end;
  {$ENDIF}

{ mouse tracking }

var
  FMouseTrackingTimerList: TList;

function MouseTrackingTimerList: TList;
begin
  if not FUnitIsFinalized and (FMouseTrackingTimerList = nil) then
    FMouseTrackingTimerList := TList.Create;
  Result := FMouseTrackingTimerList;
end;

type
  TMouseTrackingTimer = class(TcxTimer)
  protected
    procedure TimerHandler(Sender: TObject);
  public
    Caller: IcxMouseTrackingCaller;
    Control: TWinControl;
    Bounds: TRect;
    constructor Create(AOwner: TComponent); override;
  end;

constructor TMouseTrackingTimer.Create(AOwner: TComponent);
begin
  inherited;
  Interval := 10;
  OnTimer := TimerHandler;
end;

procedure TMouseTrackingTimer.TimerHandler(Sender: TObject);
var
  ACaller: IcxMouseTrackingCaller;

  function IsParentFormDisabled: Boolean;
  begin
    Result := (Control = nil) or not Control.HandleAllocated or not IsWindowEnabledEx(Control.Handle);
  end;

  function PtInCaller: Boolean;
  var
    ACaller2: IcxMouseTrackingCaller2;
  begin
    if Supports(Caller, IcxMouseTrackingCaller2, ACaller2) then
      Result := Control.HandleAllocated and
        (Caller as IcxMouseTrackingCaller2).PtInCaller(Control.ScreenToClient(GetMouseCursorPos))
    else
      Result := PtInRect(Bounds, GetMouseCursorPos);
  end;

begin
  if not PtInCaller or IsParentFormDisabled then
  begin
    ACaller := Caller;
    if (Control <> nil) and Control.HandleAllocated and
      (not PtInRect(Control.ClientRect, Control.ScreenToClient(GetMouseCursorPos)) or IsParentFormDisabled) then
        SendMessage(Control.Handle, CM_MOUSELEAVE, 0, LPARAM(Control));
    if ACaller <> nil then ACaller.MouseLeave;
    EndMouseTracking(ACaller);
  end;
end;

procedure BeginMouseTracking(AControl: TWinControl; const ABounds: TRect;
  ACaller: IcxMouseTrackingCaller);
var
  ATimer: TMouseTrackingTimer;
begin
  if FUnitIsFinalized or IsMouseTracking(ACaller) then Exit;
  ATimer := TMouseTrackingTimer.Create(nil);
  with ATimer do
  begin
    Control := AControl;
    Bounds := ABounds;
    if Control <> nil then
      MapWindowRect(Control.Handle, ScreenHandle, Bounds);
    Caller := ACaller;
  end;
  MouseTrackingTimerList.Add(ATimer);
end;

function GetMouseTrackingTimer(ACaller: IcxMouseTrackingCaller): TMouseTrackingTimer;
var
  I: Integer;
begin
  if not FUnitIsFinalized then
  begin
    for I := 0 to MouseTrackingTimerList.Count - 1 do
    begin
      Result := TMouseTrackingTimer(MouseTrackingTimerList[I]);
      if Result.Caller = ACaller then Exit;
    end;
  end;
  Result := nil;
end;

procedure EndMouseTracking(ACaller: IcxMouseTrackingCaller);
var
  ATimer: TMouseTrackingTimer;
begin
  ATimer := GetMouseTrackingTimer(ACaller);
  if ATimer <> nil then
  begin
    MouseTrackingTimerList.Remove(ATimer);
    ATimer.Free;
  end;
end;

{ hourglass cursor showing }

var
  FPrevScreenCursor: TCursor;
  FHourglassCursorUseCount: Integer; 

function IsMouseTracking(ACaller: IcxMouseTrackingCaller): Boolean;
begin
  Result := not FUnitIsFinalized and (GetMouseTrackingTimer(ACaller) <> nil);
end;

procedure HideHourglassCursor;
begin
  if FHourglassCursorUseCount <> 0 then
  begin
    Dec(FHourglassCursorUseCount);
    if FHourglassCursorUseCount = 0 then
      Screen.Cursor := FPrevScreenCursor;
  end;
end;

procedure ShowHourglassCursor;
begin
  if FHourglassCursorUseCount = 0 then
  begin
    FPrevScreenCursor := Screen.Cursor;
    Screen.Cursor := crHourglass;
  end;
  Inc(FHourglassCursorUseCount);
end;

{ popup menu routines }

function GetPopupMenuHeight(APopupMenu: TPopupMenu): Integer;

  function IsOwnerDrawItem(AMenuItem: TMenuItem): Boolean;
  begin
    Result := APopupMenu.OwnerDraw or (AMenuItem.GetImageList <> nil) or
      not AMenuItem.Bitmap.Empty;
  end;

const
  AMenuItemHeightCorrection = 4;
  APopupMenuHeightCorrection = 4;
var
  ACanvas: TcxScreenCanvas;
  AMenuItemDefaultHeight, AMenuItemHeight, AMenuItemWidth, I: Integer;
begin
  ACanvas := TcxScreenCanvas.Create;
  try
    ACanvas.Font.Assign(Screen.MenuFont);
    AMenuItemDefaultHeight := ACanvas.TextHeight('Qg') + AMenuItemHeightCorrection;

    Result := 0;
    for I := 0 to APopupMenu.Items.Count - 1 do
      if APopupMenu.Items[I].Visible then
      begin
        AMenuItemHeight := AMenuItemDefaultHeight;
        if IsOwnerDrawItem(APopupMenu.Items[I]) then
          TMenuItemAccess(APopupMenu.Items[I]).MeasureItem(ACanvas.Canvas,
            AMenuItemWidth, AMenuItemHeight);
        Inc(Result, AMenuItemHeight);
      end;
    Inc(Result, APopupMenuHeightCorrection);
  finally
    ACanvas.Free;
  end;
end;

function IsPopupMenuShortCut(APopupMenu: TComponent;
  var Message: TWMKey): Boolean;
var
  AIcxPopupMenu: IcxPopupMenu;
begin
  Result := False;
  if APopupMenu = nil then
    Exit;

  if Supports(APopupMenu, IcxPopupMenu, AIcxPopupMenu) then
    Result := AIcxPopupMenu.IsShortCutKey(Message)
  else
    Result := (APopupMenu is TPopupMenu) and (TPopupMenu(APopupMenu).WindowHandle <> 0) and
      TPopupMenu(APopupMenu).IsShortCut(Message);
end;

function ShowPopupMenu(ACaller, AComponent: TComponent; X, Y: Integer): Boolean;
var
  AIcxPopupMenu: IcxPopupMenu;
begin
  Result := False;
  if AComponent <> nil then
  begin
    Result := True;
    if Supports(AComponent, IcxPopupMenu, AIcxPopupMenu) then
      AIcxPopupMenu.Popup(X, Y)
    else
      if (AComponent is TPopupMenu) and TPopupMenu(AComponent).AutoPopup then
        with TPopupMenu(AComponent) do
        begin
          PopupComponent := ACaller;
          Popup(X, Y);
        end
      else
        Result := False;
  end;
end;

function ShowPopupMenuFromCursorPos(ACaller, AComponent: TComponent): Boolean;
var
  P: TPoint;
begin
  GetCursorPos(P);
  Result := ShowPopupMenu(ACaller, AComponent, P.X, P.Y);
end;       

function cxExtractDragObjectSource(ADragObject: TObject): TObject;
begin
  if ADragObject is TcxDragControlObject then
    Result := TcxDragControlObject(ADragObject).Control
  else
    Result := ADragObject;
end;

function GetDragObject: TDragObject;
begin
  Result := FDragObject;
end;

{ drag and drop arrow }

const
  DragAndDropArrowWidth = 11;
  DragAndDropArrowHeight = 9;
  DragAndDropArrowBorderColor = clBlack;
  DragAndDropArrowColor = clLime;

function GetDragAndDropArrowBounds(const AAreaBounds, AClientRect: TRect;
  APlace: TcxArrowPlace): TRect;

  procedure CheckResult;
  begin
    if IsRectEmpty(AClientRect) then Exit;
    with AClientRect do
    begin
      Result.Left := Max(Result.Left, Left);
      Result.Right := Max(Result.Right, Left);
      Result.Left := Min(Result.Left, Right - 1);
      Result.Right := Min(Result.Right, Right - 1);

      Result.Top := Max(Result.Top, Top);
      Result.Bottom := Max(Result.Bottom, Top);
      Result.Top := Min(Result.Top, Bottom - 1);
      Result.Bottom := Min(Result.Bottom, Bottom - 1);
    end;
  end;

  procedure CalculateHorizontalArrowBounds;
  begin
    Result.Bottom := Result.Top + 1;
    InflateRect(Result, 0, DragAndDropArrowWidth div 2);
    if APlace = apLeft then
    begin
      Result.Right := Result.Left;
      Dec(Result.Left, DragAndDropArrowHeight);
    end
    else
    begin
      Result.Left := Result.Right;
      Inc(Result.Right, DragAndDropArrowHeight);
    end;
  end;

  procedure CalculateVerticalArrowBounds;
  begin
    Result.Right := Result.Left + 1;
    InflateRect(Result, DragAndDropArrowWidth div 2, 0);
    if APlace = apTop then
    begin
      Result.Bottom := Result.Top;
      Dec(Result.Top, DragAndDropArrowHeight);
    end
    else
    begin
      Result.Top := Result.Bottom;
      Inc(Result.Bottom, DragAndDropArrowHeight);
    end;
  end;

begin
  Result := AAreaBounds;
  CheckResult;
  if APlace in [apLeft, apRight] then
    CalculateHorizontalArrowBounds
  else
    CalculateVerticalArrowBounds;
end;

procedure GetDragAndDropArrowPoints(const ABounds: TRect; APlace: TcxArrowPlace;
  out P: TPointArray; AForRegion: Boolean);

  procedure CalculatePointsForLeftArrow;
  begin
    with ABounds do
    begin
      P[0] := Point(Left + 3, Top - Ord(AForRegion));
      P[1] := Point(Left + 3, Top + 3);
      P[2] := Point(Left, Top + 3);
      P[3] := Point(Left, Bottom - 4 + Ord(AForRegion));
      P[4] := Point(Left + 3, Bottom - 4 + Ord(AForRegion));
      P[5] := Point(Left + 3, Bottom - 1 + Ord(AForRegion));
      P[6] := Point(Right - 1 + Ord(AForRegion), Top + 5);
    end;
  end;

  procedure CalculatePointsForTopArrow;
  begin
    with ABounds do
    begin
      P[0] := Point(Left + 3, Top);
      P[1] := Point(Right - 4 + Ord(AForRegion), Top);
      P[2] := Point(Right - 4 + Ord(AForRegion), Top + 3);
      P[3] := Point(Right - 1 + Ord(AForRegion), Top + 3);
      P[4] := Point(Left + 5, Bottom - 1 + Ord(AForRegion));
      P[5] := Point(Left, Top + 3);
      P[6] := Point(Left + 3, Top + 3);
    end;
  end;

  procedure CalculatePointsForRightArrow;
  begin
    with ABounds do
    begin
      P[0] := Point(Right - 4 + Ord(AForRegion), Top - Ord(AForRegion));
      P[1] := Point(Right - 4 + Ord(AForRegion), Top + 3);
      P[2] := Point(Right - 1 + Ord(AForRegion), Top + 3);
      P[3] := Point(Right - 1 + Ord(AForRegion), Bottom - 4 + Ord(AForRegion));
      P[4]