home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / CTRL3D.ZIP / DEMO3D.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-02  |  3KB  |  135 lines
  1.  
  2. program DEMO3D;
  3.  
  4. uses
  5.     Strings,Wintypes,Winprocs,
  6.     Objects, OWindows, ODialogs, OStdDlgs,Bwcc,
  7.     Ctrl3D;
  8.  
  9. {$R demo3d.Res}
  10. {$I demo3d.inc}
  11.  
  12. type
  13.     P3DApplication=^T3DApplication;
  14.     T3DApplication=
  15.         object(TApplication)
  16.  
  17.             procedure InitMainWindow; virtual;
  18.         end;
  19.  
  20.     P3DWindow=^T3DWindow;
  21.     T3DWindow=
  22.         object(TDialog)
  23.  
  24.             constructor Init;
  25.             procedure SetupWindow; virtual;
  26.             procedure wmCtlColor(var Msg:TMessage); virtual wm_First+wm_CtlColor;
  27.         end;
  28.  
  29.     PMainWindow=^TMainWindow;
  30.     TMainWindow=
  31.         object(TWindow)
  32.  
  33.             constructor Init;
  34.             procedure miShowDialog(var Msg:TMessage); virtual cm_First+mi_ShowDialog;
  35.             procedure miExit(var Msg:TMessage); virtual cm_First+mi_Exit;
  36.         end;
  37.  
  38. var
  39.     App:T3DApplication;
  40.  
  41. procedure CenterWindow(hWindow: HWnd);
  42. var
  43.   R: TRect;
  44.   StartX,
  45.   StartY : Integer;
  46.   Frame,
  47.   Caption: Integer;
  48.  
  49. begin
  50.   Frame := GetSystemMetrics(sm_CxFrame) * 2;
  51.   Caption := GetSystemMetrics(sm_CyCaption);
  52.   GetClientRect(HWindow, R);
  53.   StartX := ((GetSystemMetrics(sm_CxScreen) - (R.Right - R.Left)) div 2);
  54.   StartY := ((GetSystemMetrics(sm_CyScreen) - (R.Bottom - R.Top)) div 2);
  55.   MoveWindow(HWindow, StartX, StartY - ((Caption + Frame) div 2),
  56.      R.Right + Frame, R.Bottom + Frame + Caption, False);
  57. end;
  58.  
  59.  
  60. procedure T3DApplication.InitMainWindow;
  61. begin
  62.     MainWindow:=New(PMainWindow,Init);
  63. end;
  64.  
  65. constructor T3DWindow.Init;
  66. var
  67.     CP:PControl;
  68.  
  69. begin
  70.     inherited Init(App.MainWindow,PChar(dlg_3DTest));
  71.     CP := New(PEdit3D, InitResource(@Self, id_3DTest1,25));
  72.     CP:=New(PComboBox3D,InitResource(@Self,cb_3DTest2,25));
  73.     CP:=New(PListBox3D,InitResource(@Self,lst_3DTest3));
  74. end;
  75.  
  76. procedure T3DWindow.SetupWindow;
  77. var
  78.     DC:HDC;
  79.  
  80. begin
  81.     inherited SetupWindow;
  82.     CenterWindow(hWindow);
  83. end;
  84.  
  85. procedure T3DWindow.wmCtlColor(var Msg:TMessage);
  86. begin
  87.     case Msg.lParamHi of
  88.         ctlcolor_ListBox:
  89.             begin
  90.                 SetTextColor(Msg.wParam,RGB(0,0,0));
  91.                 SetBkColor(Msg.wParam,RGB(255,255,255));
  92.                 Msg.Result:=GetStockObject(WHITE_BRUSH);
  93.             end;
  94.  
  95.         else
  96.             DefWndProc(Msg);
  97.     end;
  98. end;
  99.  
  100. constructor TMainWindow.Init;
  101. var
  102.     width,height:integer;
  103.  
  104. begin
  105.     inherited Init(nil,'3D Demo');
  106.     width:=GetSystemMetrics(sm_cxScreen);
  107.     height:=GetSystemMetrics(sm_cyScreen);
  108.  
  109.     with Attr do
  110.     begin
  111.         X:=width div 10;
  112.         Y:=(height div 5);
  113.         H:=(height div 5)*3;
  114.         W:=(width div 5)*4;
  115.         Style:=ws_SizeBox+ws_SysMenu+ws_MinimizeBox+ws_MaximizeBox;
  116.         Menu:=LoadMenu(hInstance,MakeIntResource(mnu_MainMenu));
  117.     end;
  118. end;
  119.  
  120. procedure TMainWindow.miShowDialog(var Msg:TMessage);
  121. begin
  122.     App.ExecDialog(New(P3DWindow,Init));
  123. end;
  124.  
  125. procedure TMainWindow.miExit(var Msg:TMessage);
  126. begin
  127.     CloseWindow;
  128. end;
  129.  
  130.  
  131. begin
  132.     App.Init('3D Test');
  133.     App.Run;
  134.     App.Done;
  135. end.