Grossa Speaks Final

コンピュータに関するテーマを
気の向くまま取り上げています。
(時々雑談...)

DenGas作成ノート6

2007年01月09日 | Programming
だいぶ出来てきた。
削除のコードがまだ。また、同じ事をしている部分を関数化要。
------Start of Code
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;
Label1: TLabel;
Edit1: TEdit;
StringGrid1: TStringGrid;
GroupBox1: TGroupBox;
ListBox1: TListBox;
ButtonDelete: TButton;
LabeledEdit1: 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);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form1: TForm1;
ICAD: OLEVariant;
ICADHWND: HWND;
MyRowCount: integer;
LayerNum: integer;
IsGet: Boolean;
IsRight : boolean;
ActName : string; //アクティブな図面のファイル名
LayStName : string;//レイヤー状態のファイル名
implementation

{$R *.dfm}

//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 := 178;
ColWidths[0] := 300;
ColWidths[1] := 70;
ColWidths[2] := 70;
Cells[0,0] := 'Layer Name';
Cells[1,0] := 'On/Off';
Cells[2,0] := 'Locked';
end;

ShowMessage('アクティブな図面のレイヤー状態を取得するには' + #13
+ '<Get>をクリックして下さい。');
end
else
begin
ShowMessage('IntelliCADが起動していません。' +#13 + 'DenGasを終了します。');

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

//アクティブな図面のすべてのレイヤー名称、状態を取得
procedure TForm1.ButtonGetClick(Sender: TObject);
var
i,x: integer;
TempName1,TempName2,TempName3,TempName4: string;
searchResult : TSearchRec;
begin
IsGet := True; //最初に<Get>をクリックしないと、<Set>が利用できない
LayerNum := ICAD.ActiveDocument.Layers.Count; //レイヤーの数
StringGrid1.RowCount := LayerNum + 1; //行数の設定
//StringGrid1.Height := StringGrid1.RowCount * 24;
ActName := ICAD.ActiveDocument.FullName;
Edit1.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;

// アクティブな図面に登録されているCSVファイル(レイヤー状態)を検索
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,''); //拡張子を取り除く
ListBox1.Items.Add(TempName4) ;
until FindNext(searchResult) <> 0;
FindClose(searchResult);
end
else
ShowMessage('レイヤー状態は保存されていません。');

ShowMessage('アクティブな図面のレイヤー状態を取得しました。' +#13
+ 'セルをクリックするとOn/Off,Yes/Noが切替わります。');

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;
TempName1,TempName2: string;
begin
if LabeledEdit1.Text <> '' then
begin
//ファイル名を設定する
TempName1 := ChangeFileExt(ActName,''); //拡張子を取り除く
TempName2 := LabeledEdit1.Text;
TempName1 := TempName1 + '_DenGas_' + TempName2;
TempName1 := ChangeFileExt(TempName1,'.csv'); //拡張子をcsvとする
LayStName := TempName1; //レイヤー状態のファイル名(フルパス)

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

ShowMessage(LayStName + #13 + 'というファイル名で保存しました。');
LabeledEdit1.Clear;
end
else
ShowMessage('レイヤー状態の名称を入力して下さい。');
end;

//CSVファイルを読込んでStringGrid(レイヤー状態)へ表示
procedure TForm1.ButtonLoadClick(Sender: TObject);
var
SelIndex : integer; //選択されたレイヤー状態名
F: TextFile; //ファイル変数とファイル型を宣言
i: integer;
TempName1,TempName2: string;
TmpStringList: TStringList;
TxtLineData: String;
begin
if ListBox1.ItemIndex >= 0 then
begin
//ファイル名を設定する
TempName1 := ChangeFileExt(ActName,''); //拡張子を取り除く
SelIndex := ListBox1.ItemIndex;
TempName2 := ListBox1.Items.Strings[SelIndex];
TempName1 := TempName1 + '_DenGas_' + TempName2;
TempName1 := ChangeFileExt(TempName1,'.csv'); //拡張子をcsvとする
LayStName := TempName1; //レイヤー状態のファイル名(フルパス)

//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);
end;
end
else
ShowMessage('レイヤー状態を選択して下さい。');

end;

//レイヤー状態のファイルを削除
procedure TForm1.ButtonDeleteClick(Sender: TObject);
var
SelIndex : integer; //選択されたレイヤー状態名
TempName1,TempName2,TempName3: string;
begin
if ListBox1.ItemIndex >= 0 then
begin
//削除するレイヤー状態のファイル名を設定する
TempName1 := ChangeFileExt(ActName,''); //拡張子を取り除く
SelIndex := ListBox1.ItemIndex;
TempName2 := ListBox1.Items.Strings[SelIndex];
TempName3 := TempName1 + '_DenGas_' + TempName2;
TempName3 := ChangeFileExt(TempName3,'.csv'); //拡張子をcsvとする
LayStName := TempName3; //レイヤー状態のファイル名(フルパス)
ShowMessage(LayStName);
end
else
ShowMessage('レイヤー状態を選択して下さい。');
end;

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


end.
-----End of Code

最新の画像もっと見る

コメントを投稿