Mover una ventana sin leyenda mediante el uso de un "área de arrastrar"

Question

Me gustaría tener mi propia barra de título y, por lo tanto, estoy usando básicamente un panel (Nombre: pnCaption) y elimino la barra de título original en CreateParams. Pero la capacidad de mover la ventana mediante MouseDown-MouseMove en el nuevo panel es un problema.

Normalmente, utilizaría el mensaje NCHITTEST. PERO esto no se señala si el mouse está sobre el panel (mi propio título). Ver código ...

procedure TForm1.CreateParams(var params: TCreateParams); 
begin 
    inherited Createparams(Params); 
    with Params do 
    Style := (Style or WS_POPUP) and (not WS_DLGFRAME); 
end; 

procedure TForm1.WM_NCHitTest(var Msg: TWMNcHitTest); 
begin 
    inherited; 
    if PtInRect(pnCaption.BoundsRect, ScreenToClient(Point(Msg.XPos, Msg.YPos))) 
     then Msg.Result := HTCAPTION; 
end; 

Agradecería cualquier pista sobre cómo llevar a cabo esa tarea.

Cristiano

Answer 1

siempre se puede arrastrar una ventana por cualquier control que tenga un evento mousedown usando el número "Mágico" $ F012 con un mensaje WM_SYSCOMMAND. Es algo que recogí de Ray Kanopka (autor de los excelentes componentes de Raize), pero ya no recuerdo cómo se me impartió esto.

También es una manera ordenada y simple de permitir a los usuarios mover formas sin bordes dándoles una etiqueta de panel que se parece a un título. Por ejemplo, lo uso para permitir a los usuarios moverse sin fronteras sobre un diálogo:

procedure TAbout_Dlg.LblTitleMouseDown(Sender: TObject; 
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
const 
    sc_DragMove = $F012; 
begin 
    ReleaseCapture; 
    Perform(wm_SysCommand, sc_DragMove, 0); 
end; 

Answer 2

Como Estoy buscando en nuestro antiguo código de encargo componente StatusBar, que es descendiente de TWinControl, para proporcionar la forma de cambiar el tamaño usando el agarre de StatusBar manejamos WM_NCHITTEST en el control, no en la forma y HTBOTTOMRIGHT volver:

procedure TElStatusBar.WMNCHitTest; 
var 
    P : TPoint; 

    function InGrip(Point : TPoint) : boolean; 
    var 
    r : TRect; 
    begin 
    R := ClientRect; 
    R.Left := R.Right - R.Bottom + hMargin; 
    result := PtInRect(R, Point); 
    end; 

begin 
    if not FSizeGrip then 
    begin 
    inherited; 
    exit; 
    end; 
    P := ScreenToClient(Point(Message.XPos, Message.YPos)); 
    if InGrip(P) and (TForm(Parent).WindowState = wsNormal) 
    and (TForm(Parent).BorderStyle in [bsSizeable, bsSizeToolWin]) then 
    Message.Result := HTBOTTOMRIGHT 
    else 
    inherited; 
end; 

Esto significa que es necesario implementar descendiente de su componente panel (o el gancho que es el manejo de mensajes) y el mango WM_NCHITTEST allí.

Además, tomaría la ruta de manejar los mensajes WM_NCCALCSIZE y WM_NCPAINT en el formulario para proporcionar su propia área de subtítulos y evitar el uso de TPanel u otro control. Pero esta es solo mi preferencia.

Answer 3

La forma más fácil es, probablemente, utilizar un componente que no tiene un identificador de ventana HWND y, por lo tanto, no puede recibir mensajes. Se pasarán a su formulario, donde se pueden manejar de la manera que se muestra en su pregunta.

simplemente reemplazando el TPanel con un TGraphicControl descendiente alineado arriba TPaintBox, TImage o similar, haría que su código de trabajo. Mantiene tanto el manejo de mensajes del formulario como el soporte de alineación del VCL.

Answer 4

No es exactamente lo que está buscando, pero para otras personas interesadas en una técnica similar, aquí está el código para un componente TLabel descendiente que puede servir como una barra de título:

unit Draglbl; 

interface 

uses 
    WinTypes, WinProcs, Classes, Graphics, Controls, Forms, StdCtrls; 

type 
    TDragWindowTitle = class(TCustomLabel) 
    private 
    { Private declarations } 
    _lastx, 
    _lasty : integer ; 
    protected 
    { Protected declarations } 
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override ; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override ; 
    public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    published 
    { Published declarations } 
    property Alignment; 
    property Caption; 
    property Color; 
    property DragCursor; 
    property DragMode; 
    property Enabled; 
    property FocusControl; 
    property Font; 
    property ParentFont; 
    property ParentShowHint; 
    property PopupMenu; 
    property ShowHint; 
    property Visible; 
    property WordWrap; 
    property OnClick; 
    property OnDblClick; 
    property OnDragDrop; 
    property OnDragOver; 
    property OnEndDrag; 
    property OnMouseDown; 
    property OnMouseMove; 
    property OnMouseUp; 
    end; 

procedure Register; 

implementation 
constructor TDragWindowTitle.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner) ; 
    color := clActiveCaption ; 
    font := TForm(AOwner).Font ; 
    font.color := clCaptionText ; 
    Align := alTop ; 
    AutoSize := false ; 
    ShowAccelChar := false ; 
    Transparent := false ; 
end ; 

procedure TDragWindowTitle.MouseMove(Shift: TShiftState; X, Y: Integer); 
begin 
    if ssLeft in Shift then begin 
    TForm(owner).left := TForm(owner).left+(x-_lastx) ; 
    TForm(owner).top := TForm(owner).top+(y-_lasty) ; 
    end ; 

    inherited MouseMove(shift,x,y) ; 
end ; 

procedure TDragWindowTitle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
    if Button=mbLeft then begin 
    _lastx := x; 
    _lasty := y ; 
    end ; 
end ; 

procedure Register; 
begin 
    RegisterComponents('MYCOMPONENTS', [TDragWindowTitle]); 
end; 

end.