program nonvcl; 
 
uses 
  Windows, Messages; 
 
const 
  App = 'NONVCL'; 
  txt1 = 'Das ist ein Test'; 
  txt2 = 'Das ist ein Versuch'; 
  width = 300; 
  height = 265; 
 
var 
  left, top, x: integer; 
  dc: HDC; 
  lr: TRect; 
  cp: TPoint; 
  aMsg: TMsg; 
  ps: TPaintStruct; 
  hBtn: array[0..1] of LongInt; 
  hm, hw, hf, bf, hEdt, hLbl, hCB: LongInt; 
 
procedure SetAutoSizeCaption(d: HDC; txt: string; h: Thandle); 
var 
  i: TSize; 
begin 
  GetTextExtentPoint32A(d, PChar(txt), length(txt), i); 
  SetWindowPos(h, 0, 0, 0, i.cx, i.cy, SWP_NOZORDER or SWP_NOMOVE); 
  SendMessage(h, WM_SETTEXT, 0, LongInt(PChar(txt))); 
end; 
 
function GetText(lang: integer; h: THandle): string; 
var 
  p: PChar; 
begin 
  GetMem(p, lang + 1); 
  SendMessage(h, WM_GETTEXT, lang + 1, LongInt(p)); 
  SetString(result, p, lang); 
  FreeMem(p); 
end; 
 
function IntToStr(i: Integer): string; 
var 
  p: PChar; 
begin 
  GetMem(p, 12); 
  SetString(Result, p, wvsprintf(p, PChar('%d'), PChar(@i))); 
  Freemem(p); 
end; 
 
function ScreenWidth: Integer; 
begin 
  Result := GetSystemMetrics(78); 
end; 
 
function ScreenHeight: Integer; 
begin 
  Result := GetSystemMetrics(79); 
end; 
 
procedure Paint; 
begin 
  SetBkColor(dc, $EEFF); 
  SetTextColor(dc, $FF); 
  TextOut(dc, 20, 30, PChar(txt1), length(txt1)); 
  SetBkColor(dc, $663399); 
  SetTextColor(dc, $FFFFFF); 
  TextOut(dc, 140, 30, PChar(txt2), length(txt2)); 
end; 
 
function NewFont(hgt, wgt: integer; fName: string): LongInt; 
begin 
  Result := CreateFont(hgt, 0, 0, 0, wgt, 0, 0, 0, ANSI_CHARSET, 
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 
    PChar(fName)); 
end; 
 
function WindowProc(wndw: HWnd; const fMsg, WParam, 
  LParam: LongInt): LongInt; stdcall; 
var 
  txt: string; 
begin 
  Result := 0; 
  case fMsg of 
    WM_COMMAND: if WParam = BN_CLICKED then begin 
        if LParam = hBtn[0] then 
          MessageBox(wndw, 'Musst du überall draufklicken? ', '?????', 
            mb_iconquestion) 
        else if LParam = hCB then EnableWindow(hBtn[1], 
            (sendmessage(hCB, BM_GETCHECK, 0, 0) = BST_CHECKED)) 
        else if LParam = hBtn[1] then begin 
          txt := GetText(SendMessage(hEdt, WM_GETTEXTLENGTH, 0, 0), hEdt); 
          MessageBox(wndw, PChar(txt), 'Test', mb_iconinformation) 
        end; 
        Exit; 
      end; 
    WM_NCLBUTTONDOWN: if WParam = HTZOOM then begin 
        MessageBox(wndw, 'Hier wird nicht maximiert !!', 'NEIN', 
          MB_ICONEXCLAMATION); 
        Exit; 
      end; 
    WM_LBUTTONDOWN: begin 
        GetCursorPos(cp); 
        GetWindowRect(hLbl, lr); 
        if PtInRect(lr, cp) then 
          MessageBox(wndw, PChar('   ABSTURZ'#13#10#13#10 + 
            '(war ''n Scherz)   '), 'FEHLER', MB_ICONSTOP) 
        else Messagebeep(0); 
        Exit; 
      end; 
    WM_PAINT: begin 
        BeginPaint(wndw, ps); 
        Paint; 
        EndPaint(wndw, ps); 
        Exit; 
      end; 
    WM_DESTROY: begin 
        PostQuitMessage(0); 
        Exit; 
      end; 
  end; 
  Result := DefWindowProc(wndw, fMsg, WParam, LParam); 
end; 
 
function RegisterW: Atom; 
var 
  ClassW: WndClass; 
begin 
  ClassW.Style := cs_hRedraw or cs_vRedraw; 
  ClassW.lpfnWndProc := @WindowProc; 
  ClassW.cbClsExtra := 0; 
  ClassW.cbWndExtra := 0; 
  ClassW.hInstance := hInstance; 
  ClassW.hIcon := LoadIcon(0, IDI_EXCLAMATION); 
  ClassW.hCursor := LoadCursor(0, idc_Arrow); 
  ClassW.hbrBackground := CreateSolidBrush(GetSysColor(COLOR_BTNFACE)); 
  ClassW.lpszMenuName := nil; 
  ClassW.lpszClassName := App; 
  Result := RegisterClass(ClassW); 
end; 
 
function CreateW: LongInt; 
begin 
  Result := CreateWindow(App, 'Test-Programm', 
    WS_OVERLAPPEDWINDOW and not WS_MAXIMIZEBOX, left, top, width, height, 
    0, 0, hInstance, nil); 
end; 
 
function CreateBLC(k, n: string; st, lft, tp, rght, btm: integer): LongInt; 
begin 
  Result := CreateWindow(PChar(k), PChar(n), 
    WS_VISIBLE or WS_CHILD or st, lft, tp, rght, btm, 
    hw, 0, hInstance, nil); 
end; 
 
function CreateEdt(n: string; lft, tp, rght, btm: integer): LongInt; 
begin 
  Result := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', PChar(n), 
    WS_VISIBLE or WS_CHILD, lft, tp, rght, btm, 
    hw, 0, hInstance, nil); 
end; 
 
begin 
  if RegisterW = 0 then begin 
    MessageBox(0, 'Registrierfehler', nil, 0); 
    Exit; 
  end; 
  left := (screenwidth - width) div 2; 
  top := (screenheight - height) div 2; 
  hw := CreateW; 
  if hw = 0 then begin 
    MessageBox(0, 'Fenster nicht erzeugt', nil, 0); 
    Exit; 
  end; 
  for x := 0 to length(hBtn) - 1 do begin 
    hBtn[x] := CreateBLC('BUTTON', 'Button' + IntToStr(x + 1), 
      0, 40 + x * 130, 70, 75, 25); 
    if hBtn[x] = 0 then begin 
      MessageBox(0, 'Button nicht erzeugt', nil, 0); 
      DestroyWindow(hw); 
      Exit; 
    end; 
  end; 
  hEdt := CreateEdt('Edit1', 30, 120, 230, 20); 
  if hEdt = 0 then begin 
    MessageBox(0, 'Edit nicht erzeugt', nil, 0); 
    DestroyWindow(hw); 
    Exit; 
  end; 
  hLbl := CreateBLC('STATIC', '', 0, 100, 160, 0, 0); 
  if hLbl = 0 then begin 
    MessageBox(0, 'Label nicht erzeugt', nil, 0); 
    DestroyWindow(hw); 
    Exit; 
  end; 
  hCB := CreateBLC('BUTTON', 'Button2 enabled', BS_AUTOCHECKBOX, 
    80, 195, 140, 20); 
  if hCB = 0 then begin 
    MessageBox(0, 'CheckBox nicht erzeugt', nil, 0); 
    DestroyWindow(hw); 
    Exit; 
  end; 
  sendmessage(hCB, BM_SETCHECK, BST_CHECKED, 0); 
  hf := NewFont(16, FW_NORMAL, 'Courier New'); 
  bf := NewFont(18, FW_BOLD, 'Times New Roman'); 
  SendMessage(hEdt, WM_SETFONT, hf, 0); 
  SendMessage(hCB, WM_SETFONT, hf, 0); 
  for x := 0 to length(hBtn) - 1 do SendMessage(hBtn[x], WM_SETFONT, hf, 0); 
  dc := GetDC(hw); 
  SelectObject(dc, bf); 
  SendMessage(hLbl, WM_SETFONT, bf, 0); 
  SetAutoSizeCaption(dc, 'DBR.Software', hLbl);
  hm := GetSystemMenu(hw, false); 
  RemoveMenu(hm, SC_MAXIMIZE, mf_bycommand); 
  ShowWindow(hw, sw_Show); 
  while GetMessage(aMsg, 0, 0, 0) do begin 
    TranslateMessage(aMsg); 
    DispatchMessage(aMsg); 
  end; 
  DeleteObject(hf); 
  DeleteObject(bf); 
  DeleteDC(dc); 
end.