基準点、サイズ、角度を指定して図形を生成する関数です。関数は前回と同じく四角形、角丸四角形、楕円、四分円の4種類です。


 Ver.12で回転した四角形というオブジェクトが新しく出来たので、それを描く組込み手続きも追加されています。しかしこれは当然Ver.11.5では使えないし、作図の基点が四角形の左下に決め打ちされています。


 ですからVer.11.5でも使えるような関数を作ってみました。本家の手続きとは違って、生成する図形は見た目は回転した四角形ですがオブジェクトの種類は『多角形』です。

 基点の位置は各頂点と各辺の中央、そして図形の中心です。つまり四角形のスナップポイント全部です。基点の位置は -1〜7 の数字で指定します。

3:左上、 2:中上、 1:右上、

4:左中、-1:中中、 0:右中、

5:左下、 6:中下、 7:右下 

 中心の -1 を除けば、角度/45で覚えられると思います。
 図形の回転は図形に依らず共通なので手続きにしました。このライブラリでしか使わないので手続き名の前にアンダーバーを付けています。


(* 基準点、サイズ、角度を指定して図形を生成する関数です。 *)


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;