だいぶ出来たと思う。
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)
ButtonGet: TButton;
ButtonSet: TButton;
ButtonExit: TButton;
ButtonSave: TButton;
ButtonLoad: TButton;
StringGrid1: TStringGrid;
GroupBox1: TGroupBox;
ListBox1: TListBox;
ButtonDelete: TButton;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
procedure ButtonGetClick(Sender: TObject);
procedure ButtonSetClick(Sender: TObject);
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);
// procedure ButtonSearchClick(Sender: TObject);
// procedure ButtonSearchClick(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
ICAD: OLEVariant;
ICADHWND: HWND;
MyRowCount: integer;
LayerNum: integer;
IsGet: Boolean;
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;
//IntelliCADが起動しているかをチェック
//StringGridの初期設定
procedure TForm1.FormActivate(Sender: TObject);
begin
ICADHWND := FindWindow('IntelliCADApplicationWindow',nil);
if IsWindow(ICADHWND) then
begin
//IntelliCADを検出
Icad := GetActiveOleObject('ICAD.Application');
//
IsGet := False;
//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;
end
else
begin
ShowMessage('IntelliCADが起動していません。' +#13 + 'DenGasを終了します。');
//アプリケーションの終了
Application.Terminate;
end;
end;
//アクティブな図面のすべてのレイヤー名称、状態を取得
//アクティブな図面に登録されているCSVファイル(レイヤー状態)を検索
procedure TForm1.ButtonGetClick(Sender: TObject);
var
i: integer;
begin
IsGet := True; //最初に<Get>をクリックしないと、<Set>が利用できない
LayerNum := ICAD.ActiveDocument.Layers.Count; //レイヤーの数
StringGrid1.RowCount := LayerNum + 1; //行数の設定
ActName := ICAD.ActiveDocument.FullName;
LabeledEdit2.Text := ActName; //アクティブな図面の名称
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;
SearchLaySt;
LabeledEdit3.Text := 'ActiveDrawing';
end;
//StringGrid(レイヤー状態)をアクティブな図面に反映する
procedure TForm1.ButtonSetClick(Sender: TObject);
var
i: integer;
Lays: OLEVariant;
begin
if IsGet then
begin
Lays := ICAD.ActiveDocument.Layers;
//表示、非表示を設定
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;
Icad.RunCommand('_regen' + #13);
ShowMessage('設定変更を図面に反映しました。');
end
else
ShowMessage('最初に<Get>をクリックして下さい。');
end;
//StringGrid(レイヤー状態)をシングルクリックで切替える
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Column, Row: Longint;
begin
if IsGet then
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
else
ShowMessage('最初に<Get>をクリックして下さい。');
end;
//StringGrid(レイヤー状態)をCSVファイルで保存する
procedure TForm1.ButtonSaveClick(Sender: TObject);
var
F: TextFile; //ファイル変数とファイル型を宣言
i: integer;
begin
if LabeledEdit3.Text <> '' then
begin
//ファイル名を設定する
LayStName := Long_filename(LabeledEdit3.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(LabeledEdit3.Text);
SearchLaySt;
end
else
ShowMessage('レイヤー状態の名称を入力して下さい。');
end;
//CSVファイルを読込んで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);
//レイヤー状態の名前
LabeledEdit3.Text := TempName;
end;
finally
TmpStringList.Free;
CloseFile(F);
end;
end
else
ShowMessage('レイヤー状態を選択して下さい。');
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('削除します。',mtConfirmation,[mbYes,mbCancel],0) = mrYes then
begin
DeleteFile(LayStName);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end
else
ShowMessage('レイヤー状態を選択して下さい。');
end;
//アプリケーションの終了
procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Application.Terminate;
end;
end.
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)
ButtonGet: TButton;
ButtonSet: TButton;
ButtonExit: TButton;
ButtonSave: TButton;
ButtonLoad: TButton;
StringGrid1: TStringGrid;
GroupBox1: TGroupBox;
ListBox1: TListBox;
ButtonDelete: TButton;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
procedure ButtonGetClick(Sender: TObject);
procedure ButtonSetClick(Sender: TObject);
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);
// procedure ButtonSearchClick(Sender: TObject);
// procedure ButtonSearchClick(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
ICAD: OLEVariant;
ICADHWND: HWND;
MyRowCount: integer;
LayerNum: integer;
IsGet: Boolean;
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;
//IntelliCADが起動しているかをチェック
//StringGridの初期設定
procedure TForm1.FormActivate(Sender: TObject);
begin
ICADHWND := FindWindow('IntelliCADApplicationWindow',nil);
if IsWindow(ICADHWND) then
begin
//IntelliCADを検出
Icad := GetActiveOleObject('ICAD.Application');
//
IsGet := False;
//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;
end
else
begin
ShowMessage('IntelliCADが起動していません。' +#13 + 'DenGasを終了します。');
//アプリケーションの終了
Application.Terminate;
end;
end;
//アクティブな図面のすべてのレイヤー名称、状態を取得
//アクティブな図面に登録されているCSVファイル(レイヤー状態)を検索
procedure TForm1.ButtonGetClick(Sender: TObject);
var
i: integer;
begin
IsGet := True; //最初に<Get>をクリックしないと、<Set>が利用できない
LayerNum := ICAD.ActiveDocument.Layers.Count; //レイヤーの数
StringGrid1.RowCount := LayerNum + 1; //行数の設定
ActName := ICAD.ActiveDocument.FullName;
LabeledEdit2.Text := ActName; //アクティブな図面の名称
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;
SearchLaySt;
LabeledEdit3.Text := 'ActiveDrawing';
end;
//StringGrid(レイヤー状態)をアクティブな図面に反映する
procedure TForm1.ButtonSetClick(Sender: TObject);
var
i: integer;
Lays: OLEVariant;
begin
if IsGet then
begin
Lays := ICAD.ActiveDocument.Layers;
//表示、非表示を設定
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;
Icad.RunCommand('_regen' + #13);
ShowMessage('設定変更を図面に反映しました。');
end
else
ShowMessage('最初に<Get>をクリックして下さい。');
end;
//StringGrid(レイヤー状態)をシングルクリックで切替える
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Column, Row: Longint;
begin
if IsGet then
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
else
ShowMessage('最初に<Get>をクリックして下さい。');
end;
//StringGrid(レイヤー状態)をCSVファイルで保存する
procedure TForm1.ButtonSaveClick(Sender: TObject);
var
F: TextFile; //ファイル変数とファイル型を宣言
i: integer;
begin
if LabeledEdit3.Text <> '' then
begin
//ファイル名を設定する
LayStName := Long_filename(LabeledEdit3.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(LabeledEdit3.Text);
SearchLaySt;
end
else
ShowMessage('レイヤー状態の名称を入力して下さい。');
end;
//CSVファイルを読込んで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);
//レイヤー状態の名前
LabeledEdit3.Text := TempName;
end;
finally
TmpStringList.Free;
CloseFile(F);
end;
end
else
ShowMessage('レイヤー状態を選択して下さい。');
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('削除します。',mtConfirmation,[mbYes,mbCancel],0) = mrYes then
begin
DeleteFile(LayStName);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end
else
ShowMessage('レイヤー状態を選択して下さい。');
end;
//アプリケーションの終了
procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Application.Terminate;
end;
end.
※コメント投稿者のブログIDはブログ作成者のみに通知されます