Fenster verschieben?

[Aphton]

Blank Window Example (nonvcl)

Delphi-Quellcode:

program DemoFormMovement;

{$A+,B-,C-,D-,E-,F-,G+,H+,I-,J-,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$APPTYPE GUI}

type
  TWndClassEx = packed record
    cbSize: Cardinal;
    style: Cardinal;
    lpfnWndProc: Pointer;
    cbClsExtra: Integer;
    cbWndExtra: Integer;
    hInstance: Cardinal;
    hIcon: Cardinal;
    hCursor: Cardinal;
    hbrBackground: Cardinal;
    lpszMenuName: PAnsiChar;
    lpszClassName: PAnsiChar;
    hIconSm: Cardinal;
  end;

  TPoint = packed record
    X: Longint;
    Y: Longint;
  end;

  TMsg = packed record
    hwnd: Cardinal;
    message: Cardinal;
    wParam: Integer;
    lParam: Integer;
    time: Cardinal;
    pt: TPoint;
  end;

const
  kernel32          = 'kernel32.dll';
  user32            = 'user32.dll';

  _Classname: PChar = 'WndDmoCls';
  _Width: Word      = 320;
  _Height: Word     = 240;

  {Windows Rip}
  HWND_TOP          = 0;
  COLOR_WINDOW      = 5;
  WS_EX_TOOLWINDOW  = $80;
  GWL_STYLE         = -16;
  WS_VISIBLE        = $10000000;
  WS_CAPTION        = $C00000;
  VK_ESCAPE         = 27;   
  SWP_SHOWWINDOW    = $40;            
  IDC_ARROW         = Pointer(32512);

  {Messages Rip}
  WM_DESTROY        = $0002;
  WM_KEYUP          = $0101;
  WM_LBUTTONDOWN    = $0201;
  WM_MOUSEMOVE      = $0200;
  WM_LBUTTONUP      = $0202;

var
  hWnd: Cardinal;
  mMsg: TMsg;
  wWnd: TWndClassEx;

  InitialFormMousePosition,
  ScreenMouse: TPoint;
  MouseIsDown: Boolean;

{Windows Rip}
function RegisterClassEx(const WndClass: TWndClassEx): Word; stdcall;
  external user32 name 'RegisterClassExA';
function LoadCursor(Cardinalance: Cardinal; lpCursorName: PChar): Cardinal; stdcall;
  external user32 name 'LoadCursorA';
function CreateWindowEx(dwExStyle: Cardinal; lpClassName: PChar;
  lpWindowName: PChar; dwStyle: Cardinal; X, Y, nWidth, nHeight: Integer;
  hWndParent: Cardinal; hMenu: Cardinal; Cardinalance: Cardinal; lpParam: Pointer): Cardinal;
  stdcall; external user32 name 'CreateWindowExA';
function SetWindowLong(hWnd: Cardinal; nIndex: Integer; dwNewLong: Longint): Longint; stdcall;
  external user32 name 'SetWindowLongA';
function GetMessage(var lpMsg: TMsg; hWnd: Cardinal;
  wMsgFilterMin, wMsgFilterMax: Cardinal): Boolean; stdcall;
  external user32 name 'GetMessageA';
function TranslateMessage(const lpMsg: TMsg): Boolean; stdcall;
  external user32 name 'TranslateMessage';
function DispatchMessage(const lpMsg: TMsg): Longint; stdcall;
  external user32 name 'DispatchMessageA';
function UnregisterClass(lpClassName: PChar; Cardinalance: Cardinal): Boolean; stdcall;
  external user32 name 'UnregisterClassA';
function GetLastError: Cardinal; stdcall;
  external kernel32 name 'GetLastError';
procedure PostQuitMessage(nExitCode: Integer); stdcall;
  external user32 name 'PostQuitMessage';
function GetCursorPos(var lpPoint: TPoint): Boolean; stdcall;
  external user32 name 'GetCursorPos';
function SetWindowPos(hWnd: Cardinal; hWndInsertAfter: Cardinal;
  X, Y, cx, cy: Integer; uFlags: Cardinal): Boolean; stdcall;
  external user32 name 'SetWindowPos';
function DefWindowProc(hWnd, Msg: Cardinal; wParam, lParam: Integer ): Integer; stdcall;
  external user32 name 'DefWindowProcA';

function WndProc( hWnd, uMsg: Cardinal; wParam, lParam: Integer ): Integer; stdcall;
begin
  Result := 0;
  case uMsg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_KEYUP:
      case Word( wParam ) of
        VK_ESCAPE:
          WndProc( hWnd, WM_DESTROY, 0, 0 );
      end;
    WM_LBUTTONDOWN:
    begin
      with InitialFormMousePosition do
      begin
        X := Word( lParam );
        Y := Word( lParam shr 16 );
      end;
      MouseIsDown := True;
    end;
    WM_MOUSEMOVE:
    if MouseIsDown then
    begin
      GetCursorPos( ScreenMouse );
      SetWindowPos( hWnd, HWND_TOP, ScreenMouse.X - InitialFormMousePosition.X,
        ScreenMouse.Y - InitialFormMousePosition.Y, _Width, _Height, SWP_SHOWWINDOW );
    end;
    WM_LBUTTONUP:
      MouseIsDown := False;
  else
    Result := DefWindowProc( hWnd, uMsg, wParam, lParam );
  end;
end;

begin
  with wWnd do
  begin
    cbSize := SizeOf( wWnd );
    lpfnWndProc := @WndProc;
    hCursor := LoadCursor( 0, IDC_ARROW );
    hbrBackground := COLOR_WINDOW;
    lpszClassName := _Classname;
  end;
  RegisterClassEx( wWnd );
  hWnd := CreateWindowEx( WS_EX_TOOLWINDOW, _Classname, NIL, WS_VISIBLE,
    100, 100, _Width, _Height, 0, 0, 0, NIL );
  SetWindowLong( hWnd, GWL_STYLE, WS_VISIBLE and (not WS_CAPTION) );
  while GetMessage( mMsg, 0, 0, 0 ) do
  begin
    TranslateMessage( mMsg );
    DispatchMessage( mMsg );
  end;
  UnregisterClass( _Classname, 0 );
  ExitCode := GetLastError;
end.