☆JWWファイルの超簡易表示: Delphi-fan

☆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\Ａﾏﾝｼｮﾝ平面例.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を削除しました。

2007.07.22 JWW | 固定リンク
Tweet

バックナンバー

お気に入り

AFsoft World
AFSoftさんのブログです。ホームページの方では、CADに必要な数学の解説からDelphiによる具体的な実装まで、豊富なサンプルと共に詳しく解説されています。又、JWW用の便利なソフトをたくさん公開しておられます。
Delphi Library [Mr.XRAY]
Excelの操作を始め、Delphiでのいろいろな処理を丁寧にわかりやすくまとめられておられます。又、Halbow資料館として、メーリングリストでもご活躍されたHalbowさんによるホームページ(Win32 API by Object Pascal of Delphi)を公開されておられます。
Embarcadero Blogs - Team Japan
Embarcaderoの日本人スタッフによるブログです。
Embarcadero日本語トップページ
ＤＥＫＯのアヤシいお部屋。
Unicodeに関する詳細な解説を始め「Delphi によるテクニック＆アルゴリズム」には、様々な情報が見やすくまとめられています。

@niftyが提供する
無料ブログはココログ！

Delphi-fan

カテゴリー

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

最近の記事

バックナンバー

お気に入り

Delphi-fan

SyntaxHighlighter.config.bloggerMode = true; SyntaxHighlighter.all();

カテゴリー

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

最近の記事

バックナンバー

お気に入り