home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol11n19.zip / TEST1.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-27  |  2KB  |  79 lines
  1. {
  2. TITLE    :  TEST1.PAS
  3. Caption    :  A small TPW program to display the normal and modified Font dialogs.  
  4. }
  5.  
  6. program Test1;
  7.  
  8. {$R Test1}
  9.  
  10. uses wintypes, winprocs, wobjects, commdlg;
  11.  
  12. type
  13.  
  14.   TMyApp = object(TApplication)
  15.     procedure InitMainWindow; virtual;
  16.   end;
  17.  
  18.   PMyMainWindow = ^TMyMainWindow;
  19.   TMyMainWindow = object(TMDIWindow)
  20.     procedure cmChooseFont1(var Msg: TMessage); virtual cm_First + 101;
  21.     procedure cmChooseFont2(var Msg: TMessage); virtual cm_First + 102;
  22.   end;
  23.  
  24. procedure TMyMainWindow.cmChooseFont1(var Msg: TMessage);
  25. var
  26.   CF: TChooseFont;
  27.   LF: TLogFont;
  28.   FStyle: array [0..LF_FaceSize] of char;
  29. begin
  30.   FillChar(CF, Sizeof(CF), #0);
  31.   FillChar(LF, Sizeof(LF), #0);
  32.   FStyle[0] := #0;
  33.   with CF do
  34.   begin
  35.     lStructSize := SizeOf(CF);
  36.     HWndOwner := HWindow;
  37.     lpLogFont := @LF;
  38.     Flags := cf_TTOnly or cf_ScreenFonts;
  39.     lpszStyle := @FStyle;
  40.   end;
  41.  
  42.   ChooseFont(CF);
  43. end;
  44.  
  45. procedure TMyMainWindow.cmChooseFont2(var Msg: TMessage);
  46. var
  47.   CF: TChooseFont;
  48.   LF: TLogFont;
  49.   FStyle: array [0..LF_FaceSize] of char;
  50. begin
  51.   FillChar(CF, Sizeof(CF), #0);
  52.   FillChar(LF, Sizeof(LF), #0);
  53.   FStyle[0] := #0;
  54.   with CF do
  55.   begin
  56.     lStructSize := SizeOf(CF);
  57.     HWndOwner := HWindow;
  58.     lpLogFont := @LF;
  59.     Flags := cf_TTOnly or cf_ScreenFonts or cf_EnableTemplate;
  60.     lpTemplateName := 'MyFontDlg';
  61.     CF.HInstance := System.HInstance; 
  62.     lpszStyle := @FStyle;
  63.   end;
  64.  
  65.   ChooseFont(CF);
  66. end;
  67.  
  68. procedure TMyApp.InitMainWindow;
  69. begin
  70.   MainWindow := new(PMyMainWindow, Init('Test CommDlg',
  71.                      LoadMenu(HInstance, 'MainMenu')));
  72. end;
  73.  
  74. var MyApp: TMyApp;
  75. begin
  76.   MyApp.Init('TestCommDlg');
  77.   MyApp.Run;
  78.   MyApp.Done;
  79. end.