Отображение содержимого окна при перетаскивании [D5, D6, Win95/98, WinME]
kioto © (2002-01-27 10:59:00)
Что бы ТОЛЬКО для МОЕГО окна (формы) выполнялось то, что для
всех окон : Cвойства:Экран -> Эффекты -> Отображать
содержимое окна при перетаскивании (включено), вне зависимости, как
эта опция стоит у пользователя в системе.
Подскажите, как правильнее это сделать (желательно на мыло -
kioto@rambler.ru)
Almaz (2002-02-01 00:36:00) [1]
Вот так:
unit move;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
Capture: HWND;
InMove: Boolean;
MouseOffset: TPoint;
procedure WMNCLButtonDown(var Message: TWMNCMouseMove);
message WM_NCLBUTTONDOWN;
procedure WMMouseMove(var Message: TWMMouseMove); message
WM_MOUSEMOVE;
procedure WMLButtonUp(var Message: TMessage); message
WM_LBUTTONUP;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMMouseMove(var Message: TWMMouseMove);
var
MousePt: TPoint;
begin
if InMove then
begin
GetCursorPos(MousePt);
MousePt.x := MousePt.x - MouseOffset.x;
MousePt.y := MousePt.y - MouseOffset.y;
Left := MousePt.x;
Top := MousePt.y;
end else inherited;
end;
procedure TForm1.WMNCLButtonDown(var Message:
TWMNCMouseMove);
begin
if Message.HitTest = HTCAPTION then
begin
Capture := GetCapture;
SetCapture(Handle);
GetCursorPos(MouseOffset);
MouseOffset.x := MouseOffset.x - Left;
MouseOffset.y := MouseOffset.y - Top;
InMove := True;
end else inherited;
end;
procedure TForm1.WMLButtonUp(var Message: TMessage);
begin
if InMove then
begin
if Capture = 0 then ReleaseCapture else SetCapture(Capture);
InMove := False;
end else inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InMove := False;
end;
end.
Удачи.
Наверх 
ЧАТ |
Орешник |
|
