home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / paradox / rolodex.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-07  |  21.3 KB  |  735 lines
  1. PROGRAM Rolodex;
  2.  
  3. {$R Rolodex}
  4. {$D Rolodex}
  5.  
  6. USES WinTypes, WinProcs, ODialogs, OWindows, WinDos, Strings, 
  7.      PXEngine, OStdDlgs, BWCC;
  8.  
  9. CONST
  10.   cm_OpenTable     = 101;
  11.   cm_CloseTable    = 102;
  12.   cm_DeleteTable   = 103;
  13.   cm_NewerIndizes  = 104;
  14.   cm_About         = 105;
  15.  
  16.   id_Edit1         = 200;
  17.   id_Check1        = 300;
  18.   id_Stat1         = 400;
  19.  
  20.   id_SaveNew       = 500;
  21.   id_SaveUpdate    = 501;
  22.   id_ClearButton   = 502;
  23.   id_NextRec       = 503;
  24.   id_PrevRec       = 504;
  25.   id_FindRec       = 505;
  26.   id_LastRec       = 506;
  27.   id_FirstRec      = 507;
  28.   id_Delete        = 508;
  29.   id_Show          = 509;
  30.  
  31.   TextLen          = 50;
  32.  
  33. TYPE
  34.   tState = (On, Off);
  35.   ControlText = ARRAY[0..TextLen - 1] OF CHAR;
  36.   FieldText = ARRAY[0..20] OF CHAR;
  37.  
  38.   TransferRecType = RECORD
  39.     Checks : ARRAY[1..6] OF WORD;
  40.     StatFields: ARRAY[1..6] OF ControlText;
  41.     EditFields: ARRAY[1..6] OF ControlText;
  42.   END;
  43.  
  44.   tMyApp = OBJECT(tApplication)
  45.     PROCEDURE InitMainWindow;  VIRTUAL;
  46.   END;
  47.  
  48.   pMyMainWin = ^tMyMainWin;
  49.   tMyMainWin = OBJECT(tWindow)
  50.     CONSTRUCTOR Init(aParent: pWindowsObject; aTitle: pChar);
  51.     DESTRUCTOR Done; VIRTUAL;
  52.     PROCEDURE GetWindowClass(VAR aWndClass: tWndClass);  VIRTUAL;
  53.     PROCEDURE SetupWindow;  VIRTUAL;
  54.     PROCEDURE Paint(PaintDC: hDC; VAR PaintInfo: tPaintStruct); VIRTUAL;
  55.     PROCEDURE WMMinMaxInfo(VAR Msg: tMessage);
  56.               VIRTUAL wm_First + wm_GetMinMaxInfo;
  57.     PROCEDURE cmOpenTable(VAR Msg: tMessage); VIRTUAL cm_First + cm_OpenTable;
  58.     PROCEDURE cmCloseTable(VAR Msg: tMessage);
  59.               VIRTUAL cm_First + cm_CloseTable;
  60.     PROCEDURE cmDeleteTable(VAR Msg: tMessage);
  61.                VIRTUAL cm_First + cm_DeleteTable;
  62.     PROCEDURE cmNewerIndis (VAR Msg: tMessage);
  63.                VIRTUAL cm_First + cm_NewerIndizes;
  64.     PROCEDURE cmAbout(VAR Msg: tMessage); VIRTUAL cm_First + cm_About;
  65.     PROCEDURE cmSaveUpdate(VAR Msg: tMessage);
  66.               VIRTUAL id_First + id_SaveUpdate;
  67.     PROCEDURE cmSaveNew(VAR Msg: tMessage); VIRTUAL id_First + id_SaveNew;
  68.     PROCEDURE cmClear(VAR Msg: tMessage); VIRTUAL id_First + id_ClearButton;
  69.     PROCEDURE cmNext(VAR Msg: tMessage); VIRTUAL id_First + id_NextRec;
  70.     PROCEDURE cmPrev(VAR Msg: tMessage); VIRTUAL id_First + id_PrevRec;
  71.     PROCEDURE cmFind(VAR Msg: tMessage); VIRTUAL id_First + id_FindRec;
  72.     PROCEDURE cmFirstRec(VAR Msg: tMessage); VIRTUAL id_First + id_FirstRec;
  73.     PROCEDURE cmLastRec(VAR Msg: tMessage); VIRTUAL id_First + id_LastRec;
  74.     PROCEDURE cmDelete(VAR Msg: tMessage); VIRTUAL id_First + id_Delete;
  75.     PROCEDURE cmShow(VAR Msg: tMessage); VIRTUAL id_First + id_Show;
  76.   END;
  77.  
  78.   pMyButton = ^tMyButton;
  79.   tMyButton = OBJECT(tButton)
  80.     FUNCTION GetClassName : pChar; VIRTUAL;
  81.   END;
  82.  
  83.   pMyRadBut = ^tMyRadBut;
  84.   tMyRadBut = OBJECT(tRadioButton)
  85.     FUNCTION GetClassName : pChar; VIRTUAL;
  86.     PROCEDURE bnClicked(VAR Msg: tMessage); VIRTUAL nf_First + bn_Clicked;
  87.   END;
  88.  
  89. CONST
  90.   NFields = 6;
  91.   FieldNames : ARRAY[1..NFields] OF FieldText = ('Nachname', 'Vorname',
  92.       'Stra▀e / Platz', 'Wohnort', 'Telefon', 'Datum des Eintrags');
  93.   Fields: ARRAY[1..NFields] OF pChar =
  94.      (FieldNames[1], FieldNames[2], FieldNames[3], FieldNames[4],
  95.      FieldNames[5], FieldNames[6]);
  96.   Types: ARRAY[1..NFields] OF pChar =
  97.      ('A25', 'A25', 'A50', 'A50', 'A25', 'D');
  98.  
  99. VAR
  100.   MyApp              : tMyApp;
  101.   TblName            : pChar;
  102.   RecHandle1         : RecordHandle;
  103.   TableHandle1       : TableHandle;
  104.   TransRec           : TransferRecType;
  105.   InputError, NewRec : Bool;
  106.   CurrentIndex       : INTEGER;
  107.  
  108. {***********************}
  109. {*** Hilfsfunktionen ***}
  110. {***********************}
  111.  
  112. {* Der Fehlermelder *}
  113. FUNCTION PX(Error: INTEGER; S: STRING): INTEGER;
  114. BEGIN
  115.   PX := PXSuccess;
  116.   IF Error <> PXSuccess THEN
  117.   BEGIN
  118.     S:= S + #0;
  119.     BWCCMessageBox(Application^.MainWindow^.hWindow, PXErrMsg(Error),
  120.           @S[1], mb_IconExclamation);
  121.     PX := Error;
  122.   END;
  123. END;
  124.  
  125. {* Setzt Buttons inaktiv (Disable) oder aktiv (Enabled) *}
  126. PROCEDURE ChangeButtons(State:tState);
  127. VAR Fenster : hWnd;
  128.     I : INTEGER;
  129. BEGIN
  130.   FOR I := id_SaveNew TO id_Show DO
  131.   BEGIN
  132.     Fenster := GetDlgItem(Application^.MainWindow^.hWindow,I);
  133.     IF State = Off
  134.       THEN SetWindowLong(Fenster,gwl_Style,
  135.             GetWindowLong(Fenster,gwl_Style) OR ws_Disabled)
  136.       ELSE SetWindowLong(Fenster,gwl_Style,
  137.             GetWindowLong(Fenster,gwl_Style) XOR ws_Disabled);
  138.   END;
  139.   InvalidateRect(Application^.MainWindow^.hWindow,NIL,FALSE);
  140. END;
  141.  
  142. {* Initialisiert die Engine und so ... *}
  143. PROCEDURE InitEngine;
  144. VAR
  145.   NRecs: LongInt;
  146.   HMyMenu : hMenu;
  147. BEGIN
  148.   TblName := NIL;
  149.   GetMem(TblName,128);
  150.   PXSetDefaults(48, 10, 10, 32, 10, SortOrderInt);
  151.   PX(PXWinInit('MyApp', pxExclusive), 'PXWinInit');
  152.   HMyMenu := GetMenu(Application^.MainWindow^.hWindow);
  153.   EnableMenuItem(HMyMenu, cm_CloseTable,
  154.          mf_Disabled OR mf_ByCommand OR mf_Grayed);
  155.   EnableMenuItem(HMyMenu, cm_DeleteTable,
  156.          mf_Disabled OR mf_ByCommand OR mf_Grayed);
  157.   EnableMenuItem(HMyMenu, cm_NewerIndizes,
  158.          mf_Disabled OR mf_ByCommand OR mf_Grayed);
  159.   CurrentIndex := 1;
  160.   ChangeButtons(Off);
  161.   SetFocus(Application^.MainWindow^.ChildWithId(id_Edit1)^.hWindow);
  162. END;
  163.  
  164. {* Liest ein alphanumerisches Feld aus dem Transferbuffer *}
  165. PROCEDURE GetAlphaField(Ar: pChar; Fld: INTEGER);
  166. VAR
  167.   S: ARRAY[0..50] OF CHAR;
  168. BEGIN
  169.   IF (PX(PXGetAlpha(RecHandle1, Fld, 49, S), 'PXGetAlpha') = PXSuccess)
  170.     THEN StrCopy(Ar, S);
  171. END;
  172.  
  173. {* Schreibt ein alphanumerisches Feld in den Transferbuffer *}
  174. PROCEDURE PutAlphaField(Ar: pChar; Fld: INTEGER);
  175. BEGIN
  176.   PX(PXPutAlpha(RecHandle1, Fld, Ar), 'PXPutAlpha');
  177. END;
  178.  
  179. {* Liest das Datumsfeld Feld aus dem Transferbuffer *}
  180. PROCEDURE GetDateField(Ar: pChar; Fld: INTEGER);
  181. VAR
  182.   Long: LongInt;
  183.   MO, DA, YR: INTEGER;
  184.   T : ARRAY[0..6] OF CHAR;
  185. BEGIN
  186.   IF (PX(PXGetDate(RecHandle1, Fld, Long), 'PXGetDate') = PXSuccess) THEN
  187.   BEGIN
  188.     PX(PXDateDecode(Long, MO, DA, YR), 'PXDateDecode');
  189.     Str(DA, T);
  190.     StrCopy(Ar, T);
  191.     StrCat(Ar,'.');
  192.     Str(MO, T);
  193.     StrCat(Ar, T);
  194.     StrCat(Ar,'.');
  195.     Str(YR, T);
  196.     StrCat(Ar, T);
  197.   END;
  198. END;
  199.  
  200. {* Schreibt das Datumsfeld Feld in den Transferbuffer *}
  201. PROCEDURE PutDateField(Ar: pChar; Fld: INTEGER);
  202. VAR
  203.   Code, Count1, Count2, MO, DA, YR: INTEGER;
  204.   Long: LongInt;
  205.   S: STRING[15];
  206.   T: STRING[6];
  207. BEGIN
  208.   S:= StrPas(Ar);
  209.   IF Length(S) > 0 THEN
  210.   BEGIN
  211.     Count2:= 1;
  212.     Count1:= 1;
  213.     REPEAT
  214.       T[Count1] := S[Count2];
  215.       T[0]:= Chr(Count1);
  216.       Inc(Count1);
  217.       Inc(Count2);
  218.       IF Count2 > Length(S)
  219.     THEN InputError := TRUE;
  220.     UNTIL (S[Count2] = '.') OR (Count2 > Length(S));
  221.     Val(T, DA, Code);
  222.     IF (Code <> 0) OR (DA > 31) OR (DA < 1)
  223.       THEN InputError := TRUE;
  224.     Inc(Count2);
  225.     Count1:= 1;
  226.     REPEAT
  227.       T[Count1] := S[Count2];
  228.       T[0]:= Chr(Count1);
  229.       Inc(Count1);
  230.       Inc(Count2);
  231.       IF Count2 > Length(S)
  232.     THEN InputError := TRUE;
  233.     UNTIL (S[Count2] = '.') OR (Count2 > Length(S));
  234.     Val(T, MO, Code);
  235.     IF (Code <> 0) OR (MO > 12) OR (DA < 1)
  236.       THEN InputError := TRUE;
  237.     Inc(Count2);
  238.     Count1:= 1;
  239.     REPEAT
  240.       T[Count1] := S[Count2];
  241.       T[0]:= Chr(Count1);
  242.       Inc(Count1);
  243.       Inc(Count2);
  244.     UNTIL Count2 > Length(S);
  245.     Val(T, YR, Code);
  246.     IF (Code <> 0) OR (YR > 9999) OR (YR < 0)
  247.       THEN InputError := TRUE;
  248.   END
  249.   ELSE GetDate(WORD(YR),WORD(MO),WORD(DA),WORD(Code));
  250.   IF NOT(InputError) THEN
  251.   BEGIN
  252.     PX(PXDateEncode(MO, DA, YR, Long), 'PXDateDecode');
  253.     PX(PXPutDate(RecHandle1, Fld, Long), 'PXPutDate');
  254.   END;
  255. END;
  256.  
  257. {* ▄berprⁿft, welcher Radiobutton (= Index) angeklickt ist *}
  258. FUNCTION GetTblHandleChecked: INTEGER;
  259. VAR
  260.   Count : INTEGER;
  261.   Done  : BOOLEAN;
  262. BEGIN
  263.   Count := 0;
  264.   Done  := FALSE;
  265.   Application^.MainWindow^.TransferData(tf_GetData);
  266.   REPEAT
  267.     Inc(Count);
  268.     IF Count > NFields
  269.       THEN Done := TRUE
  270.       ELSE IF TransRec.Checks[Count] = 1
  271.          THEN Done := TRUE;
  272.   UNTIL Done;
  273.   GetTblHandleChecked := Count;
  274. END;
  275.  
  276. {* Leert alle Eingabefelder im Record *}
  277. PROCEDURE AssignDefaults;
  278. VAR
  279.   Count : INTEGER;
  280. BEGIN
  281.   FOR Count := 1 TO NFields DO
  282.   BEGIN
  283.     StrCopy(TransRec.StatFields[Count], FieldNames[Count]);
  284.     TransRec.EditFields[Count][0] := #0;
  285.   END;
  286. END;
  287.  
  288. {* Liest alle Werte aus dem Tranferbuffer und stellt sie dar *}
  289. PROCEDURE ShowData;
  290. VAR
  291.   PXErr, Count : INTEGER;
  292.   NFlds : LongInt;
  293. BEGIN
  294.   PX(PXRecGet(TableHandle1, RecHandle1), 'PXRecGet');
  295.   FOR Count := 1 TO 5 DO
  296.     GetAlphaField(TransRec.EditFields[Count], Count);
  297.   GetDateField(TransRec.EditFields[6], 6);
  298.   NewRec := FALSE;
  299.   Application^.MainWindow^.TransferData(tf_SetData);
  300. END;
  301.  
  302. {***************************************}
  303. {*** Methoden aufgrund eines Buttons ***}
  304. {***************************************}
  305.  
  306. PROCEDURE tMyMainWin.cmSaveUpdate(VAR Msg: tMessage);
  307. VAR
  308.   Count, INDEX : INTEGER;
  309.   Changed : Bool;
  310. BEGIN
  311.   Application^.MainWindow^.TransferData(tf_GetData);
  312.   InputError := FALSE;
  313.   FOR Count := 1 TO 5 DO
  314.     PutAlphaField(TransRec.EditFields[Count], Count);
  315.   PutDateField(TransRec.EditFields[6], 6);
  316.   IF InputError THEN
  317.   BEGIN
  318.     BWCCMessageBox(Application^.MainWindow^.hWindow,
  319.           'Datensatz wurde nicht gespeichert',
  320.           'Datumsfeld ungⁿltig', mb_IconExclamation);
  321.     PX(PXRecBufEmpty(RecHandle1),'PXRecBufEmpty');
  322.   END
  323.   ELSE BEGIN
  324.     IF NOT(NewRec)
  325.       THEN PX(PXRecUpdate(TableHandle1, RecHandle1), 'PXRecUpdate')
  326.       ELSE PX(PXRecInsert(TableHandle1, RecHandle1), 'PXRecUpdate');
  327.     ShowData;
  328.   END;
  329.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  330. END;
  331.  
  332. PROCEDURE tMyMainWin.cmSaveNew(VAR Msg: tMessage);
  333. BEGIN
  334.   NewRec := TRUE;
  335.   cmSaveUpdate(Msg);
  336.   NewRec := FALSE;
  337.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  338. END;
  339.  
  340. PROCEDURE tMyMainWin.cmClear(VAR Msg: tMessage);
  341. BEGIN
  342.   AssignDefaults;
  343.   NewRec := TRUE;
  344.   Application^.MainWindow^.TransferData(tf_SetData);
  345.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  346. END;
  347.  
  348. PROCEDURE tMyMainWin.cmDelete(VAR Msg: tMessage);
  349. BEGIN
  350.   IF NOT NewRec
  351.     THEN IF (PX(PXRecDelete(TableHandle1), 'PXRecDelete') = PXSuccess)
  352.        THEN ShowData;
  353.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  354. END;
  355.  
  356. PROCEDURE tMyMainWin.cmFind(VAR Msg: tMessage);
  357. VAR
  358.   Code, PXErr, Count, INDEX: INTEGER;
  359. BEGIN
  360.   Application^.MainWindow^.TransferData(tf_GetData);
  361.   INDEX := GetTblHandleChecked;
  362.   IF INDEX = 1 THEN
  363.   BEGIN
  364.     FOR Count := 1 TO 5
  365.       DO PutAlphaField(TransRec.EditFields[Count], Count);
  366.     PutDateField(TransRec.EditFields[6], 6);
  367.   END
  368.   ELSE IF INDEX <= 5
  369.      THEN PutAlphaField(TransRec.EditFields[INDEX], INDEX)
  370.      ELSE PutDateField(TransRec.EditFields[INDEX], INDEX);
  371.   IF INDEX = 1
  372.     THEN PXErr := PXSrchKey(TableHandle1, RecHandle1, 6, ClosestRecord)
  373.     ELSE PXErr := PXSrchKey(TableHandle1, RecHandle1, INDEX, ClosestRecord);
  374.   IF (PXErr = PXSuccess) OR (PXErr = PXERR_RecNotFound)
  375.     THEN ShowData
  376.     ELSE MessageBeep(0);
  377.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  378. END;
  379.  
  380. PROCEDURE tMyMainWin.cmShow(VAR Msg: tMessage);
  381. VAR
  382.   INDEX : INTEGER;
  383. BEGIN
  384.   ShowData;
  385.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  386. END;
  387.  
  388. {*** Recordsprungmethoden ***}
  389.  
  390. PROCEDURE tMyMainWin.cmNext(VAR Msg: tMessage);
  391. BEGIN
  392.   IF (PX(PXRecNext(TableHandle1), 'PXRecNext') = PXSuccess)
  393.     THEN ShowData;
  394.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  395. END;
  396.  
  397. PROCEDURE tMyMainWin.cmPrev(VAR Msg: tMessage);
  398. BEGIN
  399.   IF (PX(PXRecPrev(TableHandle1), 'PXRecPrev') = PXSuccess)
  400.     THEN ShowData;
  401.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  402. END;
  403.  
  404. PROCEDURE tMyMainWin.cmLastRec(VAR Msg: tMessage);
  405. BEGIN
  406.   IF (PX(PXRecLast(TableHandle1), 'PXRecLast') = PXSuccess)
  407.     THEN ShowData;
  408.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  409. END;
  410.  
  411. PROCEDURE tMyMainWin.cmFirstRec(VAR Msg: tMessage);
  412. BEGIN
  413.   IF (PX(PXRecFirst(TableHandle1), 'PXRecFirst') = PXSuccess)
  414.     THEN ShowData;
  415.   SetFocus(ChildWithId(id_Edit1)^.hWindow);
  416. END;
  417.  
  418. {****************************************}
  419. {*** Methoden aufgrund von Menⁿanwahl ***}
  420. {****************************************}
  421.  
  422. PROCEDURE tMyMainWin.cmOpenTable(VAR Msg: tMessage);
  423. CONST FldHandles : ARRAY[1..NFields] OF FieldHandle = (1,2,3,4,5,6);
  424. VAR
  425.   PD : pDialog;
  426.   Exist: Bool;
  427.   PXErr, Count : INTEGER;
  428.   FldHandle: FieldHandle;
  429.   HMyMenu: hMenu;
  430.   AFile : ARRAY[0..fsPathName] OF CHAR;
  431.   Temp : pChar;
  432.   NRecs : LongInt;
  433. BEGIN
  434.   StrCopy(AFile, '*.DB');
  435.   IF Application^.ExecDialog(New(pFileDialog,
  436.                 Init(@Self,'FileOpen',AFile))) <> id_OK
  437.     THEN Exit;
  438.   HMyMenu := GetMenu(Application^.MainWindow^.hWindow);
  439.   IF GetMenuState(HMyMenu, cm_CloseTable, mf_ByCommand) = mf_Enabled
  440.     THEN cmCloseTable(Msg);
  441.   AFile[StrPos(AFile,'.') - AFile] := #0;
  442.   StrCopy(TblName,AFile);
  443.   PD := New(pDialog, Init(Application^.MainWindow, 'WaitDlg'));
  444.   Application^.MakeWindow(PD);
  445.   PX(PXTblExist(TblName, Exist), 'PXTblExist');
  446.   IF NOT Exist THEN
  447.   BEGIN
  448.     PXErr:= PX(PXTblCreate(TblName, NFields, Fields, Types),'PXTblCreate');
  449.     IF PXErr = PXSuccess THEN
  450.     BEGIN
  451.       PXKeyAdd(TblName, NFields, FldHandles, Primary);
  452.       FOR Count := 2 TO NFields DO
  453.       BEGIN
  454.     FldHandle := Count;
  455.     PXKeyAdd(TblName, 1, FldHandle, IncSecondary);
  456.       END;
  457.       BWCCMessageBox(Application^.MainWindow^.hWindow,
  458.             'Tabelle wurde erzeugt',
  459.             'Engine Nachricht', mb_IconInformation);
  460.     END
  461.     ELSE BEGIN
  462.       BWCCMessageBox(hWindow,'Kann Tabelle nicht erzeugen !',
  463.             'Fehler', mb_IconStop);
  464.       Exit;
  465.     END;
  466.   END;
  467.   PD^.Destroy;
  468.   PXErr := PX(PXTblOpen(TblName, TableHandle1, 0, TRUE), 'PXTblOpen');
  469.   IF PXErr <> PXSuccess THEN
  470.   BEGIN
  471.     BWCCMessageBox(hWindow,'Kann Tabelle nicht ÷ffnen !',
  472.           'Fehler', mb_IconStop);
  473.     Exit;
  474.   END;
  475.   PX(PXRecBufOpen(TableHandle1, RecHandle1), 'PXRecBufOpen');
  476.   PX(PXTblNRecs(TableHandle1, NRecs),'');
  477.   IF NRecs > 0
  478.     THEN cmFirstRec(Msg);
  479.   HMyMenu := GetMenu(Application^.MainWindow^.hWindow);
  480.   EnableMenuItem(HMyMenu, cm_CloseTable, mf_Enabled OR mf_ByCommand);
  481.   EnableMenuItem(HMyMenu, cm_DeleteTable, mf_Enabled OR mf_ByCommand);
  482.   EnableMenuItem(HMyMenu, cm_NewerIndizes,mf_Enabled OR mf_ByCommand);
  483.   ChangeButtons(On);
  484. END;
  485.  
  486. PROCEDURE tMyMainWin.cmCloseTable(VAR Msg: tMessage);
  487. VAR
  488.   Exist: Bool;
  489.   HMyMenu: hMenu;
  490. BEGIN
  491.   PX(PXTblExist(TblName, Exist), 'PXTblExist');
  492.   IF Exist THEN
  493.   BEGIN
  494.     PX(PXSave, 'PXSave');
  495.     SendMessage(Application^.MainWindow^.hWindow,
  496.            wm_Command, id_ClearButton, 0);
  497.     PX(PXTblClose(TableHandle1), 'PXTblClose');
  498.     HMyMenu := GetMenu(pWindow(@Self)^.hWindow);
  499.     EnableMenuItem(HMyMenu, cm_CloseTable,
  500.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  501.     EnableMenuItem(HMyMenu, cm_DeleteTable,
  502.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  503.     EnableMenuItem(HMyMenu, cm_NewerIndizes,
  504.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  505.     ChangeButtons(Off);
  506.   END;
  507. END;
  508.  
  509. PROCEDURE tMyMainWin.cmDeleteTable(VAR Msg: tMessage);
  510. VAR
  511.   Exist: Bool;
  512.   PXErr : INTEGER;
  513.   HMyMenu: hMenu;
  514. BEGIN
  515.   PX(PXTblExist(TblName, Exist), 'PXTblExist');
  516.   IF Exist THEN
  517.   BEGIN
  518.     IF BWCCMessageBox(hWindow,'Soll Tabelle wirklich gel÷scht werden ?',
  519.              'Achtung',mb_YesNo OR mb_IconQuestion) = id_No
  520.       THEN Exit;
  521.     SendMessage(Application^.MainWindow^.hWindow,
  522.            wm_Command, id_ClearButton, 0);
  523.     PX(PXTblClose(TableHandle1), 'PXTblClose');
  524.     PXErr := PX(PXTblDelete(TblName), 'PXTblDelete');
  525.     IF PXErr = PXSuccess
  526.       THEN BWCCMessageBox(Application^.MainWindow^.hWindow,
  527.                       'Tabelle wurde gel÷scht',
  528.               'Engine Nachricht', mb_IconInformation);
  529.     HMyMenu := GetMenu(pWindow(@Self)^.hWindow);
  530.     EnableMenuItem(HMyMenu, cm_CloseTable,
  531.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  532.     EnableMenuItem(HMyMenu, cm_DeleteTable,
  533.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  534.     EnableMenuItem(HMyMenu, cm_NewerIndizes,
  535.            mf_Disabled OR mf_ByCommand OR mf_Grayed);
  536.     ChangeButtons(Off);
  537.   END;
  538. END;
  539.  
  540. PROCEDURE tMyMainWin.cmNewerIndis(VAR Msg: tMessage);
  541. CONST FldHandles : ARRAY[1..NFields] OF FieldHandle = (1,2,3,4,5,6);
  542. VAR
  543.   FldHandle : FieldHandle;
  544.   Count : INTEGER;
  545.   PD : pDialog;
  546. BEGIN
  547.   PD := New(pDialog, Init(Application^.MainWindow, 'WaitDlg'));
  548.   Application^.MakeWindow(PD);
  549.   PX(PXSave,'');
  550.   PX(PXTblClose(TableHandle1), 'PXTableClose');
  551.   PXKeyAdd(TblName, NFields, FldHandles, Primary);
  552.   FOR Count := 2 TO NFields DO
  553.   BEGIN
  554.     FldHandle := Count;
  555.     PXKeyAdd(TblName, 1, FldHandle, IncSecondary);
  556.   END;
  557.   PX(PXTblOpen(TblName, TableHandle1, 0, TRUE), 'PXTblOpen');
  558.   PX(PXRecBufOpen(TableHandle1, RecHandle1), 'PXRecBufOpen');
  559.   PD^.Destroy;
  560. END;
  561.  
  562. PROCEDURE tMyMainWin.cmAbout(VAR Msg: tMessage);
  563. BEGIN
  564.   Application^.ExecDialog(New(pDialog,
  565.              Init(Application^.MainWindow, 'AboutDlg')));
  566. END;
  567.  
  568. {********************************************}
  569. {*** Methoden von TMyButton und TMyRadBut ***}
  570. {********************************************}
  571.  
  572. FUNCTION tMyButton.GetClassName : pChar;
  573. BEGIN
  574.   GetClassName := 'Button';
  575. END;
  576.  
  577. PROCEDURE tMyRadBut.bnClicked(VAR Msg: tMessage);
  578. VAR
  579.   INDEX, PXErr, Count : INTEGER;
  580.   PD : pDialog;
  581. BEGIN
  582.   tRadioButton.bnClicked(Msg);
  583.   INDEX := GetTblHandleChecked;
  584.   IF INDEX <> CurrentIndex THEN
  585.   BEGIN
  586.     PD := New(pDialog, Init(Application^.MainWindow, 'WaitDlg'));
  587.     Application^.MakeWindow(PD);
  588.     Application^.MainWindow^.TransferData(tf_GetData);
  589.     PX(PXTblClose(TableHandle1), 'PXTableClose');
  590.     IF INDEX = 1
  591.       THEN PX(PXTblOpen(TblName, TableHandle1, 0, TRUE), 'PXTblOpen')
  592.       ELSE PX(PXTblOpen(TblName, TableHandle1, INDEX, TRUE), 'PXTblOpen');
  593.     PX(PXRecBufOpen(TableHandle1, RecHandle1), 'PXRecBufOpen');
  594.     FOR Count := 1 TO 4 DO
  595.       PutAlphaField(TransRec.EditFields[Count], Count);
  596.     PXErr := PXSrchKey(TableHandle1, RecHandle1, 4, SearchFirst);
  597.     PD^.Destroy;
  598.     IF PXErr = PXSuccess
  599.       THEN SendMessage(Application^.MainWindow^.hWindow,
  600.               wm_Command, id_Show, 0);
  601.     CurrentIndex := INDEX;
  602.   END;
  603. END;
  604.  
  605. FUNCTION tMyRadBut.GetClassName : pChar;
  606. BEGIN
  607.   GetClassName := 'Button';
  608. END;
  609.  
  610. {*************************}
  611. {*** Fensterfunktionen ***}
  612. {*************************}
  613.  
  614. CONSTRUCTOR tMyMainWin.Init(aParent: pWindowsObject; aTitle: pChar);
  615. VAR
  616.   EC: pEdit;
  617.   SC: pStatic;
  618.   BC: pButton;
  619.   CC: pMyRadBut;
  620.   Count : INTEGER;
  621. BEGIN
  622.   tWindow.Init(aParent, aTitle);
  623.   Attr.Menu := LoadMenu(hInstance,'MainMenu');
  624.   Attr.X := 120;
  625.   Attr.Y := 35;
  626.   Attr.W := 420;
  627.   Attr.H := 325;
  628.   Attr.Style := Attr.Style XOR ws_MaximizeBox;
  629.   AssignDefaults;
  630.   TransRec.Checks[1] := 1;
  631.   FOR Count := 2 TO NFields DO
  632.     TransRec.Checks[Count] := 0;
  633.   TransferBuffer:= @TransRec;
  634.   BC:= New(pMyButton, Init(@Self, id_SaveUpdate,
  635.             'Speichern/Ver&Σndert', 15, 178, 140, 25, FALSE));
  636.   BC:= New(pMyButton, Init(@Self, id_SaveNew,
  637.             'Speichern/Ne&u',15, 206, 140, 25, FALSE));
  638.   BC:= New(pMyButton, Init(@Self, id_ClearButton,
  639.             '&Maske l÷schen', 175, 178, 110, 25, FALSE));
  640.   BC:= New(pMyButton, Init(@Self, id_Delete,
  641.             'Satz L&÷schen', 175, 206, 110, 25, FALSE));
  642.   BC:= New(pMyButton, Init(@Self, id_FindRec,
  643.             '&Suchen', 305, 178, 80, 25, FALSE));
  644.   BC:= New(pMyButton, Init(@Self, id_Show,
  645.             '&Zeigen', 305, 206, 80, 25, FALSE));
  646.   BC:= New(pMyButton, Init(@Self, id_NextRec,
  647.             '&NΣchster', 15, 244, 80, 25, FALSE));
  648.   BC:= New(pMyButton, Init(@Self, id_PrevRec,
  649.             '&Vorheriger', 112, 244, 80, 25, FALSE));
  650.   BC:= New(pMyButton, Init(@Self, id_LastRec,
  651.             '&Letzter', 208, 244, 80, 25, FALSE));
  652.   BC:= New(pMyButton, Init(@Self, id_FirstRec,
  653.             '&Erster', 305, 244, 80, 25, FALSE));
  654.   FOR Count := 0 TO NFields - 1 DO
  655.   BEGIN
  656.     CC:= New(pMyRadBut, Init(@Self, id_Check1 + Count, '', 380,
  657.          20 + (Count * 24), 15, 20, NIL));
  658.     CC^.EnableTransfer;
  659.   END;
  660.   FOR Count := 0 TO NFields - 1 DO
  661.   BEGIN
  662.     SC:= New(pStatic, Init(@Self, id_Stat1 + Count, '', 20,
  663.          22 + (Count * 24), 130, 25, TextLen));
  664.     SC^.EnableTransfer;
  665.   END;
  666.   FOR Count := 0 TO NFields - 1 DO
  667.   BEGIN
  668.     EC:= New(pEdit, Init(@Self, id_Edit1 + Count, '', 165,
  669.          20 + (Count * 24), 200, 25, TextLen, FALSE));
  670.     EC^.EnableTransfer;
  671.   END;
  672.   EnableKBHandler;
  673.   NewRec := FALSE;
  674. END;
  675.  
  676. DESTRUCTOR tMyMainWin.Done;
  677. BEGIN
  678.   PX(PXSave, 'PXSave');
  679.   PX(PXExit, 'PXExit');
  680.   FreeMem(TblName,128);
  681.   tWindow.Done;
  682. END;
  683.  
  684. PROCEDURE tMyMainWin.GetWindowClass(VAR aWndClass: tWndClass);
  685. BEGIN
  686.   tWindow.GetWindowClass(aWndClass);
  687.   aWndClass.hIcon := LoadIcon(hInstance, 'RoloIcon');
  688. END;
  689.  
  690. PROCEDURE tMyMainWin.SetupWindow;
  691. BEGIN
  692.   tWindow.SetupWindow;
  693.   Application^.MainWindow^.TransferData(tf_SetData);
  694.   InitEngine;
  695. END;
  696.  
  697. PROCEDURE tMyMainWin.Paint(PaintDC: hDC; VAR PaintInfo: tPaintStruct);
  698. BEGIN
  699.   MoveTo(PaintDC,10,238);
  700.   LineTo(PaintDC,390,238);
  701. END;
  702.  
  703. PROCEDURE tMyMainWin.WMMinMaxInfo(VAR Msg : tMessage);
  704. TYPE
  705.   TMyPoints = ARRAY[0..4] OF tPoint;
  706. VAR
  707.   MyPoints: ^TMyPoints;
  708. BEGIN
  709.   MyPoints:= POINTER(Msg.lParam);
  710.   MyPoints^[3].X:=420;
  711.   MyPoints^[3].Y:=325;
  712.   MyPoints^[4].X:=420;
  713.   MyPoints^[4].Y:=325;
  714. END;
  715.  
  716. {***********************************************}
  717. {*** Aplikationsfunktionen und Hauptprogramm ***}
  718. {***********************************************}
  719.  
  720. PROCEDURE tMyApp.InitMainWindow;
  721. BEGIN
  722.   MainWindow := New(pMyMainWin, Init(NIL, 'Rolodex'))
  723. END;
  724.  
  725. BEGIN
  726.   IF hPrevInst = 0 THEN
  727.   BEGIN
  728.     MyApp.Init('MyApp');
  729.     MyApp.Run;
  730.     MyApp.Done;
  731.   END
  732.   ELSE BWCCMessageBox(0, 'Programm kann nur einmal ausgefⁿhrt werden.',
  733.              'Rolodex Nachricht', mb_IconStop);
  734. END.
  735.