DenGas作成ノート8

少し、スリムにした。

unit UnitDenGas;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComObj, StdCtrls, ExtDlgs, ExtCtrls, FileCtrl, Grids, ImgList,ShellApi;
type
TForm1 = class(TForm)
ButtonExit: TButton;
ButtonSave: TButton;
ButtonLoad: TButton;
StringGrid1: TStringGrid;
GroupBox1: TGroupBox;
ListBox1: TListBox;
ButtonDelete: TButton;
LabeledEdit1: TLabeledEdit;
procedure FormActivate(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
procedure ButtonSaveClick(Sender: TObject);
procedure ButtonLoadClick(Sender: TObject);
procedure ButtonDeleteClick(Sender: TObject);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form1: TForm1;
ICAD: OLEVariant;
ICADHWND: HWND;
MyRowCount: integer;
LayerNum: integer;
IsRight : boolean;
ActName : string; //アクティブな図面のファイル名称(フルパス）
LayStName : string;//CSVファイル(レイヤー状態)名称（フルパス）
implementation

{$R *.dfm}

//レイヤー状態名称からCSVファイル名称を求める
function Long_filename(Short_name : string) : string;
var
TempName1,TempName2 : string;
//ファイル名を設定する
begin
TempName1 := ChangeFileExt(ActName,''); //拡張子を取り除く
TempName2 := Short_name;
TempName1 := TempName1 + '_DenGas_' + TempName2;
TempName1 := ChangeFileExt(TempName1,'.csv'); //拡張子をcsvとする
Result := TempName1;
end;

// アクティブな図面に登録されているCSVファイル(レイヤー状態）を検索
procedure SearchLaySt;
var
TempName1,TempName2,TempName3,TempName4: string;
searchResult : TSearchRec;
x : integer;
begin
Form1.ListBox1.Items.Clear;
TempName1 := ChangeFileExt(ActName,''); //拡張子を取り除く
TempName2 := TempName1 + '_DenGas_' + '*' + '.csv'; //拡張子が"csv"のファイルを検索
if FindFirst(TempName2,faAnyFile,searchResult) = 0 then
begin
repeat
TempName3 := searchResult.Name;
x := Pos('_DenGas_',TempName3);
Delete(TempName3,1,x + 7);
TempName4 := ChangeFileExt(TempName3,''); //拡張子を取り除く
Form1.ListBox1.Items.Add(TempName4) ;
until FindNext(searchResult) <> 0;
FindClose(searchResult);
end
else
ShowMessage('レイヤー状態は保存されていません。');

end;

//アクティブな図面のすべてのレイヤー名称、状態を取得
procedure GetLaySt;
var
i: integer;
begin
LayerNum := ICAD.ActiveDocument.Layers.Count; //レイヤーの数
Form1.StringGrid1.RowCount := LayerNum + 1; //行数の設定
ActName := ICAD.ActiveDocument.FullName; //アクティブな図面のファイル名
with Form1 do
begin
for i :=1 to LayerNum do //レイヤー名称
begin
StringGrid1.Cells[0,i] := ICAD.ActiveDocument.Layers.Item(i).Name;
end;

for i := 1 to LayerNum do //表示(-1)、非表示(0)
begin
IsRight := ICAD.ActiveDocument.Layers.Item(i).LayerOn;
case IsRight of
True: StringGrid1.Cells[1,i] := 'On';
False:StringGrid1.Cells[1,i] := 'Off';
end;
end;

for i := 1 to LayerNum do //ロック(-1),非ロック(0)
begin
IsRight := ICAD.ActiveDocument.Layers.Item(i).Lock;
case IsRight of
True: StringGrid1.Cells[2,i] := 'Yes';
False:StringGrid1.Cells[2,i] := 'No';
end;
end;
end;

end;

//StringGrid(レイヤー状態)をアクティブな図面に反映する
procedure SetLayer;
var
i: integer;
Lays: OLEVariant;
begin
Lays := ICAD.ActiveDocument.Layers;

with Form1 do
begin
//表示、非表示を設定
for i := 1 to LayerNum do
begin
if StringGrid1.Cells[1,i] = 'On' then Lays.Item(i).LayerOn := True
else if StringGrid1.Cells[1,i] = 'Off' then Lays.Item(i).LayerOn := False;
end;

//ロック、非ロックを設定
for i := 1 to LayerNum do
begin
if StringGrid1.Cells[2,i] = 'Yes' then Lays.Item(i).Lock := True
else if StringGrid1.Cells[2,i] = 'No' then Lays.Item(i).Lock := False;
end;
end;

Icad.RunCommand('_regen' + #13);
ShowMessage('設定変更を図面に反映しました。');

end;

//IntelliCADが起動しているかをチェック
//StringGridの初期設定
//アクティブな図面のすべてのレイヤー名称、状態を取得
//アクティブな図面に登録されているCSVファイル(レイヤー状態）を検索
procedure TForm1.FormActivate(Sender: TObject);
begin
ICADHWND := FindWindow('IntelliCADApplicationWindow',nil);

if IsWindow(ICADHWND) then
begin
//IntelliCADを検出
Icad := GetActiveOleObject('ICAD.Application');

//StringGridの初期設定
MyRowCount := 10;
with StringGrid1 do
begin
RowCount := MyRowCount; //行数
ColCount := 3; //列数
FixedRows := 1; //固定行の数
FixedCols := 0; //固定列の数
Width := 463;
Height := 300;
ColWidths[0] := 300;
ColWidths[1] := 70;
ColWidths[2] := 70;
Cells[0,0] := 'Layer Name';
Cells[1,0] := 'On/Off';
Cells[2,0] := 'Locked';
end;
//アクティブな図面のすべてのレイヤー名称、状態を取得
GetLaySt;

//アクティブな図面に登録されているCSVファイル(レイヤー状態）を検索
SearchLaySt;

end
else
begin
ShowMessage('IntelliCADが起動していません。' +#13 + 'DenGasを終了します。');

//アプリケーションの終了
Application.Terminate;
end;
end;


//StringGrid(レイヤー状態)をシングルクリックで切替える
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Column, Row: Longint;
begin
StringGrid1.MouseToCell(X, Y, Column, Row);
if (Row >= 1) or (Column >= 1) then //固定行、レイヤー名称の修正禁止
begin //シングルクリックでトグル操作
with StringGrid1 do
begin
if Cells[Column,Row] = 'On' then Cells[Column,Row] := 'Off'
else if Cells[Column,Row] = 'Off' then Cells[Column,Row] := 'On'
else if Cells[Column,Row] = 'Yes' then Cells[Column,Row] := 'No'
else if Cells[Column,Row] = 'No' then Cells[Column,Row] := 'Yes';
end;
end;
end;

//StringGrid（レイヤー状態）をCSVファイルで保存する
procedure TForm1.ButtonSaveClick(Sender: TObject);
var
F: TextFile; //ファイル変数とファイル型を宣言
i: integer;
begin
if LabeledEdit1.Text <> '' then
begin
//ファイル名を設定する
LayStName := Long_filename(LabeledEdit1.Text);

//CSVファイルで保存する
AssignFile(F,LayStName); //ファイルをファイル変数に結び付ける
Rewrite(F); //新規にファイルを作って開く
try
for i := 1 to StringGrid1.RowCount - 1 do
writeln(F,StringGrid1.Rows[i].commatext);
finally
CloseFile(F); //ファイルを閉じる
end;
ListBox1.Items.Add(LabeledEdit1.Text);

// アクティブな図面に登録されているCSVファイル(レイヤー状態）を検索
SearchLaySt;

//StringGrid(レイヤー状態)をアクティブな図面に反映する
SetLayer;

LabeledEdit1.Clear;
end
else
ShowMessage('StatusNameを入力して下さい。');
end;

//CSVファイルを読込んでStringGrid（レイヤー状態）へ表示
//StringGrid(レイヤー状態)をアクティブな図面に反映する
procedure TForm1.ButtonLoadClick(Sender: TObject);
var
SelIndex : integer; //選択されたレイヤー状態名
F: TextFile; //ファイル変数とファイル型を宣言
i: integer;
TempName: string;
TmpStringList: TStringList;
TxtLineData: String;
begin
if ListBox1.ItemIndex >= 0 then
begin
//ファイル名を設定する
SelIndex := ListBox1.ItemIndex;
TempName := ListBox1.Items.Strings[SelIndex];
LayStName := Long_filename(TempName);

//CSVファイルを読込む
i := 1; //最初の行　
//横の列の数を合わせるための1次的なデータ格納場所
TmpStringList := TStringList.Create;

AssignFile(F, LayStName);
Reset(F);
try
while not SeekEof(F) do //ファイルの終わりまで続ける
begin
ReadLn(F, TxtLineData);//1行読み込み

//1行のCSV形式のデータを1つ1つのデータに分解する
//（このCommaTextプロパティに1行のCSVデータを入れると
//自動的に分解されて配列のように扱える）
TmpStringList.CommaText := TxtLineData;

//このif文は読み取ったファイルのデータの数（横の列の数）
//の最大値をグリッドのColにあわせる
if TmpStringList.Count > StringGrid1.ColCount then
begin
StringGrid1.ColCount := TmpStringList.Count;
end;

//グリッドの行の数を読み込んだファイルの行の数に合わせて増やす
StringGrid1.RowCount := i + 1;

//文字列のコピー
StringGrid1.Rows[i].Assign(TmpStringList);
Inc(i);

end;
finally
TmpStringList.Free;
CloseFile(F);
SetLayer;
end;
end
else
ShowMessage('LayerStatusを選択して下さい。');

end;

//CSVファイル（レイヤー状態）を削除
procedure TForm1.ButtonDeleteClick(Sender: TObject);
var
SelIndex : integer; //選択されたレイヤー状態名
TempName: string;
begin
if ListBox1.ItemIndex >= 0 then
begin
//ファイル名を設定する
SelIndex := ListBox1.ItemIndex;
TempName := ListBox1.Items.Strings[SelIndex];
LayStName := Long_filename(TempName);

//ファイルを削除する
if MessageDlg('LayerStatusを削除します。',mtConfirmation,[mbYes,mbCancel],0) = mrYes then
begin
DeleteFile(LayStName);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end
else
ShowMessage('LayerStatusを選択して下さい。');
end;

//アプリケーションの終了
procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Application.Terminate;
end;


end.