home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / delite / ver1 / dxfview / dxfview.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-01  |  16.9 KB  |  547 lines
  1. PROGRAM DXFView;
  2.  
  3. {$N+,E+ }     { 8087, Emulation }
  4.  
  5. { Dieses Beispielprogramm erlaubt die Betrachtung von bis zu vier DXF-
  6.   Grafiken in Fenstern und illustriert die Anwendung des deLite-Toolkits }
  7.  
  8.  
  9. USES  Kernel, api, AcadDXF, firework, DOS, errors;
  10.  
  11. CONST ProjektName  = 'DXFVIEW';                { so heissen alle Dateien  }
  12.       DXFSuffix    = '.DXF';
  13.       IDFenster1   =  201;                     { Die IDs der Botschaften  }
  14.       IDFenster2   =  202;
  15.       IDFenster3   =  203;
  16.       IDFenster4   =  204;
  17.       IDAlleFenster=  205;
  18.       IDZoom       =  206;
  19.  
  20. TYPE  Darstellung  =  (Einzel, Alle);          { Bildschirmdarstellung   }
  21.  
  22. VAR   LaunchResult      : integer;
  23.       MyEvent           : EventTyp;                  { eine Botschaft        }
  24.       StillRunning      : boolean;
  25.       MyID              : integer;
  26.       MyMenu            : hMenu;                     { Handle auf das Menü   }
  27.       Modus             : Darstellung;
  28.  
  29.       AktivWindow       : integer;                   { Rahmenfarbe akt. Fenster }
  30.  
  31.       ID1,ID2           : integer;                   { Die IDs der Fenster   }
  32.       ID3,ID4           : integer;
  33.       AktivID           : integer;                   { ID des aktiven Fensters }
  34.  
  35.       DXFFile1          : String;                    { Die DXF-Files der Fenster }
  36.       DXFFile2          : String;
  37.       DXFFile3          : String;
  38.       DXFFile4          : String;
  39.  
  40.       MyRec             : SearchRec;                 { temporär zum Suchen   }
  41.       DXFDirectory      : String;
  42.  
  43.       GetInitFileResult : Boolean; { Ergebnis Platzhalter für die Funktionen
  44.                                      des Init Files }
  45.  
  46.  
  47. procedure StartWindow;                  { wir stellen uns kurz vor }
  48. Var ScrX,ScrY : Integer;
  49.     WindowX   : Integer;
  50.     WindowY   : Integer;
  51. begin
  52.   HideMouse;
  53.   ScrX    := Succ(GetMaxX) div 2;
  54.   ScrY    := Succ(GetMaxY) div 4;
  55.   WindowX := (50 * FontX)  div 2;
  56.   WindowY := ( 6 * FontY);
  57.   OpenWindow(ScrX-WindowX,ScrY,ScrX+WindowX,ScrY+WindowY );
  58.   WriteWin('BrainLab DXFView Version 1.0    2/91',7,1,DialogText);
  59.   WriteWin('Andreas Schumm & Frank Seidinger',9,3,DialogStat);
  60.   ShowMouse;
  61.   WaitConfirm;
  62.   HideMouse;
  63.   CloseWindow;
  64.   ShowMouse;
  65. end;
  66.  
  67.  
  68. procedure Information; { wir stellen uns noch einmal vor }
  69. Var ScrX,ScrY : Integer;
  70.     WindowX   : Integer;
  71.     WindowY   : Integer;
  72. begin
  73.   HideMouse;
  74.   ScrX    := Succ(GetMaxX) div 2;
  75.   ScrY    := Succ(GetMaxY) div 4;
  76.   WindowX := (74 * FontX)  div 2;
  77.   WindowY := (13 * FontY);
  78.   OpenWindow(ScrX-WindowX,ScrY,ScrX+WindowX,ScrY+WindowY );
  79.   WriteWin('BrainLab DXFView Version 1.0   1/91',35,1,DialogText);
  80.   WriteWin('Andreas Schumm & Frank Seidinger',37,3,DialogStat);
  81.   WriteWin('erstellt mit deLite für Turbo-Pascal',35,8,DialogText);
  82.   OpenWindow(ScrX-WindowX+5,ScrY+FontY div 2,
  83.              ScrX-WindowX+33*FontX,ScrY+12*FontY+FontY div 2);
  84.   Bar(0,0,PortMaxX,PortMaxY,0);
  85.   Fireworks(6,200,PortMaxX,PortMaxY,15);
  86.   CloseWindow;
  87.   CloseWindow;
  88.   ShowMouse;
  89. end;
  90.  
  91. Function RemoveExt(Item: String):NameString;  { Dateierweiterung entfernen }
  92. begin
  93.   Delete(Item,Pos('.',Item),4);
  94.   RemoveExt := Item;
  95. end;
  96.  
  97.  
  98.  
  99. {$F+ }
  100.  
  101.        { Die Callback-Prozeduren für den Dateiauswahldialog }
  102.  
  103.   Procedure GetFirstDXF(Var Item: NameString; Var eol: boolean);
  104.   begin
  105.     MyRec.Name := '';
  106.     FindFirst(DXFDirectory+'\'+'*'+DXFSuffix,ReadOnly,MyRec);
  107.     If DosError = 0 then eol := false
  108.             else eol := true;
  109.     Item := RemoveExt(MyRec.Name);
  110.   end;
  111.  
  112.  
  113.   Procedure GetNextDXF(Var Item: NameString; Var eol: boolean);
  114.   begin
  115.     FindNext(MyRec);
  116.     If DosError = 0  then eol := false
  117.              else eol := true;
  118.     Item := RemoveExt(MyRec.Name);
  119.   end;
  120.  
  121.  
  122. {$F- }
  123.  
  124.  
  125. procedure DoQuit;                     { Programm ggf. beenden }
  126. Var YNRsc: YesNoDialog;
  127. begin
  128.   YNRsc.text := 'Programm wirklich beenden ?';
  129.   YNRsc.xorg := 50;
  130.   YNRsc.yorg := 50;
  131.   YNRsc.topic := 'Programm beenden';
  132.   IF DoYesNoDialog(YNRsc) then StillRunning := false;
  133. end;
  134.  
  135. procedure DXFDir;             { Arbeitsverzeichnis ändern }
  136. Var MyRsc : SmallDialog;
  137.     Fname : DlgStr;
  138.     OldDir: String;
  139.     ready : boolean;
  140.     result: DlgSet;
  141. begin
  142.   ready := false;
  143.   MyRsc.text1 := 'DXF-Verzeichnis wechseln:';
  144.   MyRsc.text2 := '';
  145.   MyRsc.xorg  := 50;
  146.   MyRsc.yorg  := 120;
  147.   MyRsc.len   := 60;
  148.   MyRsc.topic := 'DXF-Verzeichnis';
  149.   MyRsc.deflt := DXFDirectory;
  150.   GetDir(0,OldDir);
  151.   InitSmallDlg(MyRsc);
  152.   repeat
  153.    result := DoSmallDlg(MyRsc, fname);
  154.    if result = success then
  155.    begin
  156.     (*$i- *)
  157.     ChDir(Fname);
  158.     (*$i+ *)
  159.     if ioresult = 0 then
  160.       Begin
  161.     ready := true;
  162.     DXFDirectory := Fname;
  163.         UpString(DXFDirectory);
  164.       End
  165.     else
  166.     ErrWindow(MyRsc.xorg+10,MyRsc.yorg+32,'Falsche Pfadangabe');
  167.     ChDir(OldDIr);
  168.    end;
  169.   until ready or (result = escaped);
  170.   CloseSmallDlg;
  171. end;
  172.  
  173.  
  174. { ******************************* }
  175. { Die Fenster-Empfangsprozeduren  }
  176. { ******************************* }
  177.  
  178. {$F+ }
  179.  
  180. Procedure Fenster1(MyMessage: EventTyp);
  181. begin
  182.   If ((MyMessage.Class = LeMouse) and (MyMessage.Attrib = LeftButtonPressed))
  183.     or (MyMessage.Class = Menu) then
  184.   begin
  185.     CheckMenuItem(MyMenu,AktivID,MF_UNCHECKED);
  186.     Case AktivID of                     { aktives Fenster umrahmen  }
  187.        IDFenster1: FrameSubApplication(ID1,7);
  188.        IDFenster2: FrameSubApplication(ID2,7);
  189.        IDFenster3: FrameSubApplication(ID3,7);
  190.        IDFenster4: FrameSubApplication(ID4,7);
  191.       end;
  192.     AktivID := IDFenster1;
  193.     FrameSubApplication(ID1,AktivWindow);
  194.     CheckMenuItem(MyMenu,AktivID,MF_CHECKED);
  195.   end;
  196.   Case MyMessage.Class of
  197.     DoRedraw  : begin
  198.                   ClearWindow;
  199.                   if DXFFile1 <> '' then
  200.                     if InterpretDXF(DXFFile1) <> ok then
  201.                       ErrWindow(30,30,'DXF kann nicht interpretiert werden.');
  202.                 end;
  203.     end;
  204. end;
  205.  
  206.  
  207. Procedure Fenster2(MyMessage: EventTyp);
  208. begin
  209.   If ((MyMessage.Class = LeMouse) and (MyMessage.Attrib = LeftButtonPressed))
  210.     or (MyMessage.Class = Menu) then
  211.   begin
  212.     CheckMenuItem(MyMenu,AktivID,MF_UNCHECKED);
  213.     Case AktivID of                     { aktives Fenster umrahmen  }
  214.        IDFenster1: FrameSubApplication(ID1,7);
  215.        IDFenster2: FrameSubApplication(ID2,7);
  216.        IDFenster3: FrameSubApplication(ID3,7);
  217.        IDFenster4: FrameSubApplication(ID4,7);
  218.       end;
  219.     AktivID := IDFenster2;
  220.     FrameSubApplication(ID2,AktivWindow);
  221.     CheckMenuItem(MyMenu,AktivID,MF_CHECKED);
  222.   end;
  223.   Case MyMessage.Class of
  224.     DoRedraw  : begin
  225.                   ClearWindow;
  226.                   if DXFFile2 <> '' then
  227.                     if InterpretDXF(DXFFile2) <> ok then
  228.                       ErrWindow(30,30,'DXF kann nicht interpretiert werden.');
  229.                 end;
  230.     end;
  231. end;
  232.  
  233.  
  234. Procedure Fenster3(MyMessage: EventTyp);
  235. begin
  236.   If ((MyMessage.Class = LeMouse) and (MyMessage.Attrib = LeftButtonPressed))
  237.     or (MyMessage.Class = Menu) then
  238.   begin
  239.     CheckMenuItem(MyMenu,AktivID,MF_UNCHECKED);
  240.     Case AktivID of                     { aktives Fenster umrahmen  }
  241.        IDFenster1: FrameSubApplication(ID1,7);
  242.        IDFenster2: FrameSubApplication(ID2,7);
  243.        IDFenster3: FrameSubApplication(ID3,7);
  244.        IDFenster4: FrameSubApplication(ID4,7);
  245.       end;
  246.     AktivID := IDFenster3;
  247.     FrameSubApplication(ID3,AktivWindow);
  248.     CheckMenuItem(MyMenu,AktivID,MF_CHECKED);
  249.   end;
  250.   Case MyMessage.Class of
  251.     DoRedraw  : begin
  252.                   ClearWindow;
  253.                   if DXFFile3 <> '' then
  254.                     if InterpretDXF(DXFFile3) <> ok then
  255.                       ErrWindow(30,30,'DXF kann nicht interpretiert werden.');
  256.                 end;
  257.     end;
  258. end;
  259.  
  260.  
  261. Procedure Fenster4(MyMessage: EventTyp);
  262. begin
  263.   If ((MyMessage.Class = LeMouse) and (MyMessage.Attrib = LeftButtonPressed))
  264.     or (MyMessage.Class = Menu) then
  265.   begin
  266.     CheckMenuItem(MyMenu,AktivID,MF_UNCHECKED);
  267.       Case AktivID of                     { aktives Fenster umrahmen  }
  268.        IDFenster1: FrameSubApplication(ID1,7);
  269.        IDFenster2: FrameSubApplication(ID2,7);
  270.        IDFenster3: FrameSubApplication(ID3,7);
  271.        IDFenster4: FrameSubApplication(ID4,7);
  272.       end;
  273.     AktivID := IDFenster4;
  274.     FrameSubApplication(ID4,AktivWindow);
  275.     CheckMenuItem(MyMenu,AktivID,MF_CHECKED);
  276.   end;
  277.   Case MyMessage.Class of
  278.     DoRedraw  : begin
  279.                   ClearWindow;
  280.                   if DXFFile4 <> '' then
  281.                     if InterpretDXF(DXFFile4) <> ok then
  282.                       ErrWindow(30,30,'DXF kann nicht interpretiert werden.');
  283.                 end;
  284.     end;
  285. end;
  286.  
  287.  
  288. Procedure Vollbild;             { Zeigt ein Fenster ganz gross ! }
  289. Var  MSG    : EventTyp;
  290. begin
  291.   CloseSubApplication(ID1);     { Die vier Fenster schliessen }
  292.   CloseSubApplication(ID2);
  293.   CloseSubApplication(ID3);
  294.   CloseSubApplication(ID4);
  295.   ActivateApplication(MyID);    { und die Hauptapplikation reaktivieren }
  296.   SetTheViewPort(MyID);
  297.   ClearViewPort;                { Bildschirm löschen }
  298.   Msg.Class := DoRedraw;
  299.   Case AktivID of               { dann ein Redraw }
  300.     IDFenster1 : Fenster1(Msg);
  301.     IDFenster2 : Fenster2(Msg);
  302.     IDFenster3 : Fenster3(Msg);
  303.     IDFenster4 : Fenster4(Msg);
  304.     end;
  305.   Modus := Einzel;
  306. end;
  307.  
  308.  
  309. Procedure VierFenster;              { zeigt vier kleine Fenster ! }
  310. Var ThePort: ViewPortType;
  311.     XSize  : integer;
  312.     YSize  : integer;
  313.     XOrg   : integer;
  314.     YOrg   : integer;
  315.     XEnd   : integer;
  316.     YEnd   : integer;
  317.     Msg    : EventTyp;
  318. begin
  319.   ClearViewPort;                       { Fenster löschen }
  320.   GetViewSettings(ThePort);
  321.   With ThePort Do
  322.     begin
  323.       XSize := (x2-x1) div 2 - 2;       { Ausdehnung in x-Richtung berechnen }
  324.       YSize := (y2-y1) div 2 - 4;       { dito in y-Richtung }
  325.       XOrg  := x1;
  326.       YOrg  := y1 + 3;
  327.       XEND  := x2;
  328.       YEnd  := y2;
  329.     end;
  330.  
  331.   ID1 := OpenSubApplication(Fenster1,0,'Fenster 1',
  332.                      XOrg,YOrg,Xorg+XSize,YOrg+YSize);
  333.  
  334.   ID2 := OpenSubApplication(Fenster2,0,'Fenster 2',
  335.                      XEND-XSize,YOrg,XEND,YOrg+YSize);
  336.  
  337.   ID3 := OpenSubApplication(Fenster3,0,'Fenster 3',
  338.                      XOrg,YEnd-YSize,Xorg+XSize,YEnd);
  339.  
  340.   ID4 := OpenSubApplication(Fenster4,0,'Fenster 4',
  341.                      XEnd-XSize,YEnd-YSize,XEnd,YEnd);
  342.  
  343.   SuspendApplication(MyID);           { Hauptfenster deaktivieren }
  344.  
  345.   Case AktivID of                     { aktives Fenster umrahmen  }
  346.     IDFenster1: FrameSubApplication(ID1,AktivWindow);
  347.     IDFenster2: FrameSubApplication(ID2,AktivWindow);
  348.     IDFenster3: FrameSubApplication(ID3,AktivWindow);
  349.     IDFenster4: FrameSubApplication(ID4,AktivWindow);
  350.     end;
  351.  
  352.   MSG.Class := DoRedraw;
  353.  
  354.   PostMessage(MSG, ID1);              { alle Fenster neu zeichnen }
  355.   PostMessage(MSG, ID2);
  356.   PostMessage(MSG, ID3);
  357.   PostMessage(MSG, ID4);
  358.  
  359.   Modus := Alle;
  360. end;
  361.  
  362.  
  363. procedure NewWindow;
  364. Var MyMsg : EventTyp;
  365. begin
  366.   MyMsg.Class := DoRedraw;
  367.   Case AktivID of
  368.     IDFenster1 : begin
  369.                    DXFFile1 := '';
  370.                    SetTheViewPort(ID1);
  371.                    Fenster1(MyMsg);
  372.                  end;
  373.     IDFenster2 : begin
  374.                    DXFFile2 := '';
  375.                    SetTheViewPort(ID2);
  376.                    Fenster2(MyMsg);
  377.                  end;
  378.     IDFenster3 : begin
  379.                    DXFFile3 := '';
  380.                    SetTheViewPort(ID3);
  381.                    Fenster3(MyMsg);
  382.                  end;
  383.     IDFenster4 : begin
  384.                    DXFFile4 := '';
  385.                    SetTheViewPort(ID4);
  386.                    Fenster4(MyMsg);
  387.                  end;
  388.   end; { Case }
  389. end;
  390.  
  391.  
  392. procedure LoadDXF;
  393. Var MyRsc  : ListDialog;
  394.     LaList : TheList;
  395.     LFname : NameString;
  396.     result : DlgSet;
  397.     TheString:string;
  398.     MyMsg  : EventTyp;
  399. begin
  400.   MyRsc.text       := 'Datei auswählen:';
  401.   MyRsc.ItemWidth  := 12;
  402.   MyRsc.ListLength :=  4;
  403.   MyRsc.xorg       :=  80;
  404.   MyRsc.yorg       :=  60;
  405.   MyRsc.topic      := 'DXF laden';
  406.   MyRsc.GetFirst   := GetFirstDXF;
  407.   MyRsc.GetNext    := GetNextDXF;
  408.   result := empty;
  409.   new(LaList);
  410.   InitListDialog(MyRsc,LaList);
  411.   result := DoListDialog(MyRsc,LFname,LaList);
  412.   CloseListDialog;
  413.   dispose(LaList);
  414.   if result = success then
  415.     begin
  416.       MyMsg.Class := DoRedraw;
  417.         Case AktivID of
  418.           IDFenster1 : begin
  419.                          DXFFile1 := DXFDirectory + '\' + LFname;
  420.                          SetTheViewPort(ID1);
  421.                          Fenster1(MyMsg);
  422.                        end;
  423.           IDFenster2 : begin
  424.                          DXFFile2 := DXFDirectory + '\' + LFname;
  425.                          SetTheViewPort(ID2);
  426.                          Fenster2(MyMsg);
  427.                        end;
  428.           IDFenster3 : begin
  429.                          DXFFile3 := DXFDirectory + '\' + LFname;
  430.                          SetTheViewPort(ID3);
  431.                          Fenster3(MyMsg);
  432.                        end;
  433.           IDFenster4 : begin
  434.                          DXFFile4 := DXFDirectory + '\' + LFname;
  435.                          SetTheViewPort(ID4);
  436.                          Fenster4(MyMsg);
  437.                        end;
  438.         end; { Case }
  439.     end;
  440. end;
  441.  
  442.  
  443. Procedure HandleMsg(MyMessage: EventTyp);
  444. { Die Hauptempfangsprozedur behandelt die Menü-Botschaften }
  445. Begin
  446.   With MyMessage Do
  447.     Case Class Of
  448.       Menu    : begin
  449.                   Case x of
  450.                      0       : DoQuit;
  451.  
  452.                      101     : LoadDXF;
  453.                      102     : NewWindow;
  454.                      103     : DXFDir;
  455.  
  456.                      205     : begin
  457.                                  ReplaceMenuItem(MyMenu,
  458.                                                  205,
  459.                                                  '&Alle Fenster',
  460.                                                  206,'A');
  461.                                  Vollbild;
  462.                                end;
  463.  
  464.                      206     : begin
  465.                                  ReplaceMenuItem(MyMenu,
  466.                                                  206,
  467.                                                  '&Zoom',
  468.                                                  205,'Z');
  469.                                  VierFenster;
  470.                                end;
  471.  
  472.                    IDFenster1: begin
  473.                                  Fenster1(MyMessage);
  474.                                  MyMessage.Class := DoRedraw;
  475.                                  If Modus = Einzel then
  476.                                    Fenster1(MyMessage);
  477.                                end;
  478.  
  479.                    IDFenster2: begin
  480.                                  Fenster2(MyMessage);
  481.                                  MyMessage.Class := DoRedraw;
  482.                                  If Modus = Einzel then
  483.                                    Fenster2(MyMessage);
  484.                                end;
  485.  
  486.                    IDFenster3: begin
  487.                                  Fenster3(MyMessage);
  488.                                  MyMessage.Class := DoRedraw;
  489.                                  If Modus = Einzel then
  490.                                    Fenster3(MyMessage);
  491.                                end;
  492.  
  493.                    IDFenster4: begin
  494.                                  Fenster4(MyMessage);
  495.                                  MyMessage.Class := DoRedraw;
  496.                                  If Modus = Einzel then
  497.                                    Fenster4(MyMessage);
  498.                                end;
  499.  
  500.                      399     : Information;
  501.  
  502.                   end;
  503.                 end;
  504.     end;
  505. End;
  506.  
  507.  
  508. {$F- }
  509.  
  510.  
  511. Begin
  512.   StillRunning := true;
  513.   Modus        := Alle;              { 4 Fenster sichtbar  }
  514.   AktivID      := IDFenster1;        { Fenster 1 ist aktiv }
  515.  
  516.   DXFFile1 := '';                    { Keine DXF-Dateien zugewiesen }
  517.   DXFFile2 := '';
  518.   DXFFile3 := '';
  519.   DXFFile4 := '';
  520.  
  521.   LaunchResult := OpenMainApplication(HandleMsg,      { deLite starten }
  522.                                       0,
  523.                                       ProjektName);
  524.   MyID := GetMainID;
  525.   If LaunchResult = 0 then                      { erfolgreich gestartet }
  526.     begin
  527.       GetInitFileResult := GetInitFileName('PATHS','DXFDir',DXFDirectory);
  528.       InitDXF;                           { DXF-Interpreter initialisieren }
  529.       AktivWindow   := 15;               { Farbe des aktiven Fensters }
  530.       MyMenu := GetMenu;
  531.       DisableMoveDetect;                 { keine Bewegungen melden }
  532.       StartWindow;                       { Begrüssung anzeigen }
  533.       VierFenster;
  534.       while StillRunning Do
  535.         begin
  536.           GetEvent(MyEvent);             { Botschaften holen und weiterleiten }
  537.           DispatchMessage(MyEvent);
  538.         end;
  539.       CloseMainApplication;              { deLite schliessen }
  540.       Writeln('Programm beendet.');
  541.     end
  542.   Else
  543.     begin
  544.       Writeln('Programm kann nicht gestartet werden. Fehler: ',LaunchResult);
  545.       Writeln(ErrorName(LaunchResult));
  546.     end;
  547. End.