main_for.pas

一个比较完整的读写dxf文件的DELPHI程序

///////////////////////////////////////////////////////////////////////////////
//                                                                           //
//                             Main demo window                              //
//                             ㎎ohn Biddiscombe                             //
//                      Rutherford Appleton Laboratory, UK                   //
//                           [e-mail]                          //
//                       DXF code release 3.0 - July 1997                    //
//                                                                           //
///////////////////////////////////////////////////////////////////////////////
unit Main_form;

interface

uses
  { Borland }
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ComCtrls, Math, Clipbrd,
  { Mine }
  ThinkBox, DXF_Structs, DXF_Utils, DXF_read, DXF_write, Zoomer;

type
  TCAD_Demo_Form = class(TForm)
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    LoadButton: TButton;
    SaveDialog1: TSaveDialog;
    Panel10: TPanel;
    Panel2: TPanel;
    Panel5: TPanel;
    Files_listbox: TListBox;
    Panel6: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Panel9: TPanel;
    Label1: TLabel;
    vert_lab: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    line_lab: TLabel;
    polyo_lab: TLabel;
    polyc_lab: TLabel;
    SaveButton: TButton;
    CopyClipButton: TButton;
    Panel15: TPanel;
    delete: TButton;
    Track_timer: TTimer;
    C_remove_layers: TCheckBox;
    Panel7: TPanel;
    Label5: TLabel;
    T_entities: TLabel;
    Label13: TLabel;
    Label6: TLabel;
    T_Lists: TLabel;
    Label12: TLabel;
    Label11: TLabel;
    T_Layers: TLabel;
    Label15: TLabel;
    T_Objs: TLabel;
    ZoomBox: Zoom_panel;
    Messages: TListBox;
    Panel3: TPanel;
    Repaint_button: TButton;
    Thick_lines: TCheckBox;
    draw_vertices: TCheckBox;
    Fill_closed: TCheckBox;
    Track_mouse: TCheckBox;
    block_defs: TCheckBox;
    Memo1: TMemo;
    procedure LoadButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Repaint_buttonClick(Sender: TObject);
    procedure ZoomboxPaint(Sender: TObject);
    procedure Files_listboxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Files_listboxKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Files_listboxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SaveButtonClick(Sender: TObject);
    procedure deleteClick(Sender: TObject);
    procedure CopyClipButtonClick(Sender: TObject);
    procedure Track_mouseClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Track_timerTimer(Sender: TObject);
    procedure ZoomboxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ZoomboxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ZoomboxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Useful stuff fetched from DXF file }
    DXF_main    : DXF_Object;
    emax,emin   : Point3D;
    { Bookkeeping }
    directory        : string;
    data_dir         : string;
    database_loaded  : boolean;
    { Mouse input }
    mouseX,mouseY    : integer;
    selection        : selection_lists;
    { Tracking }
    highlight_obj    : DXF_Entity;
    highlight_point  : Point3D;
    { Editing }
    Captured_obj     : DXF_Entity;
    Captured_point   : Point3D;

    procedure read_dxf_file(name:string);
    procedure refresh_listbox(SelectAll:boolean);
    procedure update_selection;
    procedure Fill_stringlist(str:TStrings);
  end;

var
  CAD_Demo_Form: TCAD_Demo_Form;

implementation

uses
  Tracking_Form;

{$R *.DFM}

{ --------------------------------------------------------------------------- }
{                   Form Creation and Handling
{ --------------------------------------------------------------------------- }
procedure TCAD_Demo_Form.FormCreate(Sender: TObject);
begin
  directory        := ExtractFilePath(Application.Exename);
  data_dir         := directory +'data\';
  database_loaded  := false;
  selection        := selection_lists.create;
  emax             := aPoint3D(-1E10,-1E10,-1E10);
  emin             := aPoint3D( 1E10, 1E10, 1E10);
end;

procedure TCAD_Demo_Form.FormDestroy(Sender: TObject);
begin
  selection.Free;
end;
{ --------------------------------------------------------------------------- }
{                   File Load/Save
{ --------------------------------------------------------------------------- }
procedure TCAD_Demo_Form.read_dxf_file(name:string);
var temp_DXF : DXF_Object;
begin
  if DXF_main=nil then begin
    DXF_main    := DXF_Object.Create_from_file(name,messages.Items);
    emax        := DXF_main.get_max_extent;
    emin        := DXF_main.get_min_extent;
  end else begin
    temp_DXF    := DXF_Object.Create_from_file(name,messages.Items);
    max_bound(emax, temp_DXF.get_max_extent() );
    min_bound(emin, temp_DXF.get_min_extent() );
    DXF_main.merge_files(temp_DXF);
    temp_DXF.Free;
  end;
end;

procedure TCAD_Demo_Form.LoadButtonClick(Sender: TObject);
begin
  if not OpenDialog1.Execute then exit;
  if not fileexists(OpenDialog1.Filename) then begin
    showmessage('File not found'); exit;
  end;
  repaint;
  if      opendialog1.filterindex=1 then read_dxf_file(OpenDialog1.Filename);
{
  else if opendialog1.filterindex=2 then read_off_file(OpenDialog1.Filename,'',0)
  else if opendialog1.filterindex=3 then read_off_file(OpenDialog1.Filename,'',1);
}
  database_loaded := true;
  refresh_listbox(true);
  Zoombox.set_parameters(emin.x,emax.x,emin.y,emax.y, 20,20);
  Zoombox.ClientArea.repaint;
end;

procedure TCAD_Demo_Form.SaveButtonClick(Sender: TObject);
var lp1   : integer;
    lists : TList;
    ft    : file_type;
begin
  if not SaveDialog1.Execute then exit;
  thinking(self,'Saving data');
  if SaveDialog1.filterindex=1 then begin
    if Uppercase(ExtractFileExt(SaveDialog1.Filename))<>'.DXF' then
      SaveDialog1.Filename := SaveDialog1.Filename +'.dxf';
    selection.save_to_DXF_file(SaveDialog1.FileName);
  end;
  stopped_thinking;
end;

{ --------------------------------------------------------------------------- }
{                   Painting/Drawing
{ --------------------------------------------------------------------------- }
procedure TCAD_Demo_Form.Repaint_buttonClick(Sender: TObject);
begin
  Zoombox.ClientArea.repaint;
end;

procedure TCAD_Demo_Form.CopyClipButtonClick(Sender: TObject);
begin
  ZoomboxPaint(CopyClipButton);
end;

procedure TCAD_Demo_Form.ZoomboxPaint(Sender: TObject);
var lp0        : integer;
    data_list  : Entity_List;
    metafile   : TMetaFile;
    metaCanvas : TMetaFileCanvas;
    drawcanvas : TCanvas;
begin
  if (sender = CopyClipButton) then begin
    metafile        := TMetaFile.Create;
    metafile.Height := Zoombox.ClientArea.height;
    metafile.width  := Zoombox.ClientArea.width;
    metaCanvas      := TMetafileCanvas.Create(metafile, 0);
    drawcanvas      := metaCanvas;
  end
  else drawcanvas := Zoombox.ClientArea.Canvas;

  drawcanvas.Font.name := 'FF_ROMAN';
  if Thick_lines.checked then drawcanvas.Pen.Width := 3
  else drawcanvas.Pen.Width := 1;
  drawcanvas.Pen.Color := clBlack;
  if Fill_closed.checked then begin
    drawcanvas.Brush.Style := bsSolid;
    drawcanvas.Brush.Color := clBlack;
  end
  else drawcanvas.Brush.Style := bsClear;

  for lp0:=0 to Files_listbox.Items.Count-1 do begin
    if (not Files_listbox.Selected[lp0]) then continue;
    if Files_listbox.Items.Objects[lp0] is Entity_List then begin
      data_list := Entity_List(Files_listbox.Items.Objects[lp0]);
      data_list.draw_primitives(drawcanvas,Zoombox.real_to_screen,nil);
      if draw_vertices.checked then
        data_list.draw_vertices(drawcanvas,Zoombox.real_to_screen,nil);
    end;
  end;
  if (sender = CopyClipButton) then begin
    metaCanvas.Free;
    ClipBoard.Assign(metafile);
    metafile.Destroy;
  end
end;
{ --------------------------------------------------------------------------- }
{                   Mouse Tracking & Object Selection
{ --------------------------------------------------------------------------- }
procedure TCAD_Demo_Form.Track_mouseClick(Sender: TObject);
begin
  if Track_mouse.checked then begin
    TrackingForm.Show;
    Track_timer.enabled := true;
  end
  else begin
    TrackingForm.Hide;
    Track_timer.enabled := false;
  end;
end;

procedure TCAD_Demo_Form.Track_timerTimer(Sender: TObject);
var p0        : Point2D;
    t         : TColor;
    old_obj   : DXF_Entity;
    old_point : Point3D;
begin
  if (not Track_mouse.checked) or (not database_loaded) then begin
    Track_timer.enabled := false;
    exit;
  end;
  old_obj   := highlight_obj;
  old_point := highlight_point;
  p0 := zoombox.screen_to_real(Point(mouseX,mouseY));
  if TrackingForm.R_Nearest.checked then
    highlight_point := selection.find_closest_2D_point(aPoint3D(p0.x,p0.y,0),highlight_obj)
  else begin
    // lets see if the last object is still the highlighted one
    if (highlight_obj<>nil) and highlight_obj.is_point_inside_object2D(aPoint3D(p0.x,p0.y,0)) then
      highlight_point := highlight_obj.closest_vertex(aPoint3D(p0.x,p0.y,0))
    else
      highlight_point := selection.is_inside_object(aPoint3D(p0.x,p0.y,0),highlight_obj);
  end;
  if (highlight_obj<>nil) then begin
    if (highlight_obj<>old_obj) then begin
      if old_obj<>nil then old_obj.draw(zoombox.clientarea.canvas,zoombox.real_to_screen,nil);
      t := highlight_obj.colour;
      highlight_obj.setcolour(t XOR $00FFFFFF);
      highlight_obj.draw(zoombox.clientarea.canvas,zoombox.real_to_screen,nil);
      highlight_obj.setcolour(t);
    end;
    if not p1_eq_p2_3D(highlight_point,old_point) then with TrackingForm do begin
      Tr_X.Caption := FloatToStrF(highlight_point.x,ffGeneral,7,2);
      Tr_Y.Caption := FloatToStrF(highlight_point.y,ffGeneral,7,2);
      Tr_Z.Caption := FloatToStrF(highlight_point.z,ffGeneral,7,2);
      Tr_P.Caption := FloatToStr(highlight_obj.count_points);
      if T_extended.checked then T_info_box.Text := highlight_obj.details;
    end;
  end;
  // turn it off until the next mouse move
  Track_timer.enabled := false;
end;

procedure TCAD_Demo_Form.ZoomboxMouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
begin
  mouseX := X;
  mouseY := Y;
  if Track_mouse.checked then Track_timer.enabled := true;
end;

procedure TCAD_Demo_Form.ZoomboxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ssShift in Shift then begin
    Captured_point := Highlight_point;
    Captured_obj   := Highlight_obj;
  end
  else begin
    Captured_point := aPoint3D(0,0,0);
    Captured_obj   := nil;
  end;
end;

procedure TCAD_Demo_Form.ZoomboxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var new_p : Point2D;
    new_q : Point3D;
begin
  if Captured_obj<>nil then begin
    new_p   := zoombox.screen_to_real(Point(X,Y));
    new_q   := set_accuracy(1000,aPoint3D(new_p.x,new_p.y,Captured_point.z));
    if not Captured_obj.Move_point(Captured_point,new_q) then
      Showmessage('An error occurred moving point')
    else Zoombox.ClientArea.repaint;
    Captured_point := aPoint3D(0,0,0);
    Captured_obj   := nil;
  end;
end;

{ --------------------------------------------------------------------------- }
{                   Object List Control
{ --------------------------------------------------------------------------- }
procedure TCAD_Demo_Form.Files_listboxKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key=VK_DELETE then deleteClick(nil);
end;

procedure TCAD_Demo_Form.refresh_listbox(SelectAll:boolean);
var lp1 : integer;
begin
  Files_listbox.Clear;
  if DXF_main<>nil then begin
    if C_remove_layers.Checked then DXF_main.remove_empty_layers_and_lists;
    if DXF_main.num_layers=0 then begin
      DXF_main.Free;
      DXF_main:=nil;
    end else DXF_main.copy_to_strings(Files_listbox.Items);
  end;
  if SelectAll then for lp1:=0 to Files_listbox.Items.count-1 do Files_listbox.Selected[lp1] := true;
  update_selection;
end;

procedure TCAD_Demo_Form.update_selection;
var lp1,vct,lct,pcto,pctc : integer;
begin
  vct := 0; lct := 0; pcto := 0; pctc := 0;
  selection.entity_lists.Clear;
  with Files_Listbox do begin
    for lp1:=Items.Count-1 downto 0 do with Items do begin
      if (Selected[lp1]) then begin
        if (not (objects[lp1] is Entity_List)) or
          ((Entity_List(objects[lp1]).name='Block_') and block_defs.checked)
          then Selected[lp1] := false
        else selection.entity_lists.Add(objects[lp1]);
      end;
    end;
    for lp1:=Items.Count-1 downto 0 do with Items do if Selected[lp1] then begin
      vct   :=   vct  + Entity_List(Objects[lp1]).count_points;
      lct   :=   lct  + Entity_List(Objects[lp1]).count_lines;
      pcto  :=   pcto + Entity_List(Objects[lp1]).count_polys_open;
      pctc  :=   pctc + Entity_List(Objects[lp1]).count_polys_closed;
    end;
  end;
  vert_lab.Caption    := IntToStr(vct);
  line_lab.Caption    := IntToStr(lct);
  polyo_lab.Caption   := IntToStr(pcto);
  polyc_lab.Caption   := IntToStr(pctc);

  T_entities.Caption  := IntToStr(entities_in_existence);
  T_Lists.Caption     := IntToStr(Ent_lists_in_existence);
  T_Layers.Caption    := IntToStr(layers_in_existence);
  T_Objs.Caption      := IntToStr(DXF_Obj_in_existence);
  // If data changes, we must clear the highlight_obj to prevent access violation
  highlight_obj       := nil;
  highlight_point     := aPoint3D(0,0,0);
end;

procedure TCAD_Demo_Form.Fill_stringlist(str:TStrings);
begin
  if DXF_main<>nil then begin
    DXF_main.copy_to_strings(str);
  end;
end;

procedure TCAD_Demo_Form.Files_listboxKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
begin
  update_selection;
end;

procedure TCAD_Demo_Form.Files_listboxMouseUp(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
  update_selection;
end;

procedure TCAD_Demo_Form.deleteClick(Sender: TObject);
var lp1 : integer;
begin
  with selection do
    for lp1:=0 to entity_lists.count-1 do
      DXF_Layer(Entity_list(entity_lists[lp1]).parent_layer).delete(Entity_list(entity_lists[lp1]).name,true);
  refresh_listbox(false);;
end;

procedure TCAD_Demo_Form.FormShow(Sender: TObject);
begin
  OpenDialog1.InitialDir := data_dir;
end;

initialization
end.