this slowpoke moves

Window Template

program test1;

uses windows,
  messages;

{$WARNINGS OFF}
{$HINTS OFF}

const
  windowleft: integer = 100;
  windowtop: integer = 100;
  windowwidth: integer = 265;
  windowheight: integer = 202;
  ClassName = 'ATestWndClassEx';

{$IFDEF VER90}
  tagNONCLIENTMETRICSA = packed record
    cbSize: UINT;
    iBorderWidth: Integer;
    iScrollWidth: Integer;
    iScrollHeight: Integer;
    iCaptionWidth: Integer;
    iCaptionHeight: Integer;
    lfCaptionFont: TLogFontA;
    iSmCaptionWidth: Integer;
    iSmCaptionHeight: Integer;
    lfSmCaptionFont: TLogFontA;
    iMenuWidth: Integer;
    iMenuHeight: Integer;
    lfMenuFont: TLogFontA;
    lfStatusFont: TLogFontA;
    lfMessageFont: TLogFontA;
  end;

  TNonClientMetricsA = tagNONCLIENTMETRICSA;
  TNonClientMetrics = TNonClientMetricsA;
  NONCLIENTMETRICSA = tagNONCLIENTMETRICSA;
  NONCLIENTMETRICS = NONCLIENTMETRICSA;
{$ENDIF}

function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var OKbtn: DWORD;
begin
  Result := 0;
  case uMsg of
    WM_CREATE:
      begin
        OKbtn := createwindow('BUTTON', 'OK-Button', WS_VISIBLE or WS_CHILD, 100, 100, 100, 30, hwnd, IDOK, hInstance, nil);
        if OKbtn = INVALID_HANDLE_VALUE then
          messagebox(hwnd, 'Button nicht erzeugt', 'Meldung', 0);
      end;
    WM_DESTROY:
      begin
        PostQuitMessage(0);
      end;
    WM_COMMAND:
      case hiword(wparam) of
        BN_CLICKED:
          case loword(wparam) of
            IDOK:
              begin
                //messagebox(hwnd, 'OK Button gedr?/font>, 'Meldung', 0);
                sendmessage(hwnd, WM_CLOSE, 0, 0);
              end;
          end;
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

{$IFDEF VER100}
type
  tagNONCLIENTMETRICSA = packed record
    cbSize: UINT;
    iBorderWidth: Integer;
    iScrollWidth: Integer;
    iScrollHeight: Integer;
    iCaptionWidth: Integer;
    iCaptionHeight: Integer;
    lfCaptionFont: TLogFontA;
    iSmCaptionWidth: Integer;
    iSmCaptionHeight: Integer;
    lfSmCaptionFont: TLogFontA;
    iMenuWidth: Integer;
    iMenuHeight: Integer;
    lfMenuFont: TLogFontA;
    lfStatusFont: TLogFontA;
    lfMessageFont: TLogFontA;
  end;
  tagNONCLIENTMETRICS = tagNONCLIENTMETRICSA;
{$ENDIF}
var wc: TWndClassEx = (
    cbSize: SizeOf(TWndClassEx);
    style: CS_OWNDC or CS_HREDRAW or CS_VREDRAW;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hbrBackground: COLOR_WINDOW;
    lpszMenuName: nil;
    lpszClassName: ClassName;
    hIconSm: 0; );
  msg: TMSG;
  rect: trect;
  deskh, deskw: integer;
  ncm: tagNONCLIENTMETRICS;
begin
  wc.hInstance := HInstance;
  wc.hIcon := LoadIcon(HInstance, MAKEINTRESOURCE(1));
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.lpfnWndProc := @WndProc;
  systemparametersinfo(SPI_GETWORKAREA, 0, @rect, 0);
  deskw := rect.Right - rect.Left;
  deskh := rect.Bottom - rect.Top;
  ncm.cbSize := sizeof(ncm);
  systemparametersinfo(SPI_GETNONCLIENTMETRICS, sizeof(ncm), @ncm, 0);
  //windowwidth := windowleft + windowwidth;
  //windowheight := windowtop + windowheight + ncm.iMenuHeight + ncm.iCaptionHeight;
  //Windowleft := (deskw div 2) - (windowwidth div 2);
  //Windowtop := (deskh div 2) - (windowheight div 2);
  RegisterClassEx(wc);
    {mainwnd:=} CreateWindowEx(WS_EX_WINDOWEDGE or WS_EX_CONTROLPARENT or WS_EX_APPWINDOW,
    ClassName,
    'Caption',
    WS_OVERLAPPED
    or WS_CAPTION
    or WS_SYSMENU
    or WS_MINIMIZEBOX
    or WS_VISIBLE,
    windowleft,
    windowtop,
    windowwidth,
    windowheight,
    0,
    0,
    hInstance,
    nil);
  while True do begin
    if not GetMessage(msg, 0, 0, 0) then break; //oops :o)
    translatemessage(msg);
    dispatchmessage(msg);
  end;
  ExitCode := GetLastError;
end.

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate