日付スタンプ
をテンプレートにして作成
[
ホーム
|
一覧
|
検索
|
最終更新
|
ヘルプ
] [
新規
]
VWRR
・
WIKIBOX
建築mome
・
メーカー
最新の40件
2018-07-17
VectorScript
2013-05-25
例題の解説
2011-12-09
ΔxΔy
GetLine
Distance
Num2Str
2011-12-08
寸法変倍
MenuBar
日付スタンプ
Date
面積スタンプ
2011-12-07
HArea
Num2StrF
TextOrigin
GetPt
FSActLayer
FActLayer
Concat
BeginText
EndText
図面の中を検索
ReDraw
MoveObjs
GetKeyDown
ClrMessage
Message
Y方向複製
2011-12-06
キー入力
ダイアログ
2011-12-04
図形の整列
2011-11-26
属性を設定する
Locus
変数
Oval
識別子
定数
基本型
言語仕様
制御命令
IF
total:
0
today:
0
yesterday:
0
now:
2
開始行:
**日付スタンプ [#ee3d21d6]
下記のコマンドを実行すると 日付をスタンプする。
&ref(stamp01.jpg,,70%);&ref(stamp02.jpg,,70%);
Procedure DateStamp;
{
平成12年 1月24日-8.5J3 図形名称と属性のチェック追加
平成11年 6月 6日-1.01
平成11年 1月20日-1.0
著作・製作 エーアンドエー株式会社
}
{*///
ゥ1999, Diehl Graphsoft, Inc.
This procedure updates or creates a text string named "D...
Developed by Tom Urie
///*}
LABEL 99;
CONST
kB1 = 'OK';
kB2 = 'キャンセル';
kTitle = '日付スタンプ';
kTextStringName = '日付スタンプ';
kD1GB1 = ' 表示内容 ';
kD1GB1B1 = '日付のみ';
kD1GB1B2 = '日付と時刻';
kD1GB1B3 = '時刻のみ';
kD1GB2 = ' 表示形式 ';
kD1GB2B1 = '1998年, 8月 5日, 水曜日';
kD1GB2B2 = '1998年, 8月5日, (水)';
kD1GB2B3 = '98.8.5';
kD1GB3 = ' オプション ';
kD1GB3B1 = '更新機能を使う';
kD1GB3B2 = '更新機能を使わない';
kD2F9 = 'アップデートする日付スタンプがありません。';
kD2GB1 = ' オプション ';
kD2GB1B1a = 'マウスクリックで日付スタンプを配置し、';
kD2GB1B1b = '「日付スタンプ」という名前をつけます';
kD2GB1B2a = 'マウスクリックで日付スタンプを配置しますが...
kD2GB1B2b = '名前はつけません';
kAlert1 = '図形名称「日付スタンプ」がテキスト以外の図形...
VAR
x, y : REAL;
dateFormat, infoFormat, optionA, optionB : INTEGER;
textH : HANDLE;
dateValue, textStringName : STRING;
Abort : BOOLEAN;
Procedure Dialogs;
{*/// This procedure defines the dialog boxes ///*}
VAR
Width, x1, y1, x2, y2, px1, px2, px3, px4, py1, py2, py3...
Procedure AlignScr (Height, Width : INTEGER; VAR x1, x2,...
VAR
scrx1, scry1, scrx2, scry2 : INTEGER;
BEGIN
GetScreen (scrx1, scry1, scrx2, scry2);
x1 := ((scrx1 + scrx2) DIV 2) - (Width DIV 2);
x2 := x1 + Width;
y1 := (scry2 - scry1 - Height) DIV 3;
END; {of AlignScr}
Procedure LocateButtons (DialogType, scnh, scnw : INTEGE...
{*/// This procedure locates the 'OK' and 'Cancel' butto...
VAR
v1, v2, v3, v4 : INTEGER;
Mac : BOOLEAN;
Procedure Swap (VAR m1, m2, m3, m4 : INTEGER);
VAR
Temp : INTEGER;
BEGIN
Temp := m1;
m1 := m3;
m3 := Temp;
Temp := m2;
m2 := m4;
m4 := Temp;
END; {of Swap}
BEGIN
Mac := FALSE;
GetVersion (v1, v2, v3, v4);
IF v4 = 1 THEN Mac := TRUE;
IF DialogType = 1 THEN
BEGIN
px1 := (scnw DIV 2) - 80;
px2 := (scnw DIV 2) - 10;
px3 := (scnw DIV 2) + 10;
px4 := (scnw DIV 2) + 80;
IF Mac THEN SWAP (px1, px2, px3, px4);
py1 := scnh - 40;
py2 := scnh - 20;
py3 := py1;
py4 := py2;
END
ELSE IF DialogType = 2 THEN
BEGIN
px1 := scnw - 180;
px2 := scnw - 110;
px3 := scnw - 90;
px4 := scnw - 20;
IF Mac THEN SWAP (px1, px2, px3, px4);
py1 := scnh - 40;
py2 := scnh - 20;
py3 := py1;
py4 := py2;
END
ELSE BEGIN
px1 := scnw - 90;
px2 := scnw - 20;
px3 := px1;
px4 := px2;
py1 := scnh -70;
py2 := scnh - 50;
py3 := scnh - 40;
py4 := scnh - 20;
IF Mac THEN SWAP (py1, py2, py3, py4);
END;
END; {of Locate Buttons}
Procedure MakeDialog1;
CONST
scnw = 430;
scnh = 235;
DialogType = 1;
VAR
g, h : INTEGER;
BEGIN
AlignScr (scnh, scnw, x1, x2, y1);
y2 := y1 + scnh;
LocateButtons (DialogType, scnh, scnw);
BeginDialog (1, 1, x1, y1, x2, y2);
AddButton (kB1, 1, 1, px1, py1, px2, py2);
AddButton (kB2, 2, 1, px3, py3, px4, py4);
g := 20;
h := 10;
AddGroupBox (kD1GB1, 9, g, h, 140+g, 85+h);
AddButton (kD1GB1B1, 10, 5, 10+g, 20+h, 105+g, 35+h);
AddButton (kD1GB1B2, 11, 5, 10+g, 40+h, 130+g, 55+h);
AddButton (kD1GB1B3, 12, 5, 10+g, 60+h, 105+g, 75+h);
g := 180;
AddGroupBox (kD1GB2,5, g, h, 230+g, 85+h);
AddButton ( kD1GB2B1, 6, 5, 10+g, 20+h, 210+g, 35+h);
AddButton ( kD1GB2B2, 7, 5, 10+g,40+h, 175+g, 55+h);
AddButton ( kD1GB2B3, 8, 5, 10+g, 60+h, 175+g, 75+h);
g := 20;
h := 105;
AddGroupBox (kD1GB3,13, g, h, 390+g, 65+h);
AddButton ( kD1GB3B1, 14, 5, 10+g, 20+h, 380+g, 35+h);
AddButton ( kD1GB3B2, 15, 5, 10+g, 40+h, 380+g, 55+h);
EndDialog;
END;
Procedure MakeDialog2;
CONST
scnw = 370;
scnh = 205;
DialogType = 1;
VAR
g, h : INTEGER;
BEGIN
AlignScr (scnh, scnw, x1, x2, y1);
y2 := y1 + scnh;
LocateButtons (DialogType, scnh, scnw);
BeginDialog (2, 1, x1, y1, x2, y2);
AddButton (kB1, 1, 1, px1, py1, px2, py2);
AddButton (kB2, 2, 1, px3, py3, px4, py4);
g := 20;
h := 10;
AddField (kD2F9,9, 1, g, h-1, scnw-20, 20+h);
g := 20;
h := 40;
AddGroupBox (kD2GB1,13, g, h, scnw-20, 105+h);
AddButton (kD2GB1B1a, 14, 5, 10+g, 20+h, scnw-25, 35+h);
AddField (kD2GB1B1b, 16, 1, 30+g, 37+h, scnw-25, 53+h);
AddButton (kD2GB1B2a, 15, 5, 10+g, 60+h, scnw-25, 75+h);
AddField (kD2GB1B2b, 17, 1, 30+g, 77+h, scnw-25, 93+h);
EndDialog;
END;
BEGIN
MakeDialog1;
MakeDialog2;
END;
Procedure GetInfo1;
VAR
Item : INTEGER;
Done : BOOLEAN;
BEGIN
Done := FALSE;
Abort := FALSE;
optionA := 1;
infoFormat := 0;
dateFormat := 0;
GetDialog (1);
SetTitle (kTitle);
SetItem (dateFormat + 6, TRUE);
SetItem (infoFormat + 10, TRUE);
SetItem (optionA + 13, TRUE);
REPEAT
DialogEvent (item);
CASE item OF
1 :
Done := TRUE;
2 :
BEGIN
Done := TRUE;
Abort := TRUE;
END;
6..8 :
dateFormat := Item - 6;
10..12 :
BEGIN
infoFormat := Item - 10;
SetItemEnable (6, infoFormat <> 2);
SetItemEnable (7, infoFormat <> 2);
SetItemEnable (8, infoFormat <> 2);
END;
14, 15 :
optionA := Item - 13;
END; {CASE}
UNTIL Done;
ClrDialog;
END;
Procedure GetInfo2;
VAR
Item : INTEGER;
Done : BOOLEAN;
BEGIN
Done := FALSE;
Abort := FALSE;
optionB := 1;
GetDialog (2);
SetTitle (kTitle);
SetItem (optionB + 13, TRUE);
REPEAT
DialogEvent (item);
CASE item OF
1 :
Done := TRUE;
2 :
BEGIN
Done := TRUE;
Abort := TRUE;
END;
14, 15 :
optionB := Item - 13;
END; {CASE}
UNTIL Done;
ClrDialog;
END;
BEGIN
Dialogs;
GetInfo1;
IF Abort THEN GOTO 99;
dateValue := Date (dateFormat, infoFormat);
textStringName := kTextStringName;
IF optionA = 1 THEN
BEGIN
textH := GetObject (textStringName);
IF textH = NIL THEN
BEGIN
Sysbeep;
GetInfo2;
IF NOT Abort THEN
BEGIN
GetPt (x, y);
TextOrigin (x, y);
CreateText (dateValue);
IF optionB = 1 THEN
SetName (LNewObj, textStringName);
END;
END
ELSE IF GetType (textH) <> 10 THEN
BEGIN
SysBeep;
AlrtDialog (kAlert1);
GOTO 99;
END
ELSE
SetText (textH, dateValue);
END
ELSE BEGIN
GetPt (x, y);
TextOrigin (x, y);
CreateText (dateValue);
END;
99: END;
RUN (DateStamp);
終了行:
**日付スタンプ [#ee3d21d6]
下記のコマンドを実行すると 日付をスタンプする。
&ref(stamp01.jpg,,70%);&ref(stamp02.jpg,,70%);
Procedure DateStamp;
{
平成12年 1月24日-8.5J3 図形名称と属性のチェック追加
平成11年 6月 6日-1.01
平成11年 1月20日-1.0
著作・製作 エーアンドエー株式会社
}
{*///
ゥ1999, Diehl Graphsoft, Inc.
This procedure updates or creates a text string named "D...
Developed by Tom Urie
///*}
LABEL 99;
CONST
kB1 = 'OK';
kB2 = 'キャンセル';
kTitle = '日付スタンプ';
kTextStringName = '日付スタンプ';
kD1GB1 = ' 表示内容 ';
kD1GB1B1 = '日付のみ';
kD1GB1B2 = '日付と時刻';
kD1GB1B3 = '時刻のみ';
kD1GB2 = ' 表示形式 ';
kD1GB2B1 = '1998年, 8月 5日, 水曜日';
kD1GB2B2 = '1998年, 8月5日, (水)';
kD1GB2B3 = '98.8.5';
kD1GB3 = ' オプション ';
kD1GB3B1 = '更新機能を使う';
kD1GB3B2 = '更新機能を使わない';
kD2F9 = 'アップデートする日付スタンプがありません。';
kD2GB1 = ' オプション ';
kD2GB1B1a = 'マウスクリックで日付スタンプを配置し、';
kD2GB1B1b = '「日付スタンプ」という名前をつけます';
kD2GB1B2a = 'マウスクリックで日付スタンプを配置しますが...
kD2GB1B2b = '名前はつけません';
kAlert1 = '図形名称「日付スタンプ」がテキスト以外の図形...
VAR
x, y : REAL;
dateFormat, infoFormat, optionA, optionB : INTEGER;
textH : HANDLE;
dateValue, textStringName : STRING;
Abort : BOOLEAN;
Procedure Dialogs;
{*/// This procedure defines the dialog boxes ///*}
VAR
Width, x1, y1, x2, y2, px1, px2, px3, px4, py1, py2, py3...
Procedure AlignScr (Height, Width : INTEGER; VAR x1, x2,...
VAR
scrx1, scry1, scrx2, scry2 : INTEGER;
BEGIN
GetScreen (scrx1, scry1, scrx2, scry2);
x1 := ((scrx1 + scrx2) DIV 2) - (Width DIV 2);
x2 := x1 + Width;
y1 := (scry2 - scry1 - Height) DIV 3;
END; {of AlignScr}
Procedure LocateButtons (DialogType, scnh, scnw : INTEGE...
{*/// This procedure locates the 'OK' and 'Cancel' butto...
VAR
v1, v2, v3, v4 : INTEGER;
Mac : BOOLEAN;
Procedure Swap (VAR m1, m2, m3, m4 : INTEGER);
VAR
Temp : INTEGER;
BEGIN
Temp := m1;
m1 := m3;
m3 := Temp;
Temp := m2;
m2 := m4;
m4 := Temp;
END; {of Swap}
BEGIN
Mac := FALSE;
GetVersion (v1, v2, v3, v4);
IF v4 = 1 THEN Mac := TRUE;
IF DialogType = 1 THEN
BEGIN
px1 := (scnw DIV 2) - 80;
px2 := (scnw DIV 2) - 10;
px3 := (scnw DIV 2) + 10;
px4 := (scnw DIV 2) + 80;
IF Mac THEN SWAP (px1, px2, px3, px4);
py1 := scnh - 40;
py2 := scnh - 20;
py3 := py1;
py4 := py2;
END
ELSE IF DialogType = 2 THEN
BEGIN
px1 := scnw - 180;
px2 := scnw - 110;
px3 := scnw - 90;
px4 := scnw - 20;
IF Mac THEN SWAP (px1, px2, px3, px4);
py1 := scnh - 40;
py2 := scnh - 20;
py3 := py1;
py4 := py2;
END
ELSE BEGIN
px1 := scnw - 90;
px2 := scnw - 20;
px3 := px1;
px4 := px2;
py1 := scnh -70;
py2 := scnh - 50;
py3 := scnh - 40;
py4 := scnh - 20;
IF Mac THEN SWAP (py1, py2, py3, py4);
END;
END; {of Locate Buttons}
Procedure MakeDialog1;
CONST
scnw = 430;
scnh = 235;
DialogType = 1;
VAR
g, h : INTEGER;
BEGIN
AlignScr (scnh, scnw, x1, x2, y1);
y2 := y1 + scnh;
LocateButtons (DialogType, scnh, scnw);
BeginDialog (1, 1, x1, y1, x2, y2);
AddButton (kB1, 1, 1, px1, py1, px2, py2);
AddButton (kB2, 2, 1, px3, py3, px4, py4);
g := 20;
h := 10;
AddGroupBox (kD1GB1, 9, g, h, 140+g, 85+h);
AddButton (kD1GB1B1, 10, 5, 10+g, 20+h, 105+g, 35+h);
AddButton (kD1GB1B2, 11, 5, 10+g, 40+h, 130+g, 55+h);
AddButton (kD1GB1B3, 12, 5, 10+g, 60+h, 105+g, 75+h);
g := 180;
AddGroupBox (kD1GB2,5, g, h, 230+g, 85+h);
AddButton ( kD1GB2B1, 6, 5, 10+g, 20+h, 210+g, 35+h);
AddButton ( kD1GB2B2, 7, 5, 10+g,40+h, 175+g, 55+h);
AddButton ( kD1GB2B3, 8, 5, 10+g, 60+h, 175+g, 75+h);
g := 20;
h := 105;
AddGroupBox (kD1GB3,13, g, h, 390+g, 65+h);
AddButton ( kD1GB3B1, 14, 5, 10+g, 20+h, 380+g, 35+h);
AddButton ( kD1GB3B2, 15, 5, 10+g, 40+h, 380+g, 55+h);
EndDialog;
END;
Procedure MakeDialog2;
CONST
scnw = 370;
scnh = 205;
DialogType = 1;
VAR
g, h : INTEGER;
BEGIN
AlignScr (scnh, scnw, x1, x2, y1);
y2 := y1 + scnh;
LocateButtons (DialogType, scnh, scnw);
BeginDialog (2, 1, x1, y1, x2, y2);
AddButton (kB1, 1, 1, px1, py1, px2, py2);
AddButton (kB2, 2, 1, px3, py3, px4, py4);
g := 20;
h := 10;
AddField (kD2F9,9, 1, g, h-1, scnw-20, 20+h);
g := 20;
h := 40;
AddGroupBox (kD2GB1,13, g, h, scnw-20, 105+h);
AddButton (kD2GB1B1a, 14, 5, 10+g, 20+h, scnw-25, 35+h);
AddField (kD2GB1B1b, 16, 1, 30+g, 37+h, scnw-25, 53+h);
AddButton (kD2GB1B2a, 15, 5, 10+g, 60+h, scnw-25, 75+h);
AddField (kD2GB1B2b, 17, 1, 30+g, 77+h, scnw-25, 93+h);
EndDialog;
END;
BEGIN
MakeDialog1;
MakeDialog2;
END;
Procedure GetInfo1;
VAR
Item : INTEGER;
Done : BOOLEAN;
BEGIN
Done := FALSE;
Abort := FALSE;
optionA := 1;
infoFormat := 0;
dateFormat := 0;
GetDialog (1);
SetTitle (kTitle);
SetItem (dateFormat + 6, TRUE);
SetItem (infoFormat + 10, TRUE);
SetItem (optionA + 13, TRUE);
REPEAT
DialogEvent (item);
CASE item OF
1 :
Done := TRUE;
2 :
BEGIN
Done := TRUE;
Abort := TRUE;
END;
6..8 :
dateFormat := Item - 6;
10..12 :
BEGIN
infoFormat := Item - 10;
SetItemEnable (6, infoFormat <> 2);
SetItemEnable (7, infoFormat <> 2);
SetItemEnable (8, infoFormat <> 2);
END;
14, 15 :
optionA := Item - 13;
END; {CASE}
UNTIL Done;
ClrDialog;
END;
Procedure GetInfo2;
VAR
Item : INTEGER;
Done : BOOLEAN;
BEGIN
Done := FALSE;
Abort := FALSE;
optionB := 1;
GetDialog (2);
SetTitle (kTitle);
SetItem (optionB + 13, TRUE);
REPEAT
DialogEvent (item);
CASE item OF
1 :
Done := TRUE;
2 :
BEGIN
Done := TRUE;
Abort := TRUE;
END;
14, 15 :
optionB := Item - 13;
END; {CASE}
UNTIL Done;
ClrDialog;
END;
BEGIN
Dialogs;
GetInfo1;
IF Abort THEN GOTO 99;
dateValue := Date (dateFormat, infoFormat);
textStringName := kTextStringName;
IF optionA = 1 THEN
BEGIN
textH := GetObject (textStringName);
IF textH = NIL THEN
BEGIN
Sysbeep;
GetInfo2;
IF NOT Abort THEN
BEGIN
GetPt (x, y);
TextOrigin (x, y);
CreateText (dateValue);
IF optionB = 1 THEN
SetName (LNewObj, textStringName);
END;
END
ELSE IF GetType (textH) <> 10 THEN
BEGIN
SysBeep;
AlrtDialog (kAlert1);
GOTO 99;
END
ELSE
SetText (textH, dateValue);
END
ELSE BEGIN
GetPt (x, y);
TextOrigin (x, y);
CreateText (dateValue);
END;
99: END;
RUN (DateStamp);
ページ名: