☆ファイルの所属するフォルダ名を取得

ファイルが所属するフォルダ名を取得する処理です。
例えば、『C:\Program Files\CodeGear\RAD Studio\5.0\bin\bds.exe』の場合、『bin』を取得します。 当初、ExtractFilePathでパスを取得して文字列を分解していましたが、次のような処理で簡単にできました。

procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
begin
  if OpenDialog1.Execute then
  begin
    S := OpenDialog1.FileName;
    ShowMessage(ExtractFileName(ExtractFileDir(S)));
  end;
end;

※ExtractFilePathではなくExtractFileDirを使うのがポイントです。

☆スクリーンショットを無効にする。

会社のパソコンでスクリーンショットが撮れず、いろいろ調べた結果、自作のソフトが原因だとわかりました。 もう何年も昔に作ったもので、スクリーンショットを無効にするような機能を実装していたなんてすっかり忘れていました。プログラム中にPC-98用、DOS/V用なんてコメントもあってなんか懐かしかったです。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  SnapShot1 = 1;
  SnapShot2 = 2;
  SnapShot3 = 3;
  SnapShot4 = 4;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  if Msg.HotKey in [SnapShot1, SnapShot2, SnapShot3, SnapShot4] then
  begin
    Msg.Msg :=0;
    Msg.HotKey :=0;
    Msg.Unused :=0;
    Msg.Result :=0;
    ShowMessage('スクリーンショットは無効です');
  end;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotkey(Handle, SnapShot1, 0          , VK_SNAPSHOT);
  RegisterHotkey(Handle, SnapShot2, MOD_SHIFT  , VK_SNAPSHOT);
  RegisterHotkey(Handle, SnapShot3, MOD_CONTROL, VK_SNAPSHOT);
  RegisterHotkey(Handle, SnapShot4, MOD_ALT    , VK_SNAPSHOT);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotkey(Handle, SnapShot1);
  UnRegisterHotkey(Handle, SnapShot2);
  UnRegisterHotkey(Handle, SnapShot3);
  UnRegisterHotkey(Handle, SnapShot4);
end;

end.

■December 2007 Update

スタートメニューからアップデートの確認を行うと次のような画面が表示されましたので、早速アップデートを行いました。（Update3がインストールされている必要があります）

きちんとアップデートされているようです。

しかしながら新規にVCLフォームアプリケーションを作成し、コンパイルすると 次のようなメッセージが出てコンパイルできませんでした。 時間があるときにチェックしてみようと思います。
→解決方法については、この記事の最後にある追記をご覧下さい。

[再チャレンジ]
RADStudioDec2007setup.exeをダウンロードして、再度インストールしてみたところ、きちんと動作しました。 （インストールに失敗していたようですね）
変更内容をまだ確認できていませんが、コンテキストメニューも表示されるようになりました。


RAD Studio 2007、Delphi 2007 for Win32 および C++Builder 2007 アップデート（December 2007 Update）リリースノート
http://dn.codegear.com/jp/article/37443/

---

[20071219追記]
上記のようなエラーメッセージが表示された場合、某所さんのところに解決方法があります。 きちんと調べずに再インストールしているようではいけないですね(^^;

某所 | 避難所
December 2007 Update リリース
http://bousyo.blog45.fc2.com/blog-entry-182.html

■CodeGear ロゴ

CodeGearのWebサイトで、CodeGear製品を利用して作成したアプリケーションやWebサイト用のロゴが公開されています。

CodeGear 「built with」「powered by」ロゴ
http://dn.codegear.com/article/37477

■TMS Advanced ToolBars & Menusアップデート

TMS Advanced ToolBars & Menus が v3.0.5.0 から v3.5.0.0 にアップデートされました。

メーカーホームページからの引用です。

in v3.5.0.0
- New : TAdvStickyPopupMenu component
- New : mousewheel support in TAdvToolBarPager
- New : public event OnCompactCloseQuery added in TAdvToolBar
- New : TGDIPicture.Assign function works with TPicture / TBitmap
- New : article on using TAdvStickyPopupMenu
- Improved : handling of Unicode captions in TAdvGlowButton
- Fixed : issue with loading position & invisible toolbar controls
- Fixed : issue with toolbar menu positioning with shortcuts on form right-side
- Fixed : small issue with selection of menus on toolbars


tmssoftware.com

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

前回、前々回のTreeViewのチェックボックスとボールド表示を使ってレイヤーの表示／非表示部分を作ってみました。 例によってPeter.さんの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;
    TreeView1: TTreeView;
    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);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    ox, oy: Integer;                   // 原点
    ImageWidth,ImageHeight: Integer;   // 画面ドットサイズ = PaintBox1のサイズ
    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);   // 用紙サイズの設定
    procedure SetLayerName;                       // レイヤー名の設定
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Commctrl, jwwunit;

const
  TVIS_CHECKED  = $2000;

// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
var
  FileName: String;
  WindowStyles: Integer;
begin
  // TreeViewにCheckBoxを表示させます。
  WindowStyles := GetWindowLong(TreeView1.Handle, GWL_STYLE);
  SetWindowLong(TreeView1.Handle, GWL_STYLE, WindowStyles or TVS_CHECKBOXES);

  // 初期化
  DraggingNow := False;
  RubberBandShow := False;

  // ファイルの読み込み
  FileName := 'c:\jww\Ａﾏﾝｼｮﾝ平面例.jww';

  JWWBlockList := TJWWBlockList.Create;

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

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

  // mm_dot比の計算
  Calc_mm_dot;

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

  // レイヤー名及び表示/非表示の設定
  SetLayerName;
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
  上記以外は、A0サイズとする。サイズを調べるのが面倒だから(^^;
}
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;
  else
    PaperWidth  :=1189;
    PaperHeight := 841;
  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;
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;

    //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;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  cx, cy: Double;
  dx, dy: Double;
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;

    // 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;
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;

  // 線及び円弧の線種・線色の設定
  procedure LineSetting(Root: CData);
  begin
    // ペンの太さ
    PaintBox1.Canvas.Pen.width := 0;
    // ペンのスタイル
    case Root.m_nPenStyle of
      1: PaintBox1.Canvas.Pen.Style := psSolid;
      2,3,4,9: PaintBox1.Canvas.Pen.Style := psDot;
      5,6,7,8: PaintBox1.Canvas.Pen.Style := psDashDot;
    end;
    // ペンの色
    case Root.m_nPenColor of
      1: PaintBox1.Canvas.Pen.Color := RGB(0,192,192);
      2: PaintBox1.Canvas.Pen.Color := clBlack;
      3: PaintBox1.Canvas.Pen.Color := RGB(0,192,0);
      4: PaintBox1.Canvas.Pen.Color := RGB(192,192,0);
      5: PaintBox1.Canvas.Pen.Color := RGB(192,0,192);
      6: PaintBox1.Canvas.Pen.Color := RGB(0,0,255);
      7: PaintBox1.Canvas.Pen.Color := RGB(0,128,128);
      8: PaintBox1.Canvas.Pen.Color := RGB(255,0,128);
      9: PaintBox1.Canvas.Pen.Color := RGB(255,128,255);
    end;
  end;

  // フォントの設定
  procedure FontSetting(ACDataMoji: CDataMoji);
  begin
    // フォント名
    PaintBox1.Canvas.Font.Name := ACDataMoji.m_strFontName;
    // フォントの高さ
    PaintBox1.Canvas.Font.Height := Round(ACDataMoji.m_dSizeY * mm_dot);
    // フォントの色
    case JWWHd.m_Moji[ACDataMoji.m_nMojiShu].m_anMojiCol of
      1: PaintBox1.Canvas.Font.Color := RGB(0,192,192);
      2: PaintBox1.Canvas.Font.Color := clBlack;
      3: PaintBox1.Canvas.Font.Color := RGB(0,192,0);
      4: PaintBox1.Canvas.Font.Color := RGB(192,192,0);
      5: PaintBox1.Canvas.Font.Color := RGB(192,0,192);
      6: PaintBox1.Canvas.Font.Color := RGB(0,0,255);
      7: PaintBox1.Canvas.Font.Color := RGB(0,128,128);
      8: PaintBox1.Canvas.Font.Color := RGB(255,0,128);
      9: PaintBox1.Canvas.Font.Color := RGB(255,128,255);
    end;
  end;

  // レイヤーの表示/非表示
  function LayerCheck(Root: CData): Boolean;
  var
    I, J: Integer;
    F1, F2: Boolean;
  begin
    I := Root.m_nGLayer; // レイヤーグループ
    J := Root.m_nLayer;  // レイヤー
    F1 := JWWHd.GLay[I].m_anGLay <> 0;
    F2 := JWWHd.GLay[I].m_nLay[J].m_aanLay <> 0;
    Result := F1 and F2;
  end;

  // 補助線かどうか
  function IsSupportLine(Root: CData): Boolean;
  begin
    Result := (Root.m_nPenStyle = 9);
  end;

