home *** CD-ROM | disk | FTP | other *** search
- {*-----------------------------------------------------------------
- * tutor.pas - My First PowerCode App
- * 4/22/92 - 6:28:35pm
- * John Doe
- *-----------------------------------------------------------------}
-
- program Tutor;
-
- uses WinTypes, WinProcs, WObjects, Jtools;
-
- const
- cm_MainApp = 500;
- cm_MainDialog = 501;
- cm_MainWindow = 502;
- cm_MainCheckBox = 503;
- cm_New = 1000;
- cm_Open = 1001;
- cm_Save = 1002;
- cm_Exit = 1003;
- cm_About = 1004;
- ID_LNAME = 100;
- ID_NAME = 101;
- ID_TITLE = 102;
- ID_CONAME = 103;
- ID_STREET1 = 104;
- ID_STREET2 = 105;
- ID_CITY = 106;
- ID_STATE = 107;
- ID_ZIP = 108;
- ID_BPHONE = 109;
- ID_HPHONE = 110;
- ID_FAX = 111;
- ID_COMMENTS = 112;
- ID_SEARCH = 113;
- ID_ADDTYPE = 114;
- ID_MALE = 115;
- ID_FEMALE = 116;
- ID_LIST = 117;
-
-
- type
- PMain = ^TMain;
- TMain = object(TWindow)
- constructor Init(AParent: PWindowsObject);
- procedure SetupWindow; virtual;
- procedure GetWindowClass(var AWndClass: TWndClass);virtual;
- function GetClassName: PChar;virtual;
- procedure MsgMainApp(var Msg: TMessage);
- virtual cm_First + cm_MainApp;
- procedure MsgMainDialog(var Msg: TMessage);
- virtual cm_First + cm_MainDialog;
- procedure MsgMainWindow(var Msg: TMessage);
- virtual cm_First + cm_MainWindow;
- procedure MsgNew(var Msg: TMessage);
- virtual cm_First + cm_New;
- procedure MsgOpen(var Msg: TMessage);
- virtual cm_First + cm_Open;
- procedure MsgSave(var Msg: TMessage);
- virtual cm_First + cm_Save;
- procedure MsgExit(var Msg: TMessage);
- virtual cm_First + cm_Exit;
- procedure MsgAbout(var Msg: TMessage);
- virtual cm_First + cm_About;
- end;
- type
- PNewWin = ^TNewWin;
- TNewWin = object(TWindow)
- constructor Init(AParent: PWindowsObject);
- procedure SetupWindow; virtual;
- procedure GetWindowClass(var AWndClass: TWndClass);virtual;
- function GetClassName: PChar;virtual;
- end;
- type
- PAbout = ^TAbout;
- TAbout = object(TDialog)
- WorkStr : array[0..80] of Char;
-
- constructor Init(AParent: PWindowsObject; AName : PChar);
- procedure SetupWindow; virtual;
- function CanClose: Boolean;virtual;
- procedure Cancel(var Msg: TMessage);
- virtual id_First + id_Cancel;
- end;
- type
- PAddress = ^TAddress;
- TAddress = object(TDialog)
- WorkStr : array[0..80] of Char;
- EdLname, EdName, EdTitle, EdConame, EdStreet1, EdStreet2, EdCity, EdState,
- EdZip, EdBphone, EdHphone, EdFax, EdComments : PEdit;
- RbMale, RbFemale : PRadioButton;
- CoAddtype : PComboBox;
-
- constructor Init(AParent: PWindowsObject; AName : PChar);
- procedure SetupWindow; virtual;
- function CanClose: Boolean;virtual;
- procedure Cancel(var Msg: TMessage);
- virtual id_First + id_Cancel;
- procedure MsgSearch(var Msg: TMessage);
- virtual id_First + ID_SEARCH;
- end;
- type
- PSearch = ^TSearch;
- TSearch = object(TDialog)
- WorkStr : array[0..80] of Char;
- LbList : PListBox;
-
- constructor Init(AParent: PWindowsObject; AName : PChar);
- procedure SetupWindow; virtual;
- function CanClose: Boolean;virtual;
- procedure Cancel(var Msg: TMessage);
- virtual id_First + id_Cancel;
- end;
-
- type
- TTutorApp = object(TApplication)
- procedure InitMainWindow; virtual;
- end;
-
- {*-----------------------------------------------------------------
- * Window Method implementations - Main
- *-----------------------------------------------------------------}
- constructor TMain.Init(AParent: PWindowsObject);
- var pTB : PToolBar;
- begin
- TWindow.Init(AParent, 'My First PowerCode App');
- Attr.Menu := LoadMenu(HInstance, 'Main');
- { Create ToolBar - This is a child window so OWL will delete }
- pTB := New(PToolBar, Init(@Self, 44));
- pTB^.AddToolItem(@Self, 'Button', CM_MAINAPP, -1, -1, 45, 45,
- 'NMainApp', 'SMainApp', 'Y', 'Y');
- pTB^.AddToolItem(@Self, 'Button', CM_MAINDIALOG, 43, -1, 45, 45,
- 'NMainDialog', 'SMainDialog', 'Y', 'Y');
- pTB^.AddToolItem(@Self, 'Button', CM_MAINWINDOW, 87, -1, 45, 45,
- 'NMainWindow', 'SMainWindow', 'Y', 'Y');
- pTB^.AddToolItem(@Self, 'Checkbox', CM_MAINCHECKBOX, 134, 2, 40, 40,
- 'NMainCheckBox', 'SMainCheckBox', 'N', 'N');
- end;
-
- {*-----------------------------------------------------------------
- * procedure TMain.GetWindowClass
- * Allows window class info to be modified (icon, color, etc.)
- *-----------------------------------------------------------------}
- procedure TMain.GetWindowClass(var AWndClass: TWndClass);
- begin
- TWindow.GetWindowClass(AWndClass); { Get the default class }
- AWndClass.hbrBackground := CreateSolidBrush(RGB(255,255,128));
- AWndClass.hIcon := LoadIcon(HInstance, 'Main');
- end;
-
- {*-----------------------------------------------------------------
- * function TMain.GetClassName
- * Returns a unique class name for the window class.
- *-----------------------------------------------------------------}
- function TMain.GetClassName: PChar;
- begin
- GetClassName := 'Main';
- end;
-
- {*-----------------------------------------------------------------
- * procedure TMain.SetupWindow
- * Setup all child windows and controls.
- * Perform any window setup operations requiring a window handle.
- *-----------------------------------------------------------------}
- procedure TMain.SetupWindow;
- begin
- TWindow.SetupWindow;
- end;
-
- {*-----------------------------------------------------------------
- * Window Response Methods - Main
- *-----------------------------------------------------------------}
- procedure TMain.MsgMainApp(var Msg: TMessage);
- begin
- WinExec('notepad.exe tutor.txt', SW_SHOW);
-
- end;
- procedure TMain.MsgMainDialog(var Msg: TMessage);
- var pDlg : PDialog;
- begin
- pDlg := New(PADDRESS, Init(@Self, 'ADDRESS'));
- Application^.MakeWindow(pDlg);
- pDlg^.Show(SW_SHOW);
-
- end;
- procedure TMain.MsgMainWindow(var Msg: TMessage);
- var pWin : PWindow;
- begin
- pWin := New(PNewWin, Init(@Self));
- Application^.MakeWindow(pWin);
- pWin^.Show(SW_SHOW);
-
- end;
- procedure TMain.MsgNew(var Msg: TMessage);
- var pWin : PWindow;
- begin
- pWin := New(PNewWin, Init(@Self));
- Application^.MakeWindow(pWin);
- pWin^.Show(SW_SHOW);
-
- end;
- procedure TMain.MsgOpen(var Msg: TMessage);
- begin
- MessageBox(HWindow, 'User Clicked on Item : &Open', 'Info',
- mb_Ok or mb_IconInformation);
-
- end;
- procedure TMain.MsgSave(var Msg: TMessage);
- begin
- MessageBox(HWindow, 'User Clicked on Item : &Save', 'Info',
- mb_Ok or mb_IconInformation);
-
- end;
- procedure TMain.MsgExit(var Msg: TMessage);
- begin
- MessageBox(HWindow, 'User Clicked on Item : &Exit', 'Info',
- mb_Ok or mb_IconInformation);
-
- end;
- procedure TMain.MsgAbout(var Msg: TMessage);
- var pDlg : PDialog;
- begin
- Application^.ExecDialog(New(PAbout, Init(@Self, 'ABOUT')));
-
- end;
- {*-----------------------------------------------------------------
- * Window Method implementations - NewWin
- *-----------------------------------------------------------------}
- constructor TNewWin.Init(AParent: PWindowsObject);
- begin
- TWindow.Init(AParent, '');
- Attr.Menu := LoadMenu(HInstance, '');
- Attr.Style := WS_OVERLAPPEDWINDOW or ws_Visible;
- end;
-
- {*-----------------------------------------------------------------
- * procedure TNewWin.GetWindowClass
- * Allows window class info to be modified (icon, color, etc.)
- *-----------------------------------------------------------------}
- procedure TNewWin.GetWindowClass(var AWndClass: TWndClass);
- begin
- TWindow.GetWindowClass(AWndClass); { Get the default class }
- end;
-
- {*-----------------------------------------------------------------
- * function TNewWin.GetClassName
- * Returns a unique class name for the window class.
- *-----------------------------------------------------------------}
- function TNewWin.GetClassName: PChar;
- begin
- GetClassName := 'NewWin';
- end;
-
- {*-----------------------------------------------------------------
- * procedure TNewWin.SetupWindow
- * Setup all child windows and controls.
- * Perform any window setup operations requiring a window handle.
- *-----------------------------------------------------------------}
- procedure TNewWin.SetupWindow;
- begin
- TWindow.SetupWindow;
- end;
-
- {*-----------------------------------------------------------------
- * Window Response Methods - NewWin
- *-----------------------------------------------------------------}
- {*-----------------------------------------------------------------
- * Dialog Method implementations - TAbout
- *-----------------------------------------------------------------}
- constructor TAbout.Init(AParent: PWindowsObject; AName :PChar);
- begin
- TDialog.Init(AParent, AName);
- end;
-
-
- {*-----------------------------------------------------------------
- * procedure TAbout.SetupWindow
- * Setup all child windows and controls.
- * Perform any window setup operations requiring a window handle.
- *-----------------------------------------------------------------}
- procedure TAbout.SetupWindow;
- begin
- TDialog.SetupWindow;
- end;
-
- {*-----------------------------------------------------------------
- * function TAbout.CanClose
- * Determine if dialog should be allowed to update
- *-----------------------------------------------------------------}
- function TAbout.CanClose : Boolean;
- var I : Word;
- begin
- CanClose := true;
- end;
- {*-----------------------------------------------------------------
- * procedure TAbout.Cancel
- * Overide Cancel method because TDialog incorrectly calls
- * CanClose on a Cancel
- *-----------------------------------------------------------------}
- procedure TAbout.Cancel(var Msg: TMessage);
- begin
- EndDlg(idcancel);
- end;
- {*-----------------------------------------------------------------
- * Dialog Response Methods - TAbout
- *-----------------------------------------------------------------}
- {*-----------------------------------------------------------------
- * Dialog Method implementations - TAddress
- *-----------------------------------------------------------------}
- constructor TAddress.Init(AParent: PWindowsObject; AName :PChar);
- begin
- TDialog.Init(AParent, AName);
- New(EdLname, InitResource(@Self, ID_LNAME, 30));
- New(EdName, InitResource(@Self, ID_NAME, 0));
- New(EdTitle, InitResource(@Self, ID_TITLE, 0));
- New(EdConame, InitResource(@Self, ID_CONAME, 0));
- New(EdStreet1, InitResource(@Self, ID_STREET1, 0));
- New(EdStreet2, InitResource(@Self, ID_STREET2, 0));
- New(EdCity, InitResource(@Self, ID_CITY, 0));
- New(EdState, InitResource(@Self, ID_STATE, 0));
- New(EdZip, InitResource(@Self, ID_ZIP, 0));
- New(EdBphone, InitResource(@Self, ID_BPHONE, 0));
- New(EdHphone, InitResource(@Self, ID_HPHONE, 0));
- New(EdFax, InitResource(@Self, ID_FAX, 0));
- New(EdComments, InitResource(@Self, ID_COMMENTS, 0));
- New(CoAddtype, InitResource(@Self, ID_ADDTYPE, 0));
- New(RbMale, InitResource(@Self, ID_MALE));
- New(RbFemale, InitResource(@Self, ID_FEMALE));
- end;
-
-
- {*-----------------------------------------------------------------
- * procedure TAddress.SetupWindow
- * Setup all child windows and controls.
- * Perform any window setup operations requiring a window handle.
- *-----------------------------------------------------------------}
- procedure TAddress.SetupWindow;
- begin
- TDialog.SetupWindow;
- RbFemale^.Check; { Set Initial Check }
- { Fill Combo with initial values }
- CoAddtype^.AddString('Employee');
- CoAddtype^.AddString('Vendor');
- CoAddtype^.AddString('Friend');
- CoAddtype^.AddString('Other');
- end;
-
- {*-----------------------------------------------------------------
- * function TAddress.CanClose
- * Determine if dialog should be allowed to update
- *-----------------------------------------------------------------}
- function TAddress.CanClose : Boolean;
- var I : Word;
- begin
- if EdLname^.GetText(WorkStr, 80) = 0 then
- begin
- MessageBox(HWindow, 'Mandatory field requires input.', 'Error',
- MB_OK or MB_ICONEXCLAMATION);
- SetFocus(EdLname^.HWindow); { Position cursor to error }
- CanClose := false;
- exit;
- end;
- CanClose := true;
- end;
- {*-----------------------------------------------------------------
- * procedure TAddress.Cancel
- * Overide Cancel method because TDialog incorrectly calls
- * CanClose on a Cancel
- *-----------------------------------------------------------------}
- procedure TAddress.Cancel(var Msg: TMessage);
- begin
- Done; { Delete modeless dialog box }
- end;
- {*-----------------------------------------------------------------
- * Dialog Response Methods - TAddress
- *-----------------------------------------------------------------}
- procedure TAddress.MsgSearch(var Msg: TMessage);
- var pDlg : PDialog;
- begin
- Application^.ExecDialog(New(PSearch, Init(@Self, 'SEARCH')));
-
- end;
- {*-----------------------------------------------------------------
- * Dialog Method implementations - TSearch
- *-----------------------------------------------------------------}
- constructor TSearch.Init(AParent: PWindowsObject; AName :PChar);
- begin
- TDialog.Init(AParent, AName);
- New(LbList, InitResource(@Self, ID_LIST));
- end;
-
-
- {*-----------------------------------------------------------------
- * procedure TSearch.SetupWindow
- * Setup all child windows and controls.
- * Perform any window setup operations requiring a window handle.
- *-----------------------------------------------------------------}
- procedure TSearch.SetupWindow;
- begin
- TDialog.SetupWindow;
- end;
-
- {*-----------------------------------------------------------------
- * function TSearch.CanClose
- * Determine if dialog should be allowed to update
- *-----------------------------------------------------------------}
- function TSearch.CanClose : Boolean;
- var I : Word;
- begin
- CanClose := true;
- end;
- {*-----------------------------------------------------------------
- * procedure TSearch.Cancel
- * Overide Cancel method because TDialog incorrectly calls
- * CanClose on a Cancel
- *-----------------------------------------------------------------}
- procedure TSearch.Cancel(var Msg: TMessage);
- begin
- EndDlg(idcancel);
- end;
- {*-----------------------------------------------------------------
- * Dialog Response Methods - TSearch
- *-----------------------------------------------------------------}
- {*-----------------------------------------------------------------
- * TTutorApp method implementations:
- *-----------------------------------------------------------------}
-
- procedure TTutorApp.InitMainWindow;
- begin
- MainWindow := New(PMain, Init(nil));
- end;
-
- {*-----------------------------------------------------------------
- * Main Program:
- *-----------------------------------------------------------------}
- var
- TutorApp: TTutorApp;
-
- begin
- TutorApp.Init('Tutor');
- TutorApp.Run;
- TutorApp.Done;
- end.
-