基準点、サイズ、角度を指定して図形を生成する関数です。関数は前回と同じく四角形、角丸四角形、楕円、四分円の4種類です。
Ver.12で回転した四角形というオブジェクトが新しく出来たので、それを描く組込み手続きも追加されています。しかしこれは当然Ver.11.5では使えないし、作図の基点が四角形の左下に決め打ちされています。
ですからVer.11.5でも使えるような関数を作ってみました。本家の手続きとは違って、生成する図形は見た目は回転した四角形ですがオブジェクトの種類は『多角形』です。
基点の位置は各頂点と各辺の中央、そして図形の中心です。つまり四角形のスナップポイント全部です。基点の位置は -1〜7 の数字で指定します。
3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下
(* 基準点、サイズ、角度を指定して図形を生成する関数です。 *)
procedure _RotateObjct(h :handle; x, y, wd, ht, rot :real; base :integer);
(* 基準点、サイズ、角度を指定して図形を回転する。 *)
{ base = 基準点の位置 ( 3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下 ) }
var
hwd, hht :real;
begin
hwd:= Abs(wd) / 2;
hht:= Abs(ht) / 2;
case base of
-1, 2, 6: hwd:= 0;
0, 1, 7: hwd:= -hwd;
end;
case base of
-1, 0, 4: hht:= 0;
1..3: hht:= -hht;
end;
HMove(h, hwd, hht);
HRotate(h, x, y, rot);
end;
function AngledRect_R(x, y, wd, ht, rot :real; base :integer): handle;
{ 基準点、サイズ、角度を指定して四角形を描く(real型) }
{ base = 基準点の位置 ( 3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下 ) }
var
xc, yc, hwd, hht :real;
result :handle;
begin
if (wd <> 0) & (ht <> 0) then begin
hwd:= Abs(wd) / 2;
hht:= Abs(ht) / 2;
Rect(x - hwd, y + hht, x + hwd, y - hht);
result:= LNewObj;
_RotateObjct(result, x, y, wd, ht, rot, base);
end
else
result:= Nil;
AngledRect_R:= result;
end;
function AngledRect_P(pt, sz :point; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して四角形を描く(point型) }
begin
AngledRect_P:= AngledRect_R(pt.x, pt.y, sz.x, sz.y, rot, base);
end;
function AngledRect_V(pt, sz :vector; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して四角形を描く(vector型) }
begin
AngledRect_V:= AngledRect_R(pt.x, pt.y, sz.x, sz.y, rot, base);
end;
function AngledRRect_R(x, y, wd, ht, dx, dy, rot :real; base :integer): handle;
{ 基準点、サイズ、角度を指定して角丸四角形を描く(real型) }
{ base = 基準点の位置 ( 3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下 ) }
var
xc, yc, hwd, hht :real;
result :handle;
begin
if (wd <> 0) & (ht <> 0) then begin
hwd:= Abs(wd) / 2;
hht:= Abs(ht) / 2;
RRect(x - hwd, y + hht, x + hwd, y - hht, dx, dy);
result:= LNewObj;
_RotateObjct(result, x, y, wd, ht, rot, base);
end
else
result:= Nil;
AngledRRect_R:= result;
end;
function AngledRRect_P(pt, sz, dr :point; rot :real; base :integer): handle;
{ 基準点、サイズ、角度を指定して角丸四角形を描く(point型) }
begin
AngledRRect_P:= AngledRRect_R(pt.x, pt.y, sz.x, sz.y, dr.x, dr.y, rot, base);
end;
function AngledRRect_V(pt, sz, dr :vector; rot :real; base :integer): handle;
{ 基準点、サイズ、角度を指定して角丸四角形を描く(vector型) }
begin
AngledRRect_V:= AngledRRect_R(pt.x, pt.y, sz.x, sz.y, dr.x, dr.y, rot, base);
end;
function AngledOval_R(x, y, wd, ht, rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して楕円形を描く(real型) }
{ base = 基準点の位置 ( 3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下 ) }
var
xc, yc, hwd, hht :real;
result :handle;
begin
if (wd <> 0) & (ht <> 0) then begin
hwd:= Abs(wd) / 2;
hht:= Abs(ht) / 2;
Oval(x - hwd, y + hht, x + hwd, y - hht);
result:= LNewObj;
_RotateObjct(result, x, y, wd, ht, rot, base);
end
else
result:= Nil;
AngledOval_R:= result;
end;
function AngledOval_P(pt, sz :point; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して楕円形を描く(point型) }
begin
AngledOval_P:= AngledOval_R(pt.x, pt.y, sz.x, sz.y, rot, base);
end;
function AngledOval_V(pt, sz :vector; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して楕円形を描く(vector型) }
begin
AngledOval_V:= AngledOval_R(pt.x, pt.y, sz.x, sz.y, rot, base);
end;
function AngledQuad_R(x, y, wd, ht :real; tp :integer; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して四分円を描く(real型) }
{ base = 基準点の位置 ( 3:左上、 2:中上、 1:右上、
4:左中、-1:中中、 0:右中、
5:左下、 6:中下、 7:右下 )
tp = 円弧の角度 ( 1:左上(90〜180度)、0:右上(0〜90度)
2:左下(180〜270度)、3:右下(270〜360度) }
var
xc, yc, hwd, hht :real;
result :handle;
begin
if (wd <> 0) & (ht <> 0) then begin
hwd:= Abs(wd) / 2;
hht:= Abs(ht) / 2;
Quad(x - hwd, y + hht, x + hwd, y - hht, tp);
result:= LNewObj;
_RotateObjct(result, x, y, wd, ht, rot, base);
end
else
result:= Nil;
AngledQuad_R:= result;
end;
function AngledQuad_P(pt, sz :point; tp :integer; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して楕円形を描く(point型) }
begin
AngledQuad_P:= AngledQuad_R(pt.x, pt.y, sz.x, sz.y, tp, rot, base);
end;
function AngledQuad_V(pt, sz :vector; tp :integer; rot: real; base :integer): handle;
{ 基準点、サイズ、角度を指定して楕円形を描く(vector型) }
begin
AngledQuad_V:= AngledQuad_R(pt.x, pt.y, sz.x, sz.y, tp, rot, base);
end;