var
  I: Integer;
  x1, x2, y1, y2, Hankei: Double;
  ix1, ix2, iy1, iy2: Integer;
  Moji: String;
  Hajime, Owari: Double;
  wx1,wy1,wx2,wy2 : Double ;
  ax3,ay3,ax4,ay4 : integer ;
  LF: TLogFont;
begin
  // 用紙枠の描画
  Draw_Paper_Frame;

  // 線の描画
  PaintBox1.Canvas.Pen.Color := clBlack;
  for I := Low(JWWSen) to High(JWWSen) do
  begin
    if (not IsSupportLine(JWWSen[I].Root)) and LayerCheck(JWWSen[I].Root) then
    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);

      // 線の設定
      LineSetting(JWWSen[I].Root);

      //線の描画
      PaintBox1.Canvas.MoveTo(ix1, iy1);
      PaintBox1.Canvas.LineTo(ix2, iy2);
    end;
  end;

  // 円弧の描画
  for I := Low(JWWEnko) to High(JWWEnko) do
  begin
    if (not IsSupportLine(JWWEnko[I].Root)) and LayerCheck(JWWEnko[I].Root) then
    begin
      x1 := JWWEnko[I].m_start_x;
      y1 := JWWEnko[I].m_start_y;
      Hankei := JWWEnko[I].m_dHankei;
      Hajime := JWWEnko[I].m_radKaishiKaku + JWWEnko[I].m_radKatamukiKaku;
      Owari :=  JWWEnko[I].m_radKaishiKaku + JWWEnko[I].m_radEnkoKaku +
        JWWEnko[I].m_radKatamukiKaku;
      if JWWEnko[I].m_radKatamukiKaku < 0 then
      begin
        wx1 := X1-Hankei*JWWEnko[I].m_dHenpeiRitsu;
        wy1 := Y1-Hankei;
        wx2 := X1+Hankei*JWWEnko[I].m_dHenpeiRitsu;
        wy2 := Y1+Hankei;
      end
      else
      begin
        wx1 := X1-Hankei;
        wy1 := Y1-Hankei*JWWEnko[I].m_dHenpeiRitsu;
        wx2 := X1+Hankei;
        wy2 := Y1+Hankei*JWWEnko[I].m_dHenpeiRitsu;
      end;

      // 円弧の設定
      LineSetting(JWWEnko[I].Root);

      // mm→dot変換
      Change_mm_dot(wx1, wx2, wy1, wy2, ix1, ix2, iy1, iy2);

      // 円弧の描画
      if JWWEnko[I].m_bZenEnFlg = 1 then
        PaintBox1.Canvas.Ellipse(ix1, iy1,ix2,iy2)  //円
      else
      begin
        ax3 := Round( ((x1+Hankei*Cos(Hajime)))*MM_dot+ox);
        ay3 := Round(-((y1+Hankei*Sin(Hajime)))*MM_dot+oy);
        ax4 := Round( ((x1+Hankei*Cos(Owari )))*MM_dot+ox);
        ay4 := Round(-((y1+Hankei*Sin(Owari )))*MM_dot+oy);

        if (ax3 <> ax4) or (ay3 <> ay4) then
        begin
          if (JWWEnko[I].m_radEnkoKaku < 0) then
            PaintBox1.Canvas.Arc(ix1,iy1,ix2,iy2,ax4,ay4,ax3,ay3)
          else
            PaintBox1.Canvas.Arc(ix1,iy1,ix2,iy2,ax3,ay3,ax4,ay4);
        end;
      end;
    end;
  end;

  // 文字の描画
  for I := Low(JWWMoji) to High(JWWMoji) do
  begin
    if LayerCheck(JWWMoji[I].Root) then
    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);

      // フォントの設定
      FontSetting(JWWMoji[I]);

      // 文字の描画
      GetObject(PaintBox1.Canvas.Font.Handle, SizeOf(LF), @LF);
      SetTextAlign(PaintBox1.Canvas.Handle,TA_LEFT or TA_BOTTOM);
      LF.lfEscapement := Round(JWWMoji[I].m_degKakudo*10);
      PaintBox1.Canvas.Font.Handle := CreateFontIndirect(LF);
      PaintBox1.Canvas.TextOut(ix1,iy1,moji);
    end;
  end;
end;


// レイヤー名及び表示/非表示の設定
procedure TForm1.SetLayerName;

  // ノードのチェックボックス設定
  procedure NodeCheckBox(Node: TTreeNode; F: Boolean);
  var
    TvItem: TTVItem;
  begin
    TvItem.hItem := Node.ItemId;
    TvItem.stateMask := TVIS_STATEIMAGEMASK;
    TvItem.mask := TVIF_HANDLE or TVIF_STATE;
    TvItem.state := TVIS_CHECKED;
    TreeView_SetItem(TreeView1.Handle, TvItem);
  end;

  // 太字設定
  procedure SetBold(Node: TTreeNode);
  var
    TvItem: TTVItem;
  begin
    TvItem.hItem := Node.ItemId;
    TvItem.stateMask := TVIS_BOLD;
    TvItem.mask := TVIF_HANDLE or TVIF_STATE;
    TvItem.state := TVIS_BOLD;
    TreeView_SetItem(TreeView1.Handle, TvItem);
  end;

var
  I, J, K, SNo, ENo: Integer;
  NodeA, NodeB: TTreeNode;
  LayerNo, Scale, LayerName: String;
  F: Boolean;
begin
  TreeView1.Items.BeginUpdate;
  try
    TreeView1.Items.Clear;
    // レイヤーグループの設定
    for I := Low(JWWHd.m_aStrGLayName) to High(JWWHd.m_aStrGLayName) do
    begin
      // レイヤーグループ番号
      LayerNo := '[' + IntToHex(I, 1) +'] ';
      // 縮尺
      if JWWHd.GLay[I].m_adScale < 1 then
        Scale := IntToStr(Round(1 / JWWHd.GLay[I].m_adScale)) + '/1'
      else
        Scale := '1/'+ IntToStr(Trunc(JWWHd.GLay[I].m_adScale));

      // レイヤーグループ名
      LayerName := ' ' + JWWHd.m_aStrGLayName[I];

      // ノードの追加及び表示/非表示の設定
      NodeA := TreeView1.Items.Add(nil, LayerNo + Scale + LayerName);
      F := JWWHd.GLay[I].m_anGLay <> 0;
      NodeCheckBox(NodeA, F);
      SetBold(NodeA);

      // レイヤーの設定
      SNo := I * 16;   // 読み取り開始番号
      ENo := SNo + 15; // 読み取り終了番号
      for J := SNo to ENo do
      begin
        K := J - SNo;
        LayerNo := '[' + IntToHex(K, 1) +'] ';       // レイヤーグループ番号
        LayerName := ' ' + JWWHd.m_aStrLayName[J];   // レイヤー名
        // ノードの追加及び表示/非表示の設定
        NodeB := TreeView1.Items.AddChild(NodeA, LayerNo + LayerName);
        F := JWWHd.GLay[I].m_nLay[K].m_aanLay <> 0;
        NodeCheckBox(NodeB, F);
      end;
    end;
  finally
    TreeView1.Items.EndUpdate;
  end;
end;

procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  lpht: TTVHitTestInfo;
  Node: TTreeNode;
  I,J, K: Integer;
