Turbo Toolbox/Turbo_Toolbox.iso/dtx9101/tpw/owner.pas

Pascal/Delphi Source File | 1991-10-11 | 6.4 KB | 215 lines

PROGRAM Owner;

{$R Owner}

USES WObjects, WinTypes, WinProcs, BWCC;

(* Beispielprogramm fⁿr Borland Windows Custom Controls und Menⁿspielereien *)
(* mit Turbo Pascal fⁿr Windows.                                            *)

CONST
  cm_About    = 100;
  cm_WinMsgBox= 101;
  cm_BorMsgBox= 102;
  cm_Haegar   = 103;
  cm_Hilfe    = 901;

  id_Munch     = 200;
  id_Boticelli = 201;
  id_EGAVGA    = 202;

  id_Punkt1    = 401;
  id_Punkt2    = 402;
  id_Punkt3    = 403;
  cm_Gray      = 404;
  cm_Check     = 405;
  cm_Disable   = 406;

TYPE
  PMyWindow = ^TMyWindow;
  TMyWindow = OBJECT (TWindow)
    Punkt1Grayed: BOOLEAN;
    Punkt2Checked: BOOLEAN;
    Punkt3Disabled: BOOLEAN;

    CONSTRUCTOR Init (AParent: PWindowsObject; ATitle: PChar);
    PROCEDURE SetupWindow; VIRTUAL;
    PROCEDURE GetWindowClass (VAR AWndClass: TWndClass); VIRTUAL;

    PROCEDURE About (VAR Msg: TMessage); VIRTUAL cm_First + cm_About;
    PROCEDURE WinMsgBox (VAR Msg: TMessage); VIRTUAL cm_First + cm_WinMsgBox;
    PROCEDURE BorMsgBox (VAR Msg: TMessage); VIRTUAL cm_First + cm_BorMsgBox;
    PROCEDURE Punkt3 (VAR Msg: TMessage); VIRTUAL cm_First + id_Punkt3;
    PROCEDURE ManipPunkt1 (VAR Msg: TMessage); VIRTUAL cm_First + cm_Gray;
    PROCEDURE ManipPunkt2 (VAR Msg: TMessage); VIRTUAL cm_First + cm_Check;
    PROCEDURE ManipPunkt3 (VAR Msg: TMessage); VIRTUAL cm_First + cm_Disable;

    PROCEDURE WMSysCommand (VAR Msg: TMessage); VIRTUAL wm_First + wm_SysCommand;
  END;

  PMyDialog = ^TMyDialog;
  TMyDialog = OBJECT (TDialog)
    PROCEDURE Munch (VAR Msg: TMessage); VIRTUAL id_First + id_Munch;
    PROCEDURE Boticelli (VAR Msg: TMessage); VIRTUAL id_First + id_Boticelli;
    PROCEDURE EGAVGA (VAR Msg: TMessage); VIRTUAL id_First + id_EGAVGA;
  END;

  TMyApplication = OBJECT (TApplication)
    PROCEDURE InitMainWindow; VIRTUAL;
  END;

VAR
  NewBitmap: HBitmap;
  GenericApp: TMyApplication;

(************************************ TMyWindow *******************************)

(* Methoden zum Aufbau des Applikationsfensters *)

CONSTRUCTOR TMyWindow.Init (AParent: PWindowsObject; ATitle: PChar);
BEGIN
  TWindow.Init (AParent, ATitle);
  Attr.Menu := LoadMenu(HInstance, 'OwnerMenu');
  Punkt1Grayed := FALSE;
  Punkt2Checked := FALSE;
  Punkt3Disabled := FALSE;
END;

PROCEDURE TMyWindow.SetupWindow;
VAR
  MyMenu: HMenu;
BEGIN
  TWindow.SetupWindow;
  AppendMenu (GetSystemMenu (HWindow, FALSE), mf_Separator, 0, NIL);
  AppendMenu (GetSystemMenu (HWindow, FALSE), mf_String, cm_About, '▄ber dieses Programm...');
  NewBitmap := LoadBitmap (HInstance, 'Haegar4');
  MyMenu := GetMenu (HWindow);
  ModifyMenu (MyMenu, cm_Haegar, mf_ByCommand OR mf_Bitmap, cm_Haegar, PChar(NewBitmap));
END;

PROCEDURE TMyWindow.GetWindowClass (VAR AWndClass: TWndClass);
BEGIN
  TWindow.GetWindowClass (AWndClass);
  AWndClass.hIcon := LoadIcon (HInstance, 'MYICON');
END;

(* Antwortmethode fⁿr Menⁿoption im Menⁿ "Dialogfenster und mehr..." *)

PROCEDURE TMyWindow.About (VAR Msg: TMessage);
VAR Dialog: TMyDialog;
BEGIN
  Dialog.Init(@Self, 'OwnerDraw');
  Dialog.Execute;
  Dialog.Done;
