[KOOL]

Как сделать, чтобы сначала показывалась рамка вместо мгновенного изменения размеров формы?

[Rosenkrantz]

За это отвечает системный параметр Windows "Перетаскивать содержимое окна" (Drag Full Window), который можно установить либо узнать функцией SystemParametersInfo. Т.е. можно посоветовать при активации приложения устанавливать его в значение False, а при деактивации - возвращаеть обратно.

Т.е. при создании главной формы запоминаем как было; при активации приложения ставим False; при деактивации и при завершении приложения возвращаем "как было".

Вот примерно так:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  SysParam: Boolean;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Ord(SysParam), nil, SPIF_SENDCHANGE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @SysParam, SPIF_SENDCHANGE);
end;

procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, nil, SPIF_SENDCHANGE);
end;

procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Ord(SysParam), nil, SPIF_SENDCHANGE);
end;

end.

Это работает, но нужно помнить, что если ваше приложение вылетит, например, при exception, то установка останется и будет действовать на все окна системы.

Другой способ, видимо, состоит в перехвате событий WM_SIZE и WM_SIZING и отрисовке собственной рамки.

[KOOL]

Спасибо, а как это отключить при перемещении?Форма у меня должна цепляться к краям экрана

[Rosenkrantz]

Я не понял вопроса.
Какая связь между цеплянием к краям экрана и отображением рамки при перетаскивании? Проверяйте в ходе перетаскивания насколько близко форма оказалась к краю экрана и в случае, если это расстояние меньше предельного - прижимайте ее принудительно. Контролировать это можно при получении сообщения WM_WINDOWPOSCHANGING. А рамка тут, по-моему, совсем ни при чем.

Вот, посмотрите ссылку, тут описаны сообщения окна:
http://www.cyberguru.ru/programming/...truct-msg.html

Вот форма, которая прилипает к правому краю экрана, если подвести ее ближе чем на DRAG_DELTA пикселей. Кроме того, она не выходит за правый край экрана.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WndProc(var Msg: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

const
  DRAG_DELTA = 20;

procedure TForm1.WndProc(var Msg: TMessage);
var
  Data: PWindowPos;
begin
  if Msg.Msg = WM_WINDOWPOSCHANGING then begin
    Data := PWindowPos(Msg.LParam);

    if Data^.x + Data^.cx > Screen.Width then
      Data^.x := Screen.Width - Data^.cx;
    if Screen.Width - Data^.x - Data^.cx <= DRAG_DELTA then
      Data^.x := Screen.Width - Data^.cx;
  end;

  inherited;
end;

end.

[AlexSku]

Для цепляния формы к краям экрана установите св-во ScreenSnap = True. Расстояние, с которого это действует равно значению SnapBuffer (по ум. 10 пикселей).

[KOOL]

2AlexSku:
У меня так и есть , только когда рамка рисуется, ниче не прилипает.

2Rosenkrantz:
Спасибо попробую. Только рамки для всех окон остаются даже при корректном выходе из программы

[Rosenkrantz]

А все-таки - зачем вам эти самые рамки, если не секрет? Потому что, вообще говоря, это пользовательская настройка операционной системы (Свойства экрана->Оформление->Эффекты->Отображать содержимое окна при перетаскивании). Я бы как пользователь, например, был бы весьма недоволен, если какая-нибудь программа стала бы игнорировать мои настройки.

[KOOL]

Тормозит без них когда размер меняеш. Сильно. Хотя не очень-то много всего в окне. Может не только у меня...

[Rosenkrantz]

По-моему, я сделал то, что вам требовалось. Не ручаюсь, что наилучшим образом подобрал сообщения, но работает.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
  private
    FDragParamChanged: Boolean;

    { Private declarations }
    procedure SetFullWindowDrag(Value: Boolean);
    function  GetFullWindowDrag: Boolean;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;

    procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
    procedure WMGetMinMaxInfo(var Msg: TMessage); message WM_GETMINMAXINFO;
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

const
  DRAG_DELTA = 20;

var
  SysDragFullWindow: Boolean;

constructor TForm1.Create(AOwner: TComponent);
begin
  FDragParamChanged := False;
  
  inherited;
end;

function TForm1.GetFullWindowDrag: Boolean;
begin
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @Result, 0);
end;

procedure TForm1.SetFullWindowDrag(Value: Boolean);
begin
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Ord(Value), nil, 0);
end;

procedure TForm1.WMExitSizeMove(var Msg: TMessage);
begin
  SetFullWindowDrag(SysDragFullWindow); // Вернуть системную установку
  FDragParamChanged := False;

  inherited;
end;

procedure TForm1.WMGetMinMaxInfo(var Msg: TMessage);
begin
  if not FDragParamChanged then begin
    SysDragFullWindow := GetFullWindowDrag; // Запомнить системную установку
    SetFullWindowDrag(False); // Установить свою

    FDragParamChanged := True;
  end;

  inherited;
end;

procedure TForm1.WMMoving(var Msg: TMessage);

  procedure MoveRect(var R: TRect; ALeft, ATop: Integer);
  var
    DX, DY: Integer;
  begin
    DX       := ALeft - R.Left;
    DY       := ATop  - R.Top;

    R.Left   := R.Left   + DX;
    R.Top    := R.Top    + DY;
    R.Right  := R.Right  + DX;
    R.Bottom := R.Bottom + DY;
  end;

var
  WR: PRect; // Указатель на координаты перетаскиваемого прямоугольника
  DR: TRect; // Прямоугольник рабочей области Desktop (без TaskBar)
begin
  WR := PRect(Msg.LParam);
  SystemParametersInfo(SPI_GETWORKAREA, 0, @DR, 0);

  // -- Организуем прилипание ------------------------------------------------
  // Левый край
  if WR^.Left = DR.Left + DRAG_DELTA then
    MoveRect(WR^, DR.Left, WR^.Top);
  // Верхний край
  if WR^.Top = DR.Top + DRAG_DELTA then
    MoveRect(WR^, WR^.Left, DR.Top);
  // Правый край
  if DR.Right - WR^.Right = DRAG_DELTA then
    MoveRect(WR^, DR.Right - WR^.Right + WR^.Left, WR^.Top);
  // Нижний край
  if DR.Bottom - WR^.Bottom = DRAG_DELTA then
    MoveRect(WR^, WR^.Left, DR.Bottom - WR^.Bottom + WR^.Top);

  // -- Контроль выхода за край экрана ---------------------------------------
  if WR^.Left   < DR.Left   then MoveRect(WR^, DR.Left, WR^.Top);
  if WR^.Top    < DR.Top    then MoveRect(WR^, WR^.Left, DR.Top);
  if WR^.Right  > DR.Right  then MoveRect(WR^, DR.Right - WR^.Right + WR^.Left, WR^.Top);
  if WR^.Bottom > DR.Bottom then MoveRect(WR^, WR^.Left, DR.Bottom - WR^.Bottom + WR^.Top);

  inherited;
end;

end.