begin
  // クリックした位置のノードを取得します。
  Node := TreeView1.GetNodeAt(X, Y);
  if Node = nil then Exit;

  // クリックした位置がチェックボックス上からどうかを調べます。
  lpht.pt.x := X;
  lpht.pt.y := Y;
  TreeView_HitTest(TreeView1.Handle, lpht);

  if lpht.flags = TVHT_ONITEMSTATEICON then
  begin
    if TreeView_GetCheckState(TreeView1.Handle, Node.ItemId) > 0 then
      K := 1
    else
      K := 0;

    if Node.Level = 0 then
    begin
      I := Node.AbsoluteIndex mod 16;
      JWWHd.GLay[I].m_anGLay := K;
    end
    else
    begin
      I := Node.Parent.AbsoluteIndex mod 16;
      J := Node.Index;
      JWWHd.GLay[I].m_nLay[J].m_aanLay := K;
    end;
    PaintBox1.Invalidate;
  end;
end;

end.

[20071210NodeCheckBox手続きを訂正]
今、ふと見るとパラメーターFが無視されてました。下記のように訂正します。

  // ノードのチェックボックス設定
  procedure NodeCheckBox(Node: TTreeNode; F: Boolean);
  var
    TvItem: TTVItem;
  begin
    TvItem.hItem := Node.ItemId;
    TvItem.stateMask := TVIS_STATEIMAGEMASK;
    TvItem.mask := TVIF_HANDLE or TVIF_STATE;
    if F then
      TvItem.state := TVIS_CHECKED
    else
      TvItem.state := TVIS_CHECKED shr 1;
    TreeView_SetItem(TreeView1.Handle, TvItem);
  end;

あるいは、パラメーターFを削除して、レイヤーを表示する場合のみ呼び出した方がいいのかも知れませんね。 （チェックボックスを設定した時には、チェックが外れているから）

☆TreeViewのノードを太字にする。

TreeViewのチェックボックスを設定する処理を模索していたときに見つけたTVIS_BOLD。 これを使うと、以下の処理で確かに太字になるのですが、使い方が正しいかどうかは不明です(^^;

uses CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);

  procedure SetBold(Node: TTreeNode);
  var
    TvItem: TTVItem;
  begin
    TvItem.hItem := Node.ItemId;
    TvItem.stateMask := TVIS_BOLD;
    TvItem.mask := TVIF_HANDLE or TVIF_STATE;
    TvItem.state := TVIS_BOLD;
    TreeView_SetItem(TreeView1.Handle, TvItem);
  end;

var
  I: Integer;
  Node: TTreeNode;
begin
  for I := 0 to 10 do
  begin
    Node := TreeView1.Items.Add(nil, 'Item'+IntToStr(I));
    SetBold(Node);
  end;
end;

☆TreeViewのチェックボックスを設定する。

☆TreeViewにチェックボックスを表示する。では、 マウスによりチェックボックスを設定しましたが、 今回はプログラムからの設定を試してみました。

// チェックする
procedure TForm1.Button1Click(Sender: TObject);
var
  TvItem: TTVItem;
  Node: TTreeNode;
begin
  Node := TreeView1.Selected;
  if Node = nil then Exit;

  TvItem.hItem := Node.ItemId;
  TvItem.stateMask := TVIS_STATEIMAGEMASK;
  TvItem.mask := TVIF_HANDLE or TVIF_STATE;
  TvItem.state := TVIS_CHECKED;
  TreeView_SetItem(TreeView1.Handle, TvItem);
end;

// チェックを外す
procedure TForm1.Button2Click(Sender: TObject);
var
  TvItem: TTVItem;
  Node: TTreeNode;
begin
  Node := TreeView1.Selected;
  if Node = nil then Exit;

  TvItem.hItem := Node.ItemId;
  TvItem.stateMask := TVIS_STATEIMAGEMASK;
  TvItem.mask := TVIF_HANDLE or TVIF_STATE;
  TvItem.state := TVIS_CHECKED shr 1;
  TreeView_SetItem(TreeView1.Handle, TvItem);
end;

// チェックされているかどうかを調べる
procedure TForm1.Button3Click(Sender: TObject);
var
  Node: TTreeNode;
begin
  Node := TreeView1.Selected;
  if Node = nil then Exit;

  if TreeView_GetCheckState(TreeView1.Handle, Node.ItemId) > 0 then
    ShowMessage('Checked')
  else
    ShowMessage('Not Checked');
end;