Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Программа и интерфейс
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #9  
Старый 12.03.2008, 17:07
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

По-моему, я сделал то, что вам требовалось. Не ручаюсь, что наилучшим образом подобрал сообщения, но работает.
Код:
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.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:11.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025