home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / appgen / appgen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-01  |  14.8 KB  |  539 lines
  1. (*========================================================*)
  2. (*                      APPGEN.PAS                        *)
  3. (*        (C) 1993 Peter Fliesges & DMV-Verlag            *)
  4. (*                                                        *)
  5. (*      Einfacher Applikationsgenerator fⁿr TPW/BPW       *)
  6. (* Compiler: Turbo Pascal fⁿr Windows, Borland Pascal 7.0 *)
  7. (*========================================================*)
  8.  
  9. PROGRAM AppGen;
  10. USES
  11. {$IFDEF VER70}                      (* Borland Pascal 7.0 *)
  12.   OWindows, WinProcs, OStdDlgs,
  13.   ODialogs, WinTypes, Strings, BWCC;
  14. {$ELSE}                       (* Turbo Pascal fⁿr Windows *)
  15.   WObjects, WinTypes, WinProcs, Strings, StdDlgs, BWCC;
  16. {$ENDIF}
  17.  
  18. {$R APPGEN.RES}
  19.  
  20. CONST
  21.   id_Start           = 100;                     (* Button *)
  22.   id_Accept          = 101;
  23.   id_Ende            = 102;
  24.   id_About           = 103;
  25.  
  26.   id_CBMitRahmen     = 200;                   (* CheckBox *)
  27.   id_CBGefuellt      = 201;
  28.  
  29.   id_LBSource        = 300;                    (* ListBox *)
  30.   id_LBDest          = 301;
  31.  
  32.   id_AppName         = 400;                 (* Stat. Text *)
  33.   id_ProgName        = 401;
  34.   id_AccTable        = 402;
  35.   id_ObjName         = 403;
  36.  
  37. TYPE
  38.   tAppGen = OBJECT(tApplication)
  39.     PROCEDURE InitMainWindow; VIRTUAL;
  40.   END;
  41.  
  42.   pAppGenWindow = ^tAppGenWindow;
  43.   tAppGenWindow = OBJECT(tDlgWindow)
  44.     (* Objektfelder: *)
  45.     cbMitRahmen, cbGefuellt : pCheckBox;
  46.     lbSource,    lbDest     : pListbox;
  47.     edAppName,   edProgName,
  48.     edAccTable,  edObjName  : pEdit;
  49.  
  50.     (* Methoden: *)
  51.     CONSTRUCTOR Init(aParent: pWindowsObject;
  52.                      aTitle : pChar);
  53.     FUNCTION    GetClassName: pChar; VIRTUAL;
  54.     PROCEDURE   GetWindowClass(VAR aWndClass: tWndClass);
  55.                                               VIRTUAL;
  56.     PROCEDURE   SetUpWindow; VIRTUAL;
  57.     PROCEDURE   Quit(VAR Msg: tMessage);
  58.                   VIRTUAL id_First + id_Ende;
  59.     PROCEDURE   wmCommand(VAR Msg: tMessage);
  60.                   VIRTUAL wm_First + wm_Command;
  61.     PROCEDURE   About(VAR Msg: tMessage);
  62.                   VIRTUAL id_First + id_About;
  63.     PROCEDURE   Accept(VAR Msg: tMessage);
  64.                   VIRTUAL id_First + id_Accept;
  65.     PROCEDURE   Start;
  66.     PROCEDURE   FillLBSource;
  67.     PROCEDURE   lbDestAddItem;
  68.     FUNCTION    OpenFile : BOOLEAN;
  69.     PROCEDURE   Kopf;
  70.     PROCEDURE   Mitte;
  71.     PROCEDURE   Fuss;
  72.     PROCEDURE   FillMethod(ProcName : pChar);
  73.     PROCEDURE   ObjTitle(Name : pChar);
  74.   END;
  75.  
  76. VAR
  77.   f, f2     : Text;
  78.   ProgName,
  79.   ParentName,
  80.   AccTable,
  81.   AppName,
  82.   ObjName   : ARRAY[0..32] OF CHAR;
  83.   SWMCount  : ARRAY[0..3] OF CHAR;
  84.   WMCount   : INTEGER;
  85.  
  86.  
  87. (*========================================================*)
  88. (*     Implementierung des Objekts tAppGenWindow          *)
  89. (*========================================================*)
  90.  
  91. CONSTRUCTOR tAppGenWindow.Init(aParent: pWindowsObject;
  92.                                aTitle : pChar);
  93. BEGIN
  94.   tDlgWindow.Init(aParent, aTitle);
  95.   New(cbMitRahmen, InitResource(@Self, id_CBMitRahmen ));
  96.   New(cbGefuellt,  InitResource(@Self, id_CBGefuellt  ));
  97.   New(lbSource,    InitResource(@Self, id_LBSource    ));
  98.   New(lbDest,      InitResource(@Self, id_LBDest      ));
  99.   New(edAppName,   InitResource(@Self, id_AppName,  32));
  100.   New(edProgName,  InitResource(@Self, id_ProgName,  8));
  101.   New(edAccTable,  InitResource(@Self, id_AccTable, 32));
  102.   New(edObjName,   InitResource(@Self, id_ObjName,  32));
  103. END;
  104.  
  105.  
  106. FUNCTION tAppGenWindow.GetClassName: pChar;
  107. BEGIN                    (* Bei BorDlg gibt es kein Icon! *)
  108.   GetClassName := 'BorDlgWin';
  109. END;
  110.  
  111. PROCEDURE tAppGenWindow.GetWindowClass(
  112.                                   VAR aWndClass: tWndClass);
  113. BEGIN
  114.   tDlgWindow.GetWindowClass(aWndClass);
  115.   aWndClass.hIcon := LoadIcon(hInstance, 'AppGenIcon');
  116. END;
  117.  
  118. PROCEDURE tAppGenWindow.SetUpWindow;
  119. BEGIN
  120.   tDlgWindow.SetUpWindow;
  121.   FillLBSource;
  122.  
  123.   StrCopy(AppName, 'MyApp');
  124.   edAppName^.SetText(AppName);
  125.   StrCopy(ProgName, 'MyProg');
  126.   edProgName^.SetText(ProgName);
  127.   StrCopy(AccTable, '');
  128.   edAccTable^.SetText(AccTable);
  129.   StrCopy(ObjName, 'tMyWindow');
  130.   edObjName^.SetText(ObjName);
  131.   StrCopy(ParentName, 'tWindow');
  132.  
  133.   cbMitRahmen^.SetCheck(1);
  134.   EnableWindow(GetDlgItem(hWindow, id_Start), FALSE);
  135. END;
  136.  
  137. PROCEDURE tAppGenWindow.Quit(VAR Msg: tMessage);
  138. BEGIN
  139.  (* PostQuitMessage(0); Absturz, wenn nach ProgStart      *)
  140.  (* direkt Ende betΣtigt wird! Daher:                     *)
  141.   Halt(0);
  142. END;
  143.  
  144. PROCEDURE tAppGenWindow.wmCommand(VAR Msg: tMessage);
  145. BEGIN
  146.   IF Msg.wParam = id_Start THEN Start;
  147.   IF Msg.lParamHi = cbn_DblClk THEN lbDestAddItem;
  148.   tDlgWindow.wmCommand(Msg);
  149. END;
  150.  
  151. PROCEDURE tAppGenWindow.About(VAR Msg: tMessage);
  152. BEGIN
  153.   Application^.ExecDialog(New(pDialog,
  154.                               Init(@Self, 'About')));
  155. END;
  156.  
  157. PROCEDURE tAppGenWindow.Accept(VAR Msg: tMessage);
  158. VAR
  159.   s, s1 : ARRAY[0..255] OF CHAR;
  160.   found : BOOLEAN;
  161.   i     : INTEGER;
  162. BEGIN
  163.   lbSource^.GetSelString(s, 255);
  164.   found := FALSE;
  165.   IF lbDest^.GetCount > 0 THEN BEGIN
  166.     i := 0;
  167.     REPEAT
  168.       lbDest^.GetString(s1, i);
  169.       IF StrComp(s1, s) = 0 THEN found := TRUE;
  170.       Inc(i);
  171.     UNTIL (i>=lbDest^.GetCount) OR (StrComp(s1, s) = 0);
  172.   END;
  173.  
  174.   IF found THEN
  175.     lbDest^.DeleteString(i - 1)
  176.   ELSE
  177.     lbDest^.AddString(s);
  178.  
  179.   IF lbDest^.GetCount > 0 THEN
  180.     EnableWindow(GetDlgItem(hWindow, id_Start), TRUE)
  181.   ELSE
  182.     EnableWindow(GetDlgItem(hWindow, id_Start), FALSE);
  183. END;  
  184.  
  185. PROCEDURE tAppGenWindow.Start;
  186. VAR
  187.   OldCursor : WORD;
  188.   Msg       : tMsg;
  189. BEGIN
  190.   OldCursor := SetClassWord(hWindow, gcw_hCursor,
  191.                             LoadCursor(0, idc_Wait));
  192.   EnableWindow(GetDlgItem(hWindow,id_Start), FALSE);
  193.   edProgName^.GetText(ProgName, 8);
  194.  
  195.   IF OpenFile THEN BEGIN
  196.     edAppName^.GetText(AppName, 32);
  197.     edAccTable^.GetText(AccTable, 32);
  198.     edObjName^.GetText(ObjName, 32);
  199.  
  200.     IF cbMitRahmen^.GetCheck = bf_Checked THEN Kopf
  201.     ELSE BEGIN
  202.       Application^.ExecDialog(New(pInputDialog, Init(@Self,
  203.         '', 'Vorfahr:', ParentName, SizeOf(ParentName))));
  204.     END;
  205.     Mitte;
  206.     IF cbMitRahmen^.GetCheck = bf_Checked THEN Fuss;
  207.     Close(f);
  208.     Close(f2);
  209.   END;
  210.   EnableWindow(GetDlgItem(hWindow, id_Start), TRUE);
  211.   SetClassWord(hWindow, gcw_hCursor, OldCursor);
  212.   SetCursor(OldCursor);
  213. END;  
  214.  
  215. PROCEDURE tAppGenWindow.FillLBSource;
  216. VAR
  217.   i : INTEGER;
  218.   s : ARRAY[0..255] OF CHAR;
  219. BEGIN
  220.   i := 1;
  221.   (* Soviele Strings laden, wie vorhanden *)
  222.   WHILE LoadString(hInstance, i, s, SizeOf(s)) > 0 DO BEGIN
  223.     lbSource^.AddString(s);
  224.     Inc(i);
  225.   END;
  226.   lbSource^.SetSelIndex(0);
  227. END;
  228.  
  229. PROCEDURE tAppGenWindow.lbDestAddItem;
  230. VAR
  231.   s, s1 : ARRAY[0..255] OF CHAR;
  232.   found : BOOLEAN;
  233.   i     : INTEGER;
  234. BEGIN
  235.   IF GetFocus = lbSource^.hWindow THEN BEGIN
  236.     lbSource^.GetSelString(s, 255);
  237.     found := FALSE;
  238.     IF lbDest^.GetCount > 0 THEN BEGIN
  239.       i := 0;
  240.       REPEAT
  241.         lbDest^.GetString(s1, i);
  242.         IF StrComp(s1, s) = 0 THEN found := TRUE;
  243.         Inc(i);
  244.       UNTIL (i>=lbDest^.GetCount) OR (StrComp(s1, s) = 0);
  245.     END;
  246.  
  247.     IF found THEN
  248.       lbDest^.DeleteString(i - 1)
  249.     ELSE
  250.       lbDest^.AddString(s);
  251.   END;
  252.  
  253.   IF GetFocus = lbDest^.hWindow THEN BEGIN
  254.     lbDest^.DeleteString(lbDest^.GetSelIndex)
  255.   END;
  256.   
  257.   IF lbDest^.GetCount > 0 THEN
  258.     EnableWindow(GetDlgItem(hWindow, id_Start), TRUE)
  259.   ELSE
  260.     EnableWindow(GetDlgItem(hWindow, id_Start), FALSE);
  261. END;
  262.  
  263. FUNCTION tAppGenWindow.OpenFile: BOOLEAN;
  264. VAR
  265.   b : BOOLEAN;
  266.   s : ARRAY[0..80] OF CHAR;
  267. BEGIN
  268.   b := TRUE;
  269.   StrCopy(s, ProgName);
  270.   StrCat(s, '.Pas');
  271.   Assign(f, s);
  272.   {$I-}
  273.   Reset(f);
  274.   {$I+}
  275.   IF IOResult = 0 THEN
  276.     IF BWCCMessageBox(0, #13#10'Datei existiert bereits!' +
  277.                          #13#10'▄berschreiben?','Achtung',
  278.                          mb_YesNo OR mb_IconExclamation OR
  279.                          mb_DefButton2) = idNo THEN
  280.       b := FALSE;
  281.   IF b THEN BEGIN
  282.     ReWrite(f);
  283.     OpenFile := TRUE;
  284.   END ELSE
  285.     OpenFile := FALSE;
  286.  
  287.   Assign(f2, 'APPGEN.DAT');
  288.   {$I-}
  289.   Reset(f2);
  290.   {$I+}
  291.   IF IOResult <> 0 THEN
  292.     BWCCMessageBox(0, 'Datei AppGen.Dat nicht gefunden!',
  293.                       'Fehler',
  294.                       mb_OK OR mb_IconExclamation);
  295. END;
  296.  
  297. PROCEDURE tAppGenWindow.Kopf;
  298. VAR
  299.   p      : pChar;
  300.   s      : ARRAY[0..80] OF CHAR;
  301.   i, 
  302.   ErrPos : INTEGER;               (* ErrPos: Fⁿr Val() *)
  303. BEGIN
  304.   Reset(f2);
  305.   WHILE (NOT EoF(f2)) AND (StrPos(s, '[Kopf]') = NIL) DO
  306.     ReadLn(f2, s);
  307.   ReadLn(f2, s);
  308.   WHILE (NOT EoF(f2)) AND (s[0] <> '[') DO BEGIN
  309.     WriteLn(f, s);
  310.     ReadLn(f2, s);
  311.   END;
  312.   WriteLn(f);
  313.   WriteLn(f, 'PROGRAM ', ProgName, ';'#13#10);
  314.   WriteLn(f, 'USES');
  315. {$IFDEF VER70}
  316.   WriteLn(f, '  OWindows, WinProcs, OStdDlgs,');
  317.   WriteLn(f, '  ODialogs, WinTypes, Strings, BWCC;'#13#10);
  318. {$ELSE}
  319.   WriteLn(f, '  WObjects, WinTypes, WinProcs, Strings, ' +
  320.              ' StdDlgs, BWCC;'#13#10);
  321. {$ENDIF}
  322.   WriteLn(f, '{$R APPGEN.RES}'#13#10);
  323.   WriteLn(f, 'CONST');
  324.   WriteLn(f, '  AppName    : pChar = ''', AppName, ''';');
  325.  
  326.   edAccTable^.GetText(s, 5);
  327.   IF StrLen(s) > 0 THEN
  328.     IF Application^.ExecDialog(New(pInputDialog,
  329.           Init(@Self, 'Eingabe',
  330.           'Anzahl Botschaftsantwortmethoden',
  331.           SWMCount, SizeOf(SWMCount)))) = id_OK THEN BEGIN
  332.       WriteLn(f);
  333.       Val(SWMCount, WMCount, ErrPos);
  334.       FOR i := 1 TO WMCount DO BEGIN
  335.         Str(i, s);
  336.         Write(f, '  id_WM', s);
  337.         Str(i + 200:3, s);
  338.         WriteLn(f, #9, ' = ', s, ';');
  339.       END;
  340.     END;
  341.  
  342.   WriteLn(f, #13#10'TYPE');
  343.   WriteLn(f, '  t', AppName, ' = OBJECT(tApplication)');
  344.   WriteLn(f, '    (* Objektfelder *)'#13#10);
  345.   WriteLn(f, '    (* Methoden *)');
  346.   WriteLn(f, '    PROCEDURE InitMainWindow; VIRTUAL;');
  347.   edAccTable^.GetText(s, 5);
  348.   IF StrLen(s) > 0 THEN
  349.     WriteLn(f, '    PROCEDURE InitInstance; VIRTUAL;');
  350.   WriteLn(f, '  END;');
  351. END;
  352.  
  353. PROCEDURE tAppGenWindow.Mitte;
  354. VAR
  355.   i, j : INTEGER;
  356.   p1, p2, p3 : pChar;
  357.   s, s2, s3 : ARRAY[0..255] OF CHAR;
  358. BEGIN
  359.   WITH lbDest^ DO BEGIN
  360.     WriteLn(f);
  361.     IF cbMitRahmen^.GetCheck = bf_UnChecked THEN
  362.       WriteLn(f, 'TYPE');
  363.     WriteLn(f, '  p', ObjName + 1, ' = ^', ObjName, ';');
  364.     WriteLn(f, '  ', ObjName,' = OBJECT(', ParentName, ')');
  365.     WriteLn(f, '    (* Objektfelder *)'#13#10);
  366.     WriteLn(f, '    (* Methoden *)');
  367.  
  368.     FOR i := 0 TO GetCount - 1 DO BEGIN
  369.       GetString(s, i);
  370.       WriteLn(f, '    ', s);
  371.     END;
  372.  
  373.     IF WMCount > 0 THEN
  374.       WriteLn(f);
  375.       FOR i := 1 TO WMCount DO BEGIN
  376.         Str(i, s);
  377.         WriteLn(f, '    PROCEDURE wm', s,
  378.                    '(VAR Msg: tMessage);');
  379.         WriteLn(f, '      VIRTUAL cm_First + id_WM', s, ';')
  380.       END;
  381.  
  382.     WriteLn(f, '  END;');
  383.  
  384.     ObjTitle(ObjName);
  385.  
  386.     FOR i := 0 TO GetCount - 1 DO BEGIN
  387.       GetString(s, i);
  388.  
  389.       FillChar(s2, SizeOf(s2), #0);     (* Initialisieren *)
  390.       FillChar(s3, SizeOf(s3), #0);
  391.    
  392.       p1 := StrPos(s, ' ');
  393.       p2 := StrPos(s, ')');
  394.       p3 := StrPos(s, ';');
  395.  
  396.       StrMove(s2, s, p1 - s);
  397.       StrCat(s2, ' ');
  398.       StrCat(s2, ObjName);
  399.       StrCat(s2, '.');
  400.       IF p2 = NIL THEN
  401.         StrMove(s3, p1 + 1, p3 - p1)
  402.       ELSE
  403.         StrMove(s3, p1 + 1, p2 - p1 + 1);
  404.       StrCat(s2, s3);
  405.       WriteLn(f, s2);
  406.  
  407.       WriteLn(f, 'BEGIN');
  408.       IF cbGefuellt^.GetCheck = bf_Checked THEN BEGIN
  409.         StrCopy(s3, '[');
  410.         j := 0;
  411.         REPEAT
  412.           Move(s[j], s3[j+1], 1);
  413.           Inc(j);
  414.         UNTIL (s[j] = ';') OR (s[j] = '(') OR (s[j] = ':');
  415.         s3[j+1] := ']';
  416.         s3[j+2] := #0;
  417.         FillMethod(s3);
  418.       END;
  419.       Write(f, 'END;  (* ');
  420.  
  421.       j := 0;
  422.       REPEAT
  423.         Write(f, s2[j]);
  424.         Inc(j);
  425.       UNTIL (s2[j] = ';') OR (s2[j] = '(') OR (s2[j] = ':');
  426.       WriteLn(f, ' *)'#13#10#13#10);
  427.     END;
  428.  
  429.     IF WMCount > 0 THEN
  430.       WriteLn(f);
  431.       FOR j := 1 TO WMCount DO BEGIN
  432.         Str(j, s);
  433.         WriteLn(f, 'PROCEDURE ', ObjName, '.wm', s,
  434.                    '(VAR Msg: tMessage);');
  435.         WriteLn(f, 'BEGIN');
  436.         WriteLn(f, 'END;  (* PROCEDURE ', ObjName, '.wm',
  437.                    s, ' *)'#13#10#13#10);
  438.     END;
  439.   END;
  440. END;  
  441.  
  442. PROCEDURE tAppGenWindow.Fuss;
  443. VAR
  444.   s : ARRAY[0..80] OF CHAR;
  445. BEGIN
  446.   StrCopy(s, 't');
  447.   StrCat(s, AppName);
  448.   ObjTitle(s);
  449.   WriteLn(f, 'PROCEDURE ', s, '.InitMainWindow;');
  450.   WriteLn(f, 'BEGIN');
  451.   WriteLn(f, '  MainWindow := New(p', ObjName + 1,
  452.              ', Init(NIL, AppName));');
  453.   WriteLn(f, 'END;'#13#10);
  454.  
  455.   edAccTable^.GetText(s, 20);
  456.   IF StrLen(s) > 0 THEN BEGIN
  457.     WriteLn(f, #13#10'PROCEDURE t', AppName,
  458.                '.InitInstance;');
  459.     WriteLn(f, 'BEGIN');
  460.     WriteLn(f, '  tApplication.InitInstance;');
  461.     WriteLn(f, '  hAccTable := (LoadAccelerators(hInstance,'
  462.              + '''', s,'''));');
  463.     WriteLn(f, 'END;'#13#10);
  464.   END;
  465.  
  466.   WriteLn(f, #13#10'VAR'#13#10'  ', AppName, ' : t',
  467.              AppName, ';');
  468.   WriteLn(f, '  LibHdl : tHandle;'#13#10);
  469.   WriteLn(f, 'BEGIN');
  470.   WriteLn(f, '  LibHdl :=  LoadLibrary(''WORKLIB2.DLL'');');
  471.   WriteLn(f, '  ', AppName, '.Init(AppName);');
  472.   WriteLn(f, '  ', AppName, '.Run;');
  473.   WriteLn(f, '  ', AppName, '.Done;');
  474.   WriteLn(f, '  FreeLibrary(LibHdl);');
  475.   WriteLn(f, 'END.');
  476. END;  
  477.  
  478. PROCEDURE tAppGenWindow.FillMethod(ProcName: pChar);
  479. VAR
  480.   s : ARRAY[0..80] OF CHAR;
  481. BEGIN
  482.   Reset(f2);
  483.   WHILE (NOT EoF(f2)) AND (StrPos(s, ProcName) = NIL) DO
  484.     ReadLn(f2, s);
  485.   ReadLn(f2, s);
  486.   WHILE (NOT EoF(f2)) AND (s[0] <> '[') DO BEGIN
  487.     WriteLn(f, s);
  488.     ReadLn(f2, s);
  489.   END;
  490. END;
  491.  
  492. PROCEDURE tAppGenWindow.ObjTitle(Name : pChar);
  493. VAR
  494.   s, s1 : ARRAY[0..60] OF CHAR;
  495. BEGIN
  496.   s[0]  := '(';
  497.   s[1]  := '*';
  498.   s[58] := '*';
  499.   s[59] := ')';
  500.   s[60] := #0;
  501.   FillChar(s[2], 56, '=');
  502.   WriteLn(f, #13#10#13#10, s);
  503.   FillChar(s[2], 56, ' ');
  504.   StrCopy(s1, 'Methoden des Objekts ');
  505.   StrCat(s1, Name);
  506.   Move(s1, s[4], StrLen(s1));
  507.   WriteLn(f, s);
  508.   FillChar(s[2], 56, '=');
  509.   WriteLn(f, s, #13#10#13#10);
  510. END;
  511.  
  512. (* ====================================================== *)
  513. (*  Applikation initialisieren                            *)     
  514. (* ====================================================== *)
  515.  
  516. PROCEDURE tAppGen.InitMainWindow;
  517. BEGIN
  518.   MainWindow := New(pAppGenWindow, Init(NIL, 'AppGenDlg'));
  519. END;
  520.  
  521. VAR
  522.   App   : tAppGen;
  523.   LibHdl: tHandle;
  524.  
  525. BEGIN
  526.   LibHdl :=  LoadLibrary('WORKLIB2.DLL');
  527.   (* Nachdem die Library einmal eingebunden ist, k÷nnte   *)
  528.   (* man hier auf den Aufruf verzichten, aber beim nΣch-  *)
  529.   (* sten Neustart wundert man sich!                      *)
  530.   App.Init('AppGen');
  531.   App.Run;
  532.   App.Done;
  533.   FreeLibrary(LibHdl);
  534. END.
  535.  
  536. (*========================================================*)
  537. (*                 Ende von APPGEN.PAS                    *)                     
  538.  
  539.