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