END;

(* Antwortmethoden fⁿr Menⁿoptionen im Menⁿ "Mitteilungsfenster" *)

PROCEDURE TMyWindow.WinMsgBox (VAR Msg: TMessage);
BEGIN
  MessageBeep(0);
  MessageBox (HWindow,
    'Die MessageBox im Windows Stil',
    'MessageBox',
    mb_YesNoCancel);
END;

PROCEDURE TMyWindow.BorMsgBox (VAR Msg: TMessage);
BEGIN
  BWCCMessageBox (HWindow,
    'Die MessageBox im Borland-Stil mit der Unit BWCC.PAS',
    'MessageBox',
    mb_YesNoCancel);
END;

(* Antwortmethoden fⁿr Menⁿoptionen im Menⁿ "Menⁿmanipulationen" *)

PROCEDURE TMyWindow.Punkt3 (VAR Msg: TMessage);
BEGIN
  MessageBeep(0);
END;

PROCEDURE TMyWindow.WMSysCommand (VAR Msg: TMessage);
BEGIN
  CASE Msg.wParam OF
    cm_About: About(Msg);
    ELSE DefWndProc(Msg);
  END;
END;

PROCEDURE TMyWindow.ManipPunkt1 (VAR Msg: TMessage);
BEGIN
  IF Punkt1Grayed
    THEN BEGIN
      EnableMenuItem(GetMenu(HWindow), id_Punkt1, mf_ByCommand OR mf_Enabled);
      ModifyMenu(GetMenu(HWindow), cm_Gray, mf_ByCommand OR mf_String, cm_Gray, 'Punkt 1 grau darstellen');
    END
    ELSE BEGIN
      EnableMenuItem(GetMenu(HWindow), id_Punkt1, mf_ByCommand OR mf_Enabled OR mf_Grayed);
      ModifyMenu(GetMenu(HWindow), cm_Gray, mf_ByCommand OR mf_String, cm_Gray, 'Punkt 1 normal darstellen');
    END;
  Punkt1Grayed := NOT Punkt1Grayed;
END;

PROCEDURE TMyWindow.ManipPunkt2 (VAR Msg: TMessage);
BEGIN
  IF Punkt2Checked
    THEN BEGIN
      CheckMenuItem(GetMenu(HWindow), id_Punkt2, mf_UnChecked);
      ModifyMenu (GetMenu(HWindow), cm_Check, mf_ByCommand OR mf_String, cm_Check, 'Punkt 2 mit HΣkchen');
    END
    ELSE BEGIN
      CheckMenuItem(GetMenu(HWindow), id_Punkt2, mf_Checked);
      ModifyMenu (GetMenu(HWindow), cm_Check, mf_ByCommand OR mf_String, cm_Check, 'Punkt 2 ohne HΣkchen');
    END;
  Punkt2Checked := NOT Punkt2Checked;
END;

PROCEDURE TMyWindow.ManipPunkt3 (VAR Msg: TMessage);
BEGIN
  IF Punkt3Disabled
    THEN BEGIN
      EnableMenuItem(GetMenu(HWindow), id_Punkt3, mf_ByCommand OR mf_Enabled);
      ModifyMenu(GetMenu(HWindow), cm_Disable, mf_ByCommand OR mf_String, cm_Disable, 'Punkt 3 abschalten');
    END
    ELSE BEGIN
      EnableMenuItem(GetMenu(HWindow), id_Punkt3, mf_ByCommand OR mf_Disabled);
      ModifyMenu(GetMenu(HWindow), cm_Disable, mf_ByCommand OR mf_String, cm_Disable, 'Punkt 3 anschalten');
    END;
  Punkt3Disabled := NOT Punkt3Disabled;
END;

(************************************ TMyDialog *******************************)
(* Diese Methoden werden im Dialogfenster ben÷tigt, das durch die Option      *)
(* "Borland Dialogfenster" im Untermenⁿ "Dialogfenster und mehr..."           *)
(* aufgerufen wird.                                                           *)

PROCEDURE TMyDialog.Munch (VAR Msg: TMessage);
BEGIN
  Cancel(Msg);
END;

PROCEDURE TMyDialog.Boticelli (VAR Msg: TMessage);
BEGIN
  MessageBeep(0);
END;

PROCEDURE TMyDialog.EGAVGA (VAR Msg: TMessage);
BEGIN
  MessageBeep(0);
END;

(************************************ TMyApplication **************************)

PROCEDURE TMyApplication.InitMainWindow;
BEGIn
  MainWindow := New (PMyWindow, Init(NIL, 'Beispielprogramm Borland-Style Custom Controls'));
END;

(************************************ Hauptprogramm ***************************)

BEGIN
  GenericApp.Init ('GenericApp');
  GenericApp.Run;
  GenericApp.Done;
END.