Na lang zwoegen heb ik een werkende versie. Alleen hij flikkert een beetje.
Code:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.AppEvnts, Vcl.StdCtrls,
Vcl.ExtCtrls, Vcl.Imaging.jpeg;
type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
TeVerplaatsenMetMuisWinControl: TGroupBox;
//Overige willekeurige componten om overheen te hooveren
GroupBox2: TGroupBox;
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
//
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
private
FMousePt: TPoint;
FOldPt: TPoint;
iStartX: Integer;
iStartY: Integer;
iGroupBoxX:Integer;
iGroupBoxY:Integer;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
R: TRect;
Pt: TPoint;
DC: HDC;
Rgn: HRGN;
begin
if Msg.Message = WM_LBUTTONUP then
begin
TeVerplaatsenMetMuisWinControl.Visible := True;
TeVerplaatsenMetMuisWinControl.BringToFront;
iStartX := -1;
iStartY := -1;
end;
if Msg.Message = WM_MOUSEMOVE then
begin
FMousePt := Point(-1, -1);
if (FOldPt.X > 0) and (FOldPt.Y > 0) then
begin
R := TeVerplaatsenMetMuisWinControl.BoundsRect;
InvalidateRect(Handle, @R, True);
RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or
RDW_ALLCHILDREN);
end;
if Msg.hwnd = Handle then
begin
FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam));
end
else
begin
if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then
begin
Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
Winapi.Windows.ClientToScreen(Msg.hwnd, Pt);
FMousePt := ScreenToClient(Pt);
TeVerplaatsenMetMuisWinControl.Cursor := crSizeAll;
if Msg.wParam = Msg.wParam or MK_LBUTTON then
begin
if (iStartX = -1) and (iStartY = -1) then
begin
iStartX := Pt.X;
iStartY := Pt.Y;
iGroupBoxX := TeVerplaatsenMetMuisWinControl.Left;
iGroupBoxY := TeVerplaatsenMetMuisWinControl.Top;
end;
TeVerplaatsenMetMuisWinControl.Visible := False;
TeVerplaatsenMetMuisWinControl.Left := iGroupBoxX + Pt.X -iStartX;
TeVerplaatsenMetMuisWinControl.Top := iGroupboxY + Pt.Y - iStartY;
if PtInRect(ClientRect, FMousePt) then
begin
R := TeVerplaatsenMetMuisWinControl.BoundsRect;
FOldPt := FMousePt;
DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);
Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top, ClientRect.Right,
ClientRect.Bottom);
SelectClipRgn(DC, Rgn);
DeleteObject(Rgn);
SelectObject(DC, GetStockObject(NULL_BRUSH));
Rectangle(DC, TeVerplaatsenMetMuisWinControl.BoundsRect.Left, TeVerplaatsenMetMuisWinControl.BoundsRect.Top,
TeVerplaatsenMetMuisWinControl.BoundsRect.Right, TeVerplaatsenMetMuisWinControl.BoundsRect.Bottom);
ReleaseDC(Handle, DC);
end;
end
end
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
iStartX := -1;
iStartY := -1;
iGroupBoxX := TeVerplaatsenMetMuisWinControl.Left;
iGroupBoxY := TeVerplaatsenMetMuisWinControl.Top;
end;
procedure TForm1.WMPaint(var Message: TWMPaint);
begin
inherited;
end;
end.
En hier de dfm file
Code:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 411
ClientWidth = 852
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 592
Top = 264
Width = 31
Height = 13
Caption = 'Label1'
end
object TeVerplaatsenMetMuisWinControl: TGroupBox
Left = 80
Top = 160
Width = 201
Height = 105
Caption = 'Sleep deze control over de anderen'
TabOrder = 0
end
object GroupBox2: TGroupBox
Left = 592
Top = 88
Width = 185
Height = 105
Caption = 'GroupBox2'
TabOrder = 1
end
object Edit1: TEdit
Left = 592
Top = 40
Width = 121
Height = 21
TabOrder = 2
Text = 'Edit1'
end
object Button1: TButton
Left = 592
Top = 216
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 3
end
object ApplicationEvents1: TApplicationEvents
OnMessage = ApplicationEvents1Message
Left = 136
Top = 64
end
end
Bookmarks