{************************************************}
{                                                }
{   Demo Program                                 }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

program WMenu;

{$R WMenu}

uses WinProcs, WinTypes;

type
  TList = array[1..99] of String[17];

const
  ListCount:Word = 0;

var
  UserMenu: hMenu;
  List: TList;
  ListCounter: Word;
  MenuName:String[17];
  Window: hWnd;

function AboutProc(Dlg: hWnd; iMessage, wParam: Word; lParam: LongInt): Bool; Export;
  begin
    AboutProc:=false;
    case iMessage of
      WM_Create: AboutProc:=true;
      WM_Command: if (wParam = IDOK) or (wParam = IDCancel) then
		    begin
		      AboutProc:=true;
		      EndDialog(Dlg, 0);
		    end;
    end;
  end;

function CreateProc(Dlg: hWnd; iMessage, wParam:Word; lParam: LongInt): WordBool; export;
  var
    Style: Word;
    Name: String[17];
    Found: Boolean;
    I: Integer;
    DC: hDC;
    R: TRect;
  begin
      CreateProc:=False;
      case iMessage of
	WM_InitDialog: CreateProc:=true;
	WM_Command: case wParam of
		      IDCancel: begin
				  EndDialog(Dlg, 0);
				  CreateProc:=true;
				end;
		      104: begin
			     Name[0]:=Char(GetWindowText(GetDlgItem(Dlg, 103), @Name[1], 16));
			     Found:=false;
			     for I:=1 to ListCount do
			       if Name=List[I] then
				 begin
				   Found:=true;
				   DeleteMenu(UserMenu, I+300, MF_ByCommand);
				 end;
			      if MenuName=Name then
				begin
				  MenuName:='';
				  GetClientRect(Window, R);
				  InvalidateRect(Window, @R, true);
				end;
			      if Not found then
				MessageBox(Dlg, 'Item Not Found', 'Error', MB_OK)
			      else
				EndDialog(Dlg, 0);
			   end;
		      IDOK: begin
			      if SendMessage(GetDlgItem(Dlg, 101), BM_GetCheck, 0,0)=0 then
				Style:=MF_UnChecked
			      else
				Style:=MF_Checked;
			      if SendMessage(GetDlgItem(Dlg, 102), BM_GetCheck, 0,0)=0 then
				Style:=Style or MF_Enabled
			      else
				Style:=Style or MF_Grayed;
			      Name[0]:=Char(GetWindowText(GetDlgItem(Dlg, 103), @Name[1], 16));
			      Inc(ListCount);
			      if ListCount>99 then
				begin
				  MessageBox(Dlg, 'Too many menus', 'Error', MB_OK);
				  Exit;
				end;
			      List[ListCount]:=Name;
			      AppendMenu(UserMenu, Style or MF_String, ListCount+300, @Name[1]);
			      EndDialog(Dlg, 0);
			      CreateProc:=true;
			    end;
		     end;
      end;

  end;

function WindowProc(Wnd: hWnd; iMessage, wParam:Word; lParam: LongInt): LongInt; export;
  var
    ProcInst: Pointer;
    DC: hDC;
    PaintStruct: TPaintStruct;
    R: TRect;
  begin
    case iMessage of
      WM_Command: case WParam of
		    100: begin
			   ProcInst:=MakeProcInstance(@CreateProc, hInstance);
			   DialogBox(hInstance, 'CreateDlg', Wnd, ProcInst);
			   FreeProcInstance(ProcInst);
			 end;
		    106: begin
			   ProcInst:=MakeProcInstance(@AboutProc, hInstance);
			   DialogBox(hInstance, 'About', Wnd, ProcInst);
			   FreeProcInstance(ProcInst);
			 end;
		    301..399: begin
				MenuName:=List[wParam-300];
				GetClientRect(Window, R);
				InvalidateRect(Window, @R, true);
			      end;

		  else
		    WindowProc:=DefWindowProc(Wnd, iMessage, wParam, lParam);
		  end;
      WM_Paint: begin
		  DC:=BeginPaint(Wnd, PaintStruct);
		  TextOut(DC, 0, 0, @MenuName[1], Length(MenuName));
		  EndPaint(Wnd, PaintStruct);
		end;
      WM_Destroy: PostQuitMessage(0);
    else
      WindowProc:=DefWindowProc(Wnd, iMessage, wParam, lParam);
    end;
  end;

procedure WinMain;
  var
    WndClas: TWndClass;
    Msg: TMsg;
  begin
    If hPrevInst = 0 then
      begin
	WndClas.Style := 0;
	WndClas.lpfnWndProc:= @WindowProc;
	WndClas.cbClsExtra := 0;
	WndClas.cbWndExtra := 0;
	WndClas.hInstance := HInstance;
	WndClas.hIcon := 0;
	WndClas.hCursor := LoadCursor(0, IDC_Arrow);
	WndClas.hbrBackground := GetStockObject(White_Brush);
	WndClas.lpszMenuName := 'Menu';
	WndClas.lpszClassName := 'GenWindow';
	if not RegisterClass(WndClas) then
	  Halt;
      end;
    Window := CreateWindow('GenWindow', 'Menu Example', WS_OverLappedWindow,
		     CW_UseDefault, 0, CW_UseDefault, 0, 0, 0, hInstance, nil);
    UpDateWindow(Window);
    UserMenu:=CreatePopUpMenu;
    InsertMenu(GetMenu(Window), 106, MF_ByCommand or MF_PopUp, UserMenu, 'User Define Menu');
    ShowWindow(Window,Sw_ShowNormal);
    while GetMessage(Msg, 0, 0, 0) do
      begin
	TranslateMessage(msg);
	DispatchMessage(msg);
      end;
  end;

begin
  WinMain;
end.