home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / SUBCTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  3.3 KB  |  116 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program SubClassTest;
  9.  
  10. {$R DIALTEST.RES}
  11.  
  12. uses WinTypes, WinProcs, Strings, OWindows, ODialogs;
  13.  
  14. const
  15.   TheMenu     = 100;
  16.   id_BeepBN   = 102;
  17.   id_Stat     = 104;
  18.   cm_DialTest = 101;
  19.  
  20. type
  21.  
  22.   {--------------------------------------------------}
  23.   { Define a button object type for association      }
  24.   {--------------------------------------------------}
  25.   PTestSCButton = ^TTestSCButton;
  26.   TTestSCButton = object(TButton)
  27.     procedure WMLButtonDown(var Msg: TMessage);
  28.       virtual wm_First + wm_LButtonDown;
  29.   end;
  30.  
  31.   PTestDialog = ^TTestDialog;
  32.   TTestDialog = object(TDialog)
  33.     NumClicks: Integer;
  34.     GButton: PTestSCButton;
  35.     constructor Init(AParent: PWindowsObject; AName: PChar);
  36.     procedure IDBeepBN(var Msg: TMessage); virtual id_First + id_BeepBN;
  37.   end;
  38.  
  39.   PTestWindow = ^TTestWindow;
  40.   TTestWindow = object(TWindow)
  41.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  42.     procedure CMDialTest(var Msg: TMessage); virtual cm_First + cm_DialTest;
  43.   end;
  44.  
  45.   TDlgApplication = object(TApplication)
  46.     procedure InitMainWindow; virtual;
  47.   end;
  48.  
  49. {--------------------------------------------------}
  50. { TTestDialog method implementations:              }
  51. {--------------------------------------------------}
  52.  
  53. constructor TTestDialog.Init(AParent: PWindowsObject; AName: PChar);
  54. begin
  55.   inherited Init(AParent, AName);
  56.   GButton := New(PTestSCButton, InitResource(@Self, id_BeepBN));
  57.   NumClicks := 0;
  58. end;
  59.  
  60. procedure TTestDialog.IDBeepBN(var Msg: TMessage);
  61. var
  62.   Text : array[0..3] of Char;
  63. begin
  64.   Inc(NumClicks);
  65.   Str(NumClicks, Text);
  66.   SetWindowText(GetItemHandle(id_Stat), @Text);
  67. end;
  68.  
  69. {--------------------------------------------------}
  70. { TTestWindow method implementations:              }
  71. {--------------------------------------------------}
  72.  
  73. constructor TTestWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  74. begin
  75.   TWindow.Init(AParent, ATitle);
  76.   Attr.Menu := LoadMenu(HInstance, MakeIntResource(TheMenu));
  77. end;
  78.  
  79. procedure TTestWindow.CMDialTest(var Msg: TMessage);
  80. var
  81.   TestDlg: PTestDialog;
  82. begin
  83.   Application^.ExecDialog(New(PTestDialog, Init(@Self, 'SUBCLASS_DLG')));
  84. end;
  85.  
  86. {--------------------------------------------------}
  87. { TTestSCButton method implementations:            }
  88. {--------------------------------------------------}
  89.  
  90. procedure TTestSCButton.WMLButtonDown(var Msg: TMessage);
  91. begin
  92.   MessageBeep(0);
  93.   DefWndProc(Msg);
  94. end;
  95.  
  96. {--------------------------------------------------}
  97. { TDlgApplication method implementations:          }
  98. {--------------------------------------------------}
  99.  
  100. procedure TDlgApplication.InitMainWindow;
  101. begin
  102.   MainWindow := New(PTestWindow, Init(nil, 'SubClass Tester'));
  103. end;
  104.  
  105. {--------------------------------------------------}
  106. { Main program:                                    }
  107. {--------------------------------------------------}
  108.  
  109. var
  110.   MyApp: TDlgApplication;
  111. begin
  112.   MyApp.Init('SubClassTest');
  113.   MyApp.Run;
  114.   MyApp.Done;
  115. end.
  116.