cxcontrols.pas

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

    Result := Positions[ASign1 >= 0, ASign2 >= 0];
  end
  else
    if AHorzSeparation then
      if P.X < GetRangeCenter(ARect.Left, ARect.Right) then
        Result := posLeft
      else
        Result := posRight
    else
      if AVertSeparation then
        if P.Y < GetRangeCenter(ARect.Top, ARect.Bottom) then
          Result := posTop
        else
          Result := posBottom
      else
        Result := posNone;
end;

function IsChildClassWindow(AWnd: HWND): Boolean;
begin
  Result := GetWindowLong(AWnd, GWL_STYLE) and WS_CHILD = WS_CHILD;
end;

function IsChildEx(AParentWnd, AWnd: HWND): Boolean;
begin
  Result := (AParentWnd <> 0) and ((AParentWnd = AWnd) or IsChild(AParentWnd, AWnd));
end;

function IsCtrlPressed: Boolean;
begin
  Result := GetAsyncKeyState(VK_CONTROL) < 0;
end;

function IsOwner(AOwnerWnd, AWnd: HWND): Boolean;
begin
  if AOwnerWnd <> 0 then
    repeat
      AWnd := GetParent(AWnd);
      Result := AWnd = AOwnerWnd;
    until Result or (AWnd = 0)
  else
    Result := False;
end;

function IsOwnerEx(AOwnerWnd, AWnd: HWND): Boolean;
begin
  Result := (AOwnerWnd <> 0) and ((AOwnerWnd = AWnd) or IsOwner(AOwnerWnd, AWnd));
end;

function IsPointInDragDetectArea(const AMouseDownPos: TPoint; X, Y: Integer): Boolean;
begin
  Result :=
    (Abs(X - AMouseDownPos.X) < Mouse.DragThreshold) and
    (Abs(Y - AMouseDownPos.Y) < Mouse.DragThreshold);
end;

function IsNumericChar(C: Char; AType: TcxNumberType): Boolean;
begin
  Result := C in ['-', '+', '0'..'9'];
  if AType in [ntFloat, ntExponent] then
  begin
    Result := Result or (C = DecimalSeparator);
    if AType = ntExponent then
      Result := Result or (C = 'e') or (C = 'E');
  end;
end;

function IsTextChar(C: Char): Boolean;
begin
  Result := C in [#32..#255];
end;

procedure MakeVisibleOnDesktop(var ABounds: TRect; const ADesktopPoint: TPoint);
var
  ADesktopBounds: TRect;
begin
  ADesktopBounds := GetDesktopWorkArea(ADesktopPoint);
  if ABounds.Right > ADesktopBounds.Right then
    Offsetrect(ABounds, ADesktopBounds.Right - ABounds.Right, 0);
  if ABounds.Bottom > ADesktopBounds.Bottom then
    OffsetRect(ABounds, 0, ADesktopBounds.Bottom - ABounds.Bottom);
  if ABounds.Left < ADesktopBounds.Left then
    OffsetRect(ABounds, ADesktopBounds.Left - ABounds.Left, 0);
  if ABounds.Top < ADesktopBounds.Top then
    OffsetRect(ABounds, 0, ADesktopBounds.Top - ABounds.Top);
end;

procedure MakeVisibleOnDesktop(AControl: TControl);
var
  ABounds: TRect;
begin
  ABounds := AControl.BoundsRect;
  MakeVisibleOnDesktop(ABounds, ABounds.TopLeft);
  AControl.BoundsRect := ABounds;
end;

procedure MapWindowPoint(AHandleFrom, AHandleTo: TcxHandle; var P: TPoint);
begin            {10}
  MapWindowPoints(AHandleFrom, AHandleTo, P, 1);
end;

procedure MapWindowRect(AHandleFrom, AHandleTo: TcxHandle; var R: TRect);
var
  p: TPoint;
begin
  p := R.TopLeft;
  MapWindowPoint(AHandleFrom, AHandleTo, p);
  R.TopLeft := p;
  p := R.BottomRight;
  MapWindowPoint(AHandleFrom, AHandleTo, p);
  R.BottomRight := p;
end;

procedure RecreateControlWnd(AControl: TWinControl);
begin
  if AControl.HandleAllocated then
    AControl.Perform(CM_RECREATEWND, 0, 0);
end;

function RemoveAccelChars(const S: string; AAppendTerminatingUnderscore: Boolean): string;
const
  AAccelChar: Char = '&';
var
  ALastIndex, I: Integer;
begin
  Result := '';
  I := 1;
  ALastIndex := Length(S);
  while I <= ALastIndex do
  begin
    if S[I] = AAccelChar then
      if (I < ALastIndex) or not AAppendTerminatingUnderscore then
        Inc(I)
      else
      begin
        Result := Result + '_';
        Break;
      end;
    Result := Result + S[I];
    Inc(I);
  end;
end;

procedure SetDesignerModified(AComponent: TComponent);
var
  ADesigner: IDesignerNotify;
  //AParentForm: TCustomForm;
begin
  if (AComponent is TcxControl) and not TcxControl(AComponent).IsDesigning or
    not (AComponent is TcxControl) and not (csDesigning in AComponent.ComponentState) then
    Exit;
  ADesigner := nil;
  {if AComponent is TControl then
  begin
    AParentForm := GetParentForm(TControl(AComponent));
    if AParentForm <> nil then
      ADesigner := AParentForm.Designer;
  end
  else}
    ADesigner := FindRootDesigner(AComponent);
  if ADesigner <> nil then
    ADesigner.Modified;
end;

function ShiftStateToKeys(AShift: TShiftState): WORD;
begin
  Result := 0;
  if ssShift in AShift then Inc(Result, MK_SHIFT);
  if ssCtrl in AShift then Inc(Result, MK_CONTROL);
  if ssLeft in AShift then Inc(Result, MK_LBUTTON);
  if ssRight in AShift then Inc(Result, MK_RBUTTON);
  if ssMiddle in AShift then Inc(Result, MK_MBUTTON);
end;

function TranslateKey(Key: Word): Word;
begin
  Result := Key;
end;

  {$IFDEF USETCXSCROLLBAR}

{ TcxSettingsController }

type
  TcxSettingsController = class
  private
    FList: TList;
  protected
    FWindow: HWND;
    procedure MainWndProc(var Message: TMessage);
    procedure WndProc(var Message: TMessage); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddListener(AListener: TcxControl);
    procedure NotifyListeners;
    procedure RemoveListener(AListener: TcxControl);
  end;

constructor TcxSettingsController.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TcxSettingsController.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TcxSettingsController.AddListener(AListener: TcxControl);
begin
  with FList do
    if IndexOf(AListener) = -1 then
    begin
      if Count = 0 then
        FWindow := AllocateHWnd(MainWndProc);
      Add(AListener);
    end;
end;

procedure TcxSettingsController.RemoveListener(AListener: TcxControl);
begin
  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 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 then
  begin
    ACaller := Caller;
    if (Control <> nil) and Control.HandleAllocated and
      not PtInRect(Control.ClientRect, Control.ScreenToClient(GetMouseCursorPos)) 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