Program test;
// Program for testing dialogue boxes

{$APPTYPE GUI}

Uses windows;

Const
  AppName = 'Lydexperiment';

var 
  AMessage: Msg; hWindow: HWnd;
  pbox2: pointer; box2var1, box2var2: longint;

  Boxtemplate: DlgTemplate;
  Boxtemplatesize: word;
  pBoxAllokate: ^word; //Start of allocated memory
  pBoxtemplate: ^word; //Start of Boxtemplate
  pBoxItem: ^word;     //Start of free space after added items

{$Rangechecks off}
//**************************************************************
Procedure newboxtemplate(title: string; width, height, boxsize: word);
var i:integer;
begin boxtemplatesize:=boxsize; pBoxItem:=nil;
  getmem(pBoxAllokate,boxsize); pBoxtemplate:=pBoxAllokate;
  if (dword(pBoxtemplate) and 1)=1 then pBoxtemplate:=nil;
  if (dword(pBoxtemplate) and 2)=2 then inc(pBoxtemplate);
  if pBoxtemplate=nil then exit;
  Boxtemplate.style:=DS_CENTER or WS_POPUP or WS_CAPTION or WS_SYSMENU or DS_MODALFRAME;
  Boxtemplate.dwextendedstyle:=0;
  Boxtemplate.x:=0; Boxtemplate.y:=0; Boxtemplate.cx:=width; Boxtemplate.cy:=height;
  Boxtemplate.cdit:=0; pBoxItem:=pointer(pBoxtemplate) + sizeof(Boxtemplate);
  pBoxItem^:=0; inc(pBoxItem); pBoxItem^:=0; inc(pBoxItem); // menu and class
  for i:=1 to length(title) do begin pBoxItem^:=ord(title[i]); inc(pBoxItem) end;
  pBoxItem^:=0; inc(pBoxItem) end; // terminating 0 in titel

Procedure newboxtemplate(title: string; width, height: word);
begin newboxtemplate(title, width, height, 2000) end;

//**************************************************************
Procedure appendboxitem(id: word; style: DWORD; class: word; title: string; x,y,width,height: WORD);
var i: word; Bi: Dlgitemtemplate;
begin if pBoxItem=nil then exit; if (dword(pBoxItem) and 2)=2 then inc(pBoxItem);
  Bi.style:=style or WS_VISIBLE or WS_CHILD;
  if class<>$82 then Bi.style:=BI.style or WS_TABSTOP;
  Bi.dwextendedstyle:=0;
  Bi.x:=x; Bi.y:=y; Bi.cx:=width; Bi.cy:=height;  Bi.id:=id;
  move(Bi,pBoxItem^,sizeof(Bi)); inc(pBoxItem,sizeof(bi) div 2);
  pBoxItem^:=$FFFF; inc(pBoxItem);  pBoxItem^:=class; inc(pBoxItem); //standard-class presumed
  for i:=1 to length(title) do begin pBoxItem^:=ord(title[i]); inc(pBoxItem) end;
  pBoxItem^:=0; inc(pBoxItem); // terminating 0 in titel
  pBoxItem^:=0; inc(pBoxItem); // creation data is not used
  inc(Boxtemplate.cdit); move(Boxtemplate,pBoxtemplate^,sizeof(Boxtemplate));
  end;

Function getboxtemplate: pointer;
var nbox: DWORD; pBoxny: ^word;
begin if pBoxItem=nil then begin
    getboxtemplate:=nil; MessageBox (0,'WinCreate failed','Error',MB_OK); exit end
  else getboxtemplate:=pBoxtemplate;
  nbox := pointer(pBoxItem) - pointer(pBoxAllokate); getmem(pBoxny,nbox+2);
  if pBoxny=nil then exit;
  if (dword(pBoxny) and 1)=1 then pBoxny:=nil;
  if (dword(pBoxny) and 2)=2 then begin inc(pBoxny); dec(nbox,2) end;
  move(pBoxtemplate^,pBoxny^,nbox); freemem(pBoxAllokate,Boxtemplatesize);
  pBoxtemplate:=pBoxny; getboxtemplate:=pBoxny; pBoxItem:=nil end;

//**************************************************************
//End of dialogue box data structure making procedures

//Start of specific dialogue box definition
//******************************************************************************
Function Box2Proc(Box: hWnd; Message: UINT; WPrm : longint; LPrm: longint): Longint; stdcall;
begin Box2Proc:=1; if LPrm=0 then ;
  case Message of
    WM_INITDIALOG: begin box2var1:=8000; box2var2:=2;
      case box2var1 of
        8000: Checkradiobutton(Box,2,7,2);
        11025: Checkradiobutton(Box,2,7,3);
        16000: Checkradiobutton(Box,2,7,4);
        22050: Checkradiobutton(Box,2,7,5);
        48000: Checkradiobutton(Box,2,7,6);
        44100: Checkradiobutton(Box,2,7,7);
        end;
      if box2var2>1 then CheckDlgButton(Box,8,BST_CHECKED)
      else CheckDlgButton(Box,8,BST_UNCHECKED);
      setfocus(longint(Box)); Box2Proc:=0 end;
    WM_COMMAND: case LOWORD(WPrm) of
      2: begin Checkradiobutton(Box,2,7,2); box2var1:=8000 end;
      3: begin Checkradiobutton(Box,2,7,3); box2var1:=11025 end;
      4: begin Checkradiobutton(Box,2,7,4); box2var1:=16000 end;
      5: begin Checkradiobutton(Box,2,7,5); box2var1:=22050 end;
      6: begin Checkradiobutton(Box,2,7,6); box2var1:=48000 end;
      7: begin Checkradiobutton(Box,2,7,7); box2var1:=44100 end;
      8: if box2var2>1 then begin box2var2:=1; CheckDlgButton(Box,8,BST_UNCHECKED) end
        else begin box2var2:=2; CheckDlgButton(Box,8,BST_CHECKED) end;
      9: begin enddialog(Box,1) end end;
    WM_CLOSE: enddialog(Box,0);
    else Box2Proc:=0 end end;

Procedure showbox(window: hWnd);
begin if DialogBoxIndirect(system.MainInstance,pBox2, Window, @Box2Proc)=0 then exit end;

//******************************************************************************

Procedure setboxtemplates;
begin
  newboxtemplate('Lydkvalitet',87,90);
  appendboxitem(1,SS_SIMPLE,$82,'Samplerate (s. pr. sek.)',5,5,80,12);
  appendboxitem(2,BS_AUTORADIOBUTTON,$80,'8000',5,20,40,12);
  appendboxitem(3,BS_AUTORADIOBUTTON,$80,'11025',50,20,40,12);
  appendboxitem(4,BS_AUTORADIOBUTTON,$80,'16000',5,35,40,12);
  appendboxitem(5,BS_AUTORADIOBUTTON,$80,'22050',50,35,40,12);
  appendboxitem(6,BS_AUTORADIOBUTTON,$80,'48000',5,50,40,12);
  appendboxitem(7,BS_AUTORADIOBUTTON,$80,'44100',50,50,40,12);
  appendboxitem(8,BS_CHECKBOX,$80,'Stereo',6,68,40,12);
  appendboxitem(9,BS_DEFPUSHBUTTON,$80,'OK',50,70,30,12);
  pBox2:=getboxtemplate;  
  end;

//*****************************************************************************
//End of specific dialogue box definition

//The rest of the program is for making a window
//*****************************************************************************

Function WindowProc(Window: hWnd; AMessage: UINT; WPrm: WParam; LPrm: LParam): LResult; stdcall; export;
Var nrmenu: longint; //ps: paintstruct; dc: hdc; r: rect;
begin WindowProc := 0;
  Case AMessage of
//    wm_Paint: begin
//      dc:=BeginPaint(Window,@ps);
//      EndPaint(Window,ps);
//      Exit;
//      end;
    wm_Close: ; //Lad DefWindowProc take care of close
    wm_Destroy: begin PostQuitMessage(0); exit end;
    wm_char: ;
    wm_Command: begin
      NrMenu := WPrm and $FFFF;
      Case NrMenu Of
        100: showbox(window);
        End; End; End;
  WindowProc := DefWindowProc(Window,AMessage,WPrm,LPrm); End;

//**************************************************************
Function WinRegister: Boolean;
var  WindowClass: WndClass;
Begin With WindowClass Do Begin
    Style := cs_hRedraw Or cs_vRedraw;
    lpfnWndProc := WndProc(@WindowProc);
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := system.MainInstance;
    hIcon := LoadIcon(0,idi_Application);
    hCursor := LoadCursor(0,idc_Arrow);
    hbrBackground := GetStockObject(LTGRAY_BRUSH);
    lpszMenuName := '';
    lpszClassName := AppName;
    End;
  WinRegister := RegisterClass(WindowClass)<>0;
  If not WinRegister then begin MessageBox(0,'Register failed',Nil, mb_Ok); exit end;
  end;

//**************************************************************
Function WinCreate: hWnd;
Var hWindow: hWnd;
    Menu: hMenu;
Begin
  hWindow := CreateWindow(AppName,AppName,ws_OverlappedWindow,
  cw_UseDefault,cw_UseDefault,cw_UseDefault,cw_UseDefault,0,0,system.MainInstance,Nil);
  If hWindow<>0 then begin
    Menu := CreateMenu;
    AppendMenu(Menu,MF_STRING,100,'&Show dialogbox for test');
    SetMenu(hWindow,Menu);
    ShowWindow(hWindow,CmdShow);
    ShowWindow(hWindow,SW_SHOW);
    UpdateWindow(hWindow);
    end;
  Wincreate := hWindow
  end;


//*************** Main program **********************************
Begin
  If not WinRegister then exit;
  hWindow := WinCreate;
  If longint(hWindow)=0 then begin MessageBox (0,'WinCreate failed',Nil,MB_OK); exit end;
  setboxtemplates;
  While GetMessage(@AMessage,0,0,0) do
  begin TranslateMessage(AMessage); DispatchMessage(AMessage) end;
  Halt(AMessage.wParam) End.