VPF::Перетащить форму - Форум программистов

Стасик

Дата 23.8.2004, 13:58 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Подскажите, ПЛИЗЗЗ!
Как мне сделать так, чтобы форму можно было перетаскивать с маста на место держась за TImage или TPaintBox.
Заранее очень благодарен.

Girder

Дата 23.8.2004, 15:57 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155

К примеру, вот так:

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  xi,yi:Integer;

implementation

{$R *.dfm}

procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
 X:=X-xi;
 Y:=Y-yi;
 Form1.Left:=Form1.Left+X;
 Form1.Top:=Form1.Top+Y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Xi:=x;
 Yi:=y;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Image1.DragMode:=dmAutomatic;
 Image1.DragCursor:=crHandPoint;
end;

end.

Это сообщение отредактировал(а) Girder - 23.8.2004, 15:59

--------------------

Как слышим, так и пишим.
Истина где-то там...

Guest

Дата 23.8.2004, 16:15 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Ох! Сложно!

Огромное СПАСИБО!

Rennigth

Дата 23.8.2004, 18:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

а можно и покороче
на keydown image

Код


  ReleaseCapture;
  perform(WM_SysCommand,$F012, 0);

Faq полезная вещь

--------------------

(* Honesta mors turpi vita potior *)

Girder

Дата 24.8.2004, 08:13 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155

Можно... Только не на Key, а на Mouse...

--------------------

Как слышим, так и пишим.
Истина где-то там...

Rennigth

Дата 24.8.2004, 17:47 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

ну да...

сори

--------------------

(* Honesta mors turpi vita potior *)

Akella

Дата 25.8.2004, 14:34 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
//-------этот кусок можно вставить в событие нажатия клавиши
//-------мыши не только формы, а любого компонента, который
//-------имеет такое событие
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
perform(WM_SysCommand, SC_DragMove, 0);
end;

decoder

Дата 27.8.2004, 17:48 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 204
Регистрация: 18.5.2004
Где: Харьков(хохол, к сожалению)

Репутация: нет
Всего: -1

Держась за форму:

Код


...
type
  TForm1 = class(TForm)
  ...
  private
     procedure WMNCHitTest(var m: TWMNCHitTest); message WM_NCHitTest;
  ...
implementation
procedure TForm1.WMNCHitTest(var m: TWMNCHitTest);
begin
  inherited
  if m.Result = HTClient then
    m.Result := HTCaption;
end;

Модернизируй...

--------------------

Молчать, я вас спрашиваю!

The MASTER

Дата 1.9.2004, 10:59 (ссылка)

(нет голосов)

Загрузка ...

Old master)

Профиль
Группа: Участник
Сообщений: 862
Регистрация: 19.7.2004
Где: Санкт-Петербург

Репутация: 2
Всего: 5

Легко:

Код


В Приват напиши
cX, cY : integer;
cEnabled : bool;

В событие OnMouseDown:
Пишешь:

If button=mbleft then begin
cX:=X;
cY:=Y;
cEnabled:=true;
end;

В событие onMouseMove:

if sMove then begin;
 Left:=Left+X-cX;
 Top:=Top+Y-cY;
end;

В событие onMouseUp:

cEnabled:=false;

Вот и всё!

--------------------

http://linkinparkfans.ru
http://innovatedesign.ru
http://forum.linkinparkfans.ru

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »