« ■カテゴリーを変更しました。 | トップページ | ☆TOutlookApplicationを使ってみる。 »

☆JWWファイルの超簡易表示

JWWファイルとは、言わずと知れたJW_CAD(JW_WIN)のデータファイルです。
Peter's Roomで公開されているjww data read & save unit Ver1.2βを使って、簡単に線と文字を描画するサンプルです。座標系の処理をしないと描画できないので、AFsoftさんの「CAD作ろ」!のコードを使わせて頂きました。マウスのホイールによる拡大縮小と、右左同時クリックで範囲指定して拡大ができます。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    ox, oy: Integer;                   // 原点
    ImageWidth,ImageHeight: Integer;   // 画面ドットサイズ=Image1のサイズ
    PaperWidth, PaperHeight: Double;   // 用紙サイズ
    mm_dot: Double;                    // mm_dot比
    view_x1, view_y1, view_x2, view_y2: Double;  //ビューエリア
    DragStart_X, DragStart_Y: Integer; // ドラッグ開始点
    DragEnd_X, DragEnd_Y: Integer;     // ドラッグ終了点
    DragModeKind : Integer;            // ドラッグモード 0:移動 1:拡大 2:縮小
    DraggingNow : Boolean;             // ドラッグ中かどうかのフラグ
    RubberBandShow : Boolean;          // ラバーバンド表示フラグ
    procedure Calc_mm_dot;             // mm_dot比の計算
    procedure Calc_ViewArea;           // ビューエリアの計算
    procedure CLS;                     // 画面を消す
    procedure Draw_Paper_Frame;        // 用紙枠の描画
    procedure Drawdata;                // 図面の描画
    procedure RubberBand(x1, y1, x2, y2:Integer); // ラバーバンドの描画
    procedure SetPaperSize(PaperSize: Integer);   // 用紙サイズの設定
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses jwwunit; // jww data read & save unit Ver1.2β

procedure TForm1.FormCreate(Sender: TObject);
var
  FileName: String;
begin
  // 初期化
  DraggingNow := False;
  RubberBandShow := False;

  // ファイルの読み込み
  FileName := 'c:\jww\Aマンション平面例.jww';

  JWWBlockList := TJWWBlockList.Create;

  // JWWファイル読込み
  jwwRead(FileName);

  // 図面サイズの読み込み
  // A4~A0までしか扱えないようにする。いろいろあると面倒だから(^^;
  if not (JWWHd.m_nZumen in [0,1,2,3,4]) then
  begin
    ShowMessage('A0..A4の用紙サイズしか扱えません。');
    Exit;
  end;

  // 用紙サイズの設定
  SetPaperSize(JWWHd.m_nZumen);

  // mm_dot比の計算
  Calc_mm_dot;

  // ビューエリアの計算
  Calc_ViewArea;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  JWWBlockList.Free;
end;


procedure TForm1.FormResize(Sender: TObject);
begin
  // mm_dot比の計算
  Calc_mm_dot;

  // ビューエリアの計算
  Calc_ViewArea;
end;


// 用紙サイズの設定
{
  Paramater 用紙サイズ 
  0-A0
  1-A1
  2-A2
  3-A3
  4-A4
}
procedure TForm1.SetPaperSize(PaperSize: Integer); // 用紙サイズの設定
begin
  case PaperSize of
    0: begin //A0
         PaperWidth  :=1189;
         PaperHeight := 841;
       end;
    1: begin //A1
         PaperWidth  := 841;
         PaperHeight := 594;
       end;
    2: begin //A2
         PaperWidth  := 594;
         PaperHeight := 420;
       end;
    3: begin //A3
         PaperWidth  := 420;
         PaperHeight := 297;
       end;
    4: begin //A4
         PaperWidth  := 297;
         PaperHeight := 210;
       end;
  end;
end;


// mm_dot比の計算
procedure TForm1.Calc_mm_dot;
var
  P1, P2: Double;
begin
  ImageWidth  := PaintBox1.Width;
  ImageHeight := PaintBox1.Height;
  P1 := ImageWidth  / PaperWidth;
  P2 := ImageHeight / PaperHeight;

  if (P1 < P2) then
    mm_dot := P1
  else
    mm_dot := P2;
end;


// ビューエリアの計算
procedure TForm1.Calc_ViewArea;
begin
  view_x1 := - (ImageWidth  / 2.0) / mm_dot;
  view_y1 := - (ImageHeight / 2.0) / mm_dot;
  view_x2 :=   (ImageWidth  / 2.0) / mm_dot;
  view_y2 :=   (ImageHeight / 2.0) / mm_dot;
end;


//画面の消去
procedure TForm1.CLS;
begin
  PaintBox1.Canvas.Pen.Mode  := pmCopy;
  PaintBox1.Canvas.Pen.Color := clWhite;
  PaintBox1.Canvas.Pen.Style := psSolid;
  PaintBox1.Canvas.Pen.Width := 1;

  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.Rectangle(0, 0, ImageWidth, ImageHeight);
end;


//用紙枠の描画
procedure TForm1.Draw_Paper_Frame;
var
  x1, y1, x2, y2: Integer;
begin
  // 原点の計算
  ox := Round( (0.0 - view_x1) * mm_dot);
  oy := Round(-(0.0 - view_y2) * mm_dot);
  
  // 画面の消去
  CLS;

  // 用紙枠の描画
  x1 := Round( (-PaperWidth /2 - view_x1) * mm_dot);
  y1 := Round(-(-PaperHeight/2 - view_y2) * mm_dot);
  x2 := Round( ( PaperWidth /2 - view_x1) * mm_dot);
  y2 := Round(-( PaperHeight/2 - view_y2) * mm_dot);
  PaintBox1.Canvas.Pen.Color := clBlue;
  PaintBox1.Canvas.Brush.Style := bsClear;
  PaintBox1.Canvas.Rectangle(x1, y1, x2, y2);
end;


procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  cx, cy: Double;
  dx, dy: Double;
begin
  //2倍に拡大
  cx := (view_x1 + view_x2) / 2.0;  // ビュー中央のX座標
  cy := (view_y1 + view_y2) / 2.0;  // ビュー中央のY座標
  dx := Abs(view_x2 - view_x1);
  dy := Abs(view_y2 - view_y1);
  mm_dot := mm_dot * 2.0;
  view_x1 := cx - (dx / 4.0);
  view_y1 := cy - (dy / 4.0);
  view_x2 := cx + (dx / 4.0);
  view_y2 := cy + (dy / 4.0);
  Drawdata;
end;


procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  cx, cy: Double;
  dx, dy: Double;
begin
  // 1/2倍に縮小
  cx := (view_x1 + view_x2) / 2.0;  // ビュー中央のX座標
  cy := (view_y1 + view_y2) / 2.0;  // ビュー中央のY座標
  dx := Abs(view_x2 - view_x1);
  dy := Abs(view_y2 - view_y1);
  mm_dot := mm_dot * 0.5;
  view_x1 := cx - dx;
  view_y1 := cy - dy;
  view_x2 := cx + dx;
  view_y2 := cy + dy;
  Drawdata;
end;


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) or (ssRight in Shift) then
  begin
    DraggingNow := True;
    DragStart_X := X;
    DragStart_Y := Y;
    RubberBandShow := False;
    DragEnd_X := 0;
    DragEnd_Y := 0;

    if (ssLeft  in Shift) then
      DragEnd_X := 1;

    if (ssRight in Shift) then
      DragEnd_Y := 1;
  end;
end;


procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (DraggingNow) then
  begin
    if (RubberBandShow) then
      RubberBand(DragStart_X, DragStart_Y, DragEnd_X, DragEnd_Y);

    if (ssLeft in Shift) and (ssRight in Shift) then
    begin
      RubberBand(DragStart_X, DragStart_Y, X, Y);
      RubberBandShow := True;
      DragEnd_X := X;
      DragEnd_Y := Y;
    end;
  end;
end;


procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  x1, y1, x2, y2: Double;
  cx, cy: Double;
  dx, dy: Double;
  bx, by: Double;
  P1, P2: Double;
begin
  if (DraggingNow) then
  begin
    // ドラッグ処理の終了
    DraggingNow := False;
    if (RubberBandShow) then
      RubberBand(DragStart_X, DragStart_Y, DragEnd_X, DragEnd_Y);

    if (Abs(DragStart_X - X) <= 5) and (Abs(DragStart_Y - Y) <= 5) then
       DragModeKind := 0     // 移動
    else
      begin
        if (DragStart_X <= X) then
          DragModeKind := 1  // 拡大
        else
          DragModeKind := 2; // 縮小
      end;

    x1 := view_x1 + (DragStart_X / mm_dot);
    y1 := view_y2 - (DragStart_Y / mm_dot);
    x2 := view_x1 + (X / mm_dot);
    y2 := view_y2 - (Y / mm_dot);
    dx := Abs(view_x2 - view_x1);
    dy := Abs(view_y2 - view_y1);
    bx := Abs(x1 - x2);
    by := Abs(y1 - y2);
    cx := (x1 + x2) / 2.0;
    cy := (y1 + y2) / 2.0;

    case (DragModeKind) of
      0: begin    // 移動
           cx := (view_x1 +view_x2) / 2.0;
           cy := (view_y1 +view_y2) / 2.0;
           dx := x2 - cx;
           dy := y2 - cy;
           view_x1 := view_x1 + dx;
           view_y1 := view_y1 + dy;
           view_x2 := view_x2 + dx;
           view_y2 := view_y2 + dy;
         end;
      1: begin    // 拡大
           P1 := dx / bx;
           P2 := dy / by;

           if (P1 < P2) then
             mm_dot := mm_dot * P1
           else
             mm_dot := mm_dot * P2;

           view_x1 := cx - ((ImageWidth  / 2.0) / mm_dot);
           view_y1 := cy - ((ImageHeight / 2.0) / mm_dot);
           view_x2 := cx + ((ImageWidth  / 2.0) / mm_dot);
           view_y2 := cy + ((ImageHeight / 2.0) / mm_dot);
         end;
      2: begin    // 縮小
           P1 := bx / dx;
           P2 := by / dy;

           if (P1 > P2) then
             mm_dot := mm_dot * P1
           else
             mm_dot := mm_dot * P2;

           view_x1 := cx - ((ImageWidth  / 2.0) / mm_dot);
           view_y1 := cy - ((ImageHeight / 2.0) / mm_dot);
           view_x2 := cx + ((ImageWidth  / 2.0) / mm_dot);
           view_y2 := cy + ((ImageHeight / 2.0) / mm_dot);
         end;
    end;
    Drawdata;
  end
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Drawdata;
end;


// ラバーバンド長方形描画
procedure TForm1.RubberBand(x1, y1, x2, y2:Integer);
begin
  PaintBox1.Canvas.Pen.Mode := pmXor;
  PaintBox1.Canvas.Pen.Color := clAqua;
  PaintBox1.Canvas.Pen.Width := 0;
  PaintBox1.Canvas.Pen.Style := psSolid;
  PaintBox1.Canvas.Brush.Style := bsClear;
  PaintBox1.Canvas.Rectangle(x1,y1,x2,y2);
end;


// CADデータの描画
procedure TForm1.Drawdata;

  // 座標を変換
  procedure Change_mm_dot(x1, x2, y1, y2: Double;
    var ix1, ix2, iy1, iy2: Integer);
  begin
    ix1 := Round( x1 * mm_dot + ox );
    iy1 := Round(-y1 * mm_dot + oy );
    ix2 := Round( x2 * mm_dot + ox );
    iy2 := Round(-y2 * mm_dot + oy );
  end;

var
  I: Integer;
  x1, x2, y1, y2: Double;
  ix1, ix2, iy1, iy2: Integer;
  Moji: String;
begin
  // 一番肝心な部分ですが、とりあえず線と文字を
  // 単純に描画しています。

  // 用紙枠の描画
  Draw_Paper_Frame;

  PaintBox1.Canvas.Pen.Color := clBlack;
  for I := Low(JWWSen) to High(JWWSen)  do
  begin
    x1 := JWWSen[I].m_start_x;
    y1 := JWWSen[I].m_start_y;
    x2 := JWWSen[I].m_end_x;
    y2 := JWWSen[I].m_end_y;

    // mm→dot変換
    Change_mm_dot(x1, x2, y1, y2, ix1, ix2, iy1, iy2);

    //線の描画
    PaintBox1.Canvas.Pen.Width := 0;
    PaintBox1.Canvas.MoveTo(ix1, iy1);
    PaintBox1.Canvas.LineTo(ix2, iy2);
  end;

  PaintBox1.Canvas.Font.Size := 6;
  for I := Low(JWWMoji) to High(JWWMoji)  do
  begin
    x1 := JWWMoji[I].m_start_x;
    y1 := JWWMoji[I].m_start_y;
    x2 := JWWMoji[I].m_end_x;
    y2 := JWWMoji[I].m_end_y;
    Moji := JWWMoji[I].m_string;

    // mm→dot変換
    Change_mm_dot(x1, x2, y1, y2, ix1, ix2, iy1, iy2);

    //文字の描画
    PaintBox1.Canvas.TextOut(ix1, iy1, Moji);
  end;
end;

end.


☆Jw_cad

☆AFsoft
CADに必要な数学の解説からCADの具体的な実装まで、豊富なDelphiのサンプルと共に詳しく解説されています。 又、JWW用の便利なソフトをたくさん公開しておられます。

☆Peter's Room
jww data read & save unit Ver1.2β
MicroArtsさんが公開されていたJww読込みユニットをPeter.さんが拡張されたものだそうです。
利用に際しては、ユニットの記載内容をお読み下さい。

[20071109訂正]
for I := Low(JWWMoji) to High(JWWMoji) -1 do
for I := Low(JWWSen) to High(JWWSen) -1 do
上記のところ、High関数を使っているのに-1していましたので、-1を削除しました。

|

« ■カテゴリーを変更しました。 | トップページ | ☆TOutlookApplicationを使ってみる。 »