home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / tvision / dialogs / asmdlg.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-03  |  9.3 KB  |  301 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ASMDLG.PAS                         *)
  3. (*           (c) 1993 te-wi Verlag, München               *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM AsmDlg;
  6.  
  7. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
  8. {$M 16384,0,655360}
  9.  
  10. USES Objects, Drivers, Views, Menus, MsgBox, Dialogs, App;
  11.  
  12. CONST
  13.   cmAbout = 101;
  14.   cmTest  = 102;
  15.  
  16. (* ------------------------------------------------------ *)
  17.  
  18.   FUNCTION AsmOptDlg : pDialog;
  19.   (* Da es jede Menge CheckBoxen und RadioButtons gibt, wurde
  20.      bei der Vergabe der Shortcuts eingespart. Der Dialog
  21.      sollte jedoch auch ohne Maus zu bedienen sein. Aus diesem
  22.      Grund sind die RadioButtons mit Labels versehen, über
  23.      die die entsprechenden Felder angewählt werden können.
  24.      Die Checkboxen können über die Shortcuts manipuliert werden.
  25.  
  26.      Die Z-Ordnung bleibt unberührt: mit Tab kann der Anwedner
  27.      die Felder wechseln. Aus Gründen der Anwenderfreundlichkeit
  28.      sollten die mit [Tab] anzuwählenden Checkboxen abgesetzt werden.
  29.  
  30.      Die Reihenfolge der an den Dialog zu übergebenden Daten hängt
  31.      ebenfalls von der Z-Ordnung (also der Reihenfolge der Subviews
  32.      im Dialog) ab.
  33.    *)
  34.   VAR
  35.     D : pDialog;
  36.     C : pView;
  37.     R : tRect;
  38.   BEGIN
  39.     R.Assign(0, 0, 75, 22);
  40.     D := New(pDialog, Init(R, 'Assembly Options'));
  41.  
  42.     WITH D^ DO BEGIN
  43.       Options := Options OR ofCentered;
  44.  
  45.       R.Assign(3, 3, 30, 5);
  46.       C := New(pRadioButtons, Init(R,
  47.         NewSItem('Alphabetic      (/a)',
  48.         NewSItem('Source Code     (/s)',
  49.       NIL))));
  50.       Insert(C);
  51.       R.Assign(2, 2, 20, 3);
  52.       Insert(New(pLabel, Init(R, 'Segment ~O~rdering', C)));
  53.  
  54.       R.Assign(3, 7, 30, 10);
  55.       C := New(pRadioButtons, Init(R,
  56.         NewSItem('Full            (/zi)',
  57.         NewSItem('Line Numbers    (/zd)',
  58.         NewSItem('None            (/zn)',
  59.       NIL)))));
  60.       Insert(C);
  61.       R.Assign(2, 6, 22, 7);
  62.       Insert(New(pLabel, Init(R, '~D~ebug Information', C)));
  63.  
  64.       R.Assign(3, 11, 30, 12);
  65.       Insert(New(pCheckBoxes, Init(R,
  66.         NewSItem('~C~ross Reference (/c)',
  67.       NIL))));
  68.  
  69.       R.Assign(3, 14, 30, 17);
  70.       C := New(pRadioButtons, Init(R,
  71.         NewSItem('None  0         (/w0)',
  72.         NewSItem('Level 1         (/w1)',
  73.         NewSItem('Level 2         (/w2)',
  74.       NIL)))));
  75.       Insert(C);
  76.       R.Assign(2, 13, 22, 14);
  77.       Insert(New(pLabel, Init(R, '~W~arning Level', C)));
  78.  
  79.       R.Assign(33, 3, 72, 5);
  80.       C := New(pRadioButtons, Init(R,
  81.         NewSItem('Emulated                   (/e)',
  82.         NewSItem('Real                       (/r)',
  83.       NIL))));
  84.       Insert(C);
  85.       R.Assign(32, 2, 50, 3);
  86.       Insert(New(pLabel, Init(R, '~F~loating Point', C)));
  87.  
  88.       R.Assign(33, 7, 72, 9);
  89.       C := New(pRadioButtons, Init(R,
  90.         NewSItem('Normal                     (/l)',
  91.         NewSItem('Expanded                   (/la)',
  92.       NIL))));
  93.       Insert(C);
  94.       R.Assign(32, 6, 50, 7);
  95.       Insert(New(pLabel, Init(R, '~L~isting', C)));
  96.       R.Assign(33, 9, 72, 12);
  97.       Insert(New(pCheckBoxes, Init(R,
  98.         NewSITem('No Symbol ~t~ables           (/n)',
  99.         NewSItem('Source line ~w~ith error     (/z)',
  100.         NewSItem('~I~nclude false conditionals (/x)',
  101.       NIL))))));
  102.  
  103.       R.Assign(33, 14, 72, 18);
  104.       C := New(pRadioButtons, Init(R,
  105.         NewSItem('Standard                   (/os)',
  106.         NewSItem('Standard with overlays     (/o)',
  107.         NewSItem('Phar Lap                   (/op)',
  108.         NewSItem('IBM                        (/oi)',
  109.       NIL))))));
  110.       Insert(C);
  111.       R.Assign(32, 13, 52, 14);
  112.       Insert(New(pLabel, Init(R, 'Code ~G~eneration', C)));
  113.  
  114.       R.Assign(33, 19, 72, 21);
  115.       Insert(New(pCheckBoxes, Init(R,
  116.         NewSItem('Check for CS o~v~errides     (/p)',
  117.         NewSItem('Suppress OBJ ~r~ecords       (/q)',
  118.       NIL)))));
  119.  
  120.       R.Assign(4, 19, 14, 21);
  121.       Insert(New(pButton, Init(R, 'O~k~', cmOk, bfDefault)));
  122.       Inc(R.A.X, 12);  Inc(R.B.X, 12);
  123.       Insert(New(pButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
  124.  
  125.     END;
  126.     AsmOptDlg := D;
  127.   END;
  128.  
  129. (* -------- Assembler Options Data Transfer ------------- *)
  130.  
  131. TYPE
  132.   AsmOptRec = RECORD
  133.                 SegOrder  : WORD;
  134.                   (* Alphabetic                 (/a) *)
  135.                   (* Source Code                (/s) *)
  136.  
  137.                 DebugInfo : WORD;
  138.                   (* Full                       (/zi) *)
  139.                   (* Line Numbers               (/zd) *)
  140.                   (* None                       (/zn) *)
  141.  
  142.                 CrossRef : WORD;
  143.                   (* Cross Reference            (/c)  *)
  144.  
  145.                 Warnings : WORD;
  146.                   (* None  0                    (/w0) *)
  147.                   (* Level 1                    (/w1) *)
  148.                   (* Level 2                    (/w2) *)
  149.  
  150.                 Floating  : WORD;
  151.                   (* Emulated                   (/e)  *)
  152.                   (* Real                       (/r)  *)
  153.  
  154.                 Listing   : WORD;
  155.                   (* Normal                     (/l)  *)
  156.                   (* Expanded                   (/la) *)
  157.  
  158.                 ListErr   : WORD;
  159.                   (* No Symbol tables           (/n)  *)
  160.                   (* Source line with error     (/z)  *)
  161.                   (* Include false conditionals (/x)  *)
  162.  
  163.                 Code      : WORD;
  164.                   (* Standard                   (/os) *)
  165.                   (* Standard with overlays     (/o)  *)
  166.                   (* Phar Lap                   (/op) *)
  167.                   (* IBM                        (/oi) *)
  168.  
  169.                 Special   : WORD;
  170.                   (* Check for CS overrides     (/p)  *)
  171.                   (* Suppress OBJ records       (/q)  *)
  172.               END;
  173.  
  174. (* --- Main Application Object -------------------------- *)
  175.  
  176.  
  177. TYPE
  178.   tMyApp = OBJECT (tApplication)
  179.     PROCEDURE InitMenuBar; VIRTUAL;
  180.     PROCEDURE HandleEvent(VAR Event : tEvent); VIRTUAL;
  181.   PRIVATE
  182.     PROCEDURE DoTest;
  183.   END;
  184.  
  185. (* Utils *)
  186.  
  187.     FUNCTION HexByte(b : BYTE) : STRING;
  188.     CONST
  189.       H : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  190.     BEGIN
  191.       HexByte[0] := #2;
  192.       HexByte[1] := H[b DIV 16];
  193.       HexByte[2] := H[b MOD 16];
  194.     END;
  195.  
  196.     FUNCTION HexWord(w : WORD) : STRING;
  197.     BEGIN
  198.       HexWord := HexByte(w DIV 256) + HexByte(w MOD 256);
  199.     END;
  200.  
  201.     FUNCTION Li2Str(Li : LONGINT) : STRING;
  202.     VAR
  203.       L  : RECORD Hi, Lo : WORD; END ABSOLUTE Li;
  204.     BEGIN
  205.       Li2Str := HexWord(L.Lo) + HexWord(L.Hi);
  206.     END;
  207. (* ----- *)
  208.   PROCEDURE tMyApp.DoTest;
  209.   VAR
  210.     Data : AsmOptRec;
  211.     S    : STRING;
  212.   BEGIN
  213.     S := 'MASM /t';
  214.     (* /t = always supress messages when no warnigs *)
  215.     WITH Data DO BEGIN
  216.       SegOrder  := $00000000; (* 1 *)
  217.       DebugInfo := $00000000; (* 2 *)
  218.       CrossRef  := $00000000; (* 3 *)
  219.       Warnings  := $00000000; (* 4 *)
  220.       Floating  := $00000000; (* 5 *)
  221.       Listing   := $00000000; (* 6 *)
  222.       ListErr   := $00000000; (* 7 *)
  223.       Code      := $00000000; (* 8 *)
  224.       Special   := $00000000; (* 9 *)
  225.     END;
  226.     ExecuteDialog(AsmOptDlg, @Data);
  227.     WITH Data DO BEGIN
  228.       IF SegOrder = 0 THEN S := S + ' /a' ELSE S := S + ' /s';
  229.       CASE DebugInfo OF
  230.         0 : S := S + ' /zi';
  231.         1 : S := S + ' /zd';
  232.         2 : S := S + ' /zn';
  233.       END;
  234.       IF CrossRef = 1 THEN S := S + ' /c';
  235.       CASE Warnings OF
  236.         0 : S := S + ' /w0';
  237.         1 : S := S + ' /w1';
  238.         2 : S := S + ' /w2';
  239.       END;
  240.       IF Floating = 0 THEN S := S + ' /e' ELSE S := S + ' /r';
  241.       IF Listing  = 0 THEN S := S + ' /l' ELSE S := S + ' /la';
  242.       IF (ListErr AND 1) = 1 THEN S := S + ' /n';
  243.       IF (ListErr AND 2) = 2 THEN S := S + ' /z';
  244.       IF (ListErr AND 4) = 4 THEN S := S + ' /x';
  245.       CASE Code OF
  246.         0 : S := S + ' /os';
  247.         1 : S := S + ' /o';
  248.         2 : S := S + ' /op';
  249.         3 : S := S + ' /oi';
  250.       END;
  251.       IF (Special AND 1) = 1 THEN S := S + ' /p';
  252.       IF (Special AND 2) = 2 THEN S := S + ' /q';
  253.     END;
  254.     MessageBox(S, NIL, mfInformation + mfOkButton);
  255.   END;
  256.  
  257.   PROCEDURE tMyApp.InitMenuBar;
  258.   VAR
  259.     R : tRect;
  260.   BEGIN
  261.     GetExtent(R);
  262.     R.B.Y := R.A.Y + 1;
  263.     MenuBar := New(pMenuBar, Init(R, NewMenu(
  264.       NewSubMenu('~≡~', hcNoContext, NewMenu(
  265.         NewItem('~T~est', '', kbNoKey, cmTest, hcNoContext,
  266.         NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
  267.         NIL))),
  268.       NIL))));
  269.   END;
  270.  
  271.   PROCEDURE tMyApp.HandleEvent(VAR Event : tEvent);
  272.   BEGIN
  273.     inherited HandleEvent(Event);
  274.  
  275.     IF Event.What = evCommand THEN BEGIN
  276.       CASE Event.Command OF
  277.         cmTest  : BEGIN
  278.                     DoTest;
  279.                   END;
  280.         cmAbout : BEGIN
  281.                     MessageBox(#3'Turbo Vision Application',
  282.                     NIL, mfInformation OR mfOkButton);
  283.                   END;
  284.       ELSE
  285.         Exit;
  286.       END;
  287.       ClearEvent(Event);
  288.     END;
  289.   END;
  290.  
  291. VAR
  292.   anApp : tMyApp;
  293.  
  294. BEGIN
  295.   anApp.Init;
  296.   anApp.Run;
  297.   anApp.Done;
  298. END.
  299. (* ------------------------------------------------------ *)
  300. (*                Ende von ASMDLG.PAS                     *)
  301.