home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Disp3d / DISPUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-08  |  5KB  |  188 lines
  1. unit Dispunit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, VBXCtrl, Pict, StdCtrls, ExtCtrls, Spin, Read3d, Rot3D;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     DrawBox: TPaintBox;
  12.     OpenFileDialog: TOpenDialog;
  13.     OpenButton: TButton;
  14.     CloseButton: TButton;
  15.     XEdit: TSpinEdit;
  16.     YEdit: TSpinEdit;
  17.     ZEdit: TSpinEdit;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     Label3: TLabel;
  21.     Bevel1: TBevel;
  22.     PointCheckBox: TCheckBox;
  23.     WireCheckBox: TCheckBox;
  24.     procedure OpenButtonClick(Sender: TObject);
  25.     procedure CloseButtonClick(Sender: TObject);
  26.     procedure XEditChange(Sender: TObject);
  27.     procedure YEditChange(Sender: TObject);
  28.     procedure ZEditChange(Sender: TObject);
  29.     procedure WireCheckBoxClick(Sender: TObject);
  30.     procedure PointCheckBoxClick(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.   public
  34.     { Public declarations }
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.   DataFileName : string[80];
  40.   DataRot : RotObj;
  41.  
  42. const DrawPoints : boolean = false;
  43.       DrawWires : boolean = true;
  44.       NoData : boolean = true;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. procedure ClearDrawBox;
  51. begin
  52.   Form1.DrawBox.Canvas.Pen.Color := clwhite;
  53.   Form1.DrawBox.Canvas.Brush.Color := clblack;
  54.   Form1.DrawBox.Canvas.Rectangle(0,0,
  55.            Form1.DrawBox.Width,Form1.DrawBox.Height);
  56. end;
  57.  
  58. procedure DrawIt;
  59. var Q1,Q2,Q3,Q4,LX1,LX2,LY1,LY2,LZ1,LZ2:integer;
  60.   procedure DrawDataPoints;
  61.   var I : integer;
  62.   begin
  63.     for I := 0 to pred(DataItems) do
  64.     begin
  65.       DataRot.PointTransform(Xval^[I],Yval^[I],Zval^[I],LX1,LY1,LZ1);
  66.       Form1.DrawBox.Canvas.Pixels[Lx1,Ly1] := clLime;
  67.     end;
  68.   end;
  69.  
  70.     procedure DrawPatch(I:integer);
  71.     var K : integer;
  72.     begin
  73.       for K := 0 to BezierPatternItems-2 do
  74.       begin
  75.         Q1 := Patch^[I][BezierPattern^[K]]-1;
  76.         Q2 := Patch^[I][BezierPattern^[K+1]]-1;
  77.         DataRot.PointTransform(Xval^[Q1],Yval^[Q1],Zval^[Q1],LX1,LY1,LZ1);
  78.         DataRot.PointTransform(Xval^[Q2],Yval^[Q2],Zval^[Q2],LX2,LY2,LZ2);
  79.         Form1.DrawBox.Canvas.MoveTo(Lx1,Ly1);
  80.         Form1.DrawBox.Canvas.LineTo(Lx2,Ly2);
  81.       end;
  82.     end;
  83.  
  84.   procedure DrawDataWires;
  85.   var I:integer;
  86.   begin
  87.     I := 0;
  88.     for I := 0 to PatchLines-1 do
  89.       DrawPatch(I);
  90.   end;
  91.  
  92. begin
  93.   if NoData then Exit;
  94.   DataRot.SetTransformMatrix(Xangle,Yangle,Zangle);
  95.   ClearDrawBox;
  96.   if DrawWires then
  97.     DrawDataWires;
  98.   if DrawPoints then
  99.     DrawDataPoints;
  100. end;
  101.  
  102. procedure TForm1.OpenButtonClick(Sender: TObject);
  103. var W,H,D : word;
  104. begin
  105.   if OpenFileDialog.Execute then
  106.   begin
  107.     DataFilename := OpenFileDialog.FileName;
  108.     DataFilename := copy(DataFilename,1,length(DataFilename)-4);
  109.     if ReadConfig(DataFilename) then
  110.     begin
  111.       Xedit.Value := round(Xangle);
  112.       Yedit.Value := round(Yangle);
  113.       Zedit.Value := round(Zangle);
  114.       W := Form1.DrawBox.Width;
  115.       H := Form1.DrawBox.Height;
  116.       D := Form1.DrawBox.Width;
  117.       Form1.Caption := DataFileName;
  118.       Form1.DrawBox.Canvas.Pen.Color := clwhite;
  119.       Form1.DrawBox.Canvas.Brush.Color := clblack;
  120.       Form1.DrawBox.Canvas.Rectangle(0,0,W,H);
  121.       DataRot.SetDataConversion(Xstart,Ystart,Zstart,Xrange,Yrange,Zrange,
  122.                                 W div 2,H div 2,D div 2,W,H,D);
  123.       if not ReadData(DataFilename) then
  124.         NoData := true
  125.       else if not ReadPatch(DataFilename) then
  126.         NoData := true
  127.       else
  128.         NoData := false;
  129.       DrawIt;
  130.     end
  131.     else
  132.     begin
  133.       Form1.Caption := Application.Title;
  134.     end;
  135.   end;
  136.  
  137. end;
  138.  
  139. procedure TForm1.CloseButtonClick(Sender: TObject);
  140. begin
  141.   Close;
  142. end;
  143.  
  144. procedure TForm1.XEditChange(Sender: TObject);
  145. begin
  146.   Xangle := Xedit.Value;
  147.   if Xedit.value >= 360 then Xedit.value := 0;
  148.   if Xedit.value <= -1 then Xedit.value := 360-Xedit.increment;
  149.   Drawit;
  150. end;
  151.  
  152. procedure TForm1.YEditChange(Sender: TObject);
  153. begin
  154.   if Yedit.value >= 360 then Yedit.value := 0;
  155.   if Yedit.value <= -1 then Yedit.value := 360-Yedit.increment;
  156.   Yangle := Yedit.Value;
  157.   Drawit;
  158. end;
  159.  
  160. procedure TForm1.ZEditChange(Sender: TObject);
  161. begin
  162.   if Zedit.value >= 360 then Zedit.value := 0;
  163.   if Zedit.value <= -1 then Zedit.value := 360-Zedit.increment;
  164.   Zangle := Zedit.Value;
  165.   Drawit;
  166. end;
  167.  
  168. procedure TForm1.WireCheckBoxClick(Sender: TObject);
  169. begin
  170.   if Form1.WireCheckBox.State = cbChecked then
  171.     DrawWires := true
  172.   else
  173.     DrawWires := false;
  174.   Drawit;
  175. end;
  176.  
  177. procedure TForm1.PointCheckBoxClick(Sender: TObject);
  178. begin
  179.   if Form1.PointCheckBox.State = cbChecked then
  180.     DrawPoints := true
  181.   else
  182.     DrawPoints := false;
  183.   Drawit;
  184. end;
  185.  
  186. end.
  187.  
  188.