お題
Delphi の VCL（Visual Component Library)で、HexMapのいろんな処理を丸投げできるコンポーネントをつくります。
準備 使用環境
言語 Delphi 12 Community Edition
ターゲットプラットフォーム Windows 32ビット
※64ビットでもできますが、32ビットの方がデバッグしやすいため、32ビットがお勧め。完成したら、64ビットに切り替えてコンパイルしても良いです。
概要
- TCustomControlを親に、六角形を敷き詰めたHexマップを表示するコンポーネントをつくります。
- インストールしないで試しますので、最初に台紙になるVCLアプリケーションを作ります。
- Delphiの良さのひとつ、[F9]キーで爆走コンパイルを楽しめるように、実行速度よりも、説明のしやすさ、弄りやすさを優先して作ります。
コンポーネントのソースコード HexMapCpt.pas は、デカいので文末にあります。
テスト用のアプリについて
メインメニュー > 新規作成 > Windows VCLアプリケーション で新規にプログラムをつくります。保存先は適当なフォルダーを作ってください。
こんな感じに画面を用意してください。
テストアプリのメイン画面 Form1 / Unit1.pas
ImageList1の設定
Index0はこれ
Index1はこれ
です。
ImageList2の設定
データは、これです。
プログラムはこちらです。
Unit1.pas [クリックで開いてください]
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,HexMapCpts, Vcl.StdCtrls,
System.ImageList, Vcl.ImgList, Vcl.Imaging.pngimage;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel6: TPanel;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
Panel7: TPanel;
Panel11: TPanel;
Panel9: TPanel;
Panel10: TPanel;
Panel12: TPanel;
Panel13: TPanel;
Panel14: TPanel;
Panel15: TPanel;
Panel16: TPanel;
Panel17: TPanel;
Panel8: TPanel;
ImageList1: TImageList;
ImageList2: TImageList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Panel8Click(Sender: TObject);
procedure Panel12Click(Sender: TObject);
procedure Panel9Click(Sender: TObject);
procedure Panel11Click(Sender: TObject);
private
{ Private 宣言 }
gSeForceIx:longint;
public
{ Public 宣言 }
HexMap:THexMapCpt;
procedure HexMapClick(Sender: TObject);
procedure HexMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
procedure HexMapDblClick(Sender: TObject);
procedure HexMapSelectForce(Sender:TObject; var Col,Row,Index:Longint);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2;
procedure TForm1.HexMapClick(Sender: TObject);
begin
// 移動モード(mdMove)のときは、移動経路作成
with HexMap do
if (Mode=mdMove)or(Mode=mdMove2)or(Mode=mdMove3) then
begin
Mode:=mdMove2;
printMap;
end;
end;
procedure TForm1.HexMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
var
i:longint;
begin
if (Button=mbRight)and(CheckBox1.Checked=True) then
with HexMap do
begin
HexMap.mode:=mdEdit;
Form2.ShowModal;
GeoGraphy[SelectCol,SelectRow]:=form2.gResult;
for i:=0 to gMultiCt-1 do
GeoGraphy[gMultiHex[i].Hx,gMultiHex[i].Hy]:=Form2.gResult;
HexMap.mode:=mdNone;
HexMap.ClearMultiHex;
end;
HexMap.Refresh;
end;
procedure TForm1.HexMapDblClick(Sender: TObject);
var
i:longint;
begin
with HexMap do
if Mode=mdMove3 then //移動実行
begin
for i:=gWayCt downto 0 do //移動実行
Walking(i);
ClearWayHex;
ClearMultiHex;
Mode:=mdNone;
Panel1.caption:='';
PrintMap;
exit;
end;
// 攻撃モード
with HexMap do
if (Mode=mdAttack2) then
if SelectEnemy>=0 then
if gForce[SelectEnemy].found=True then
begin
DrawAttack(gForce[SelectForce].Col,gForce[SelectForce].Row,gForCe[SelectEnemy].Col,gForCe[SelectEnemy].Row);
Panel1.caption:='攻撃しました';
MOde:=mdNone;
ClearMultiHex;
ClearObHex;
PrintMap;
exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
path:String;
begin
path:=ExtractFilePath(Application.Exename); //このアプリのパス
HexMap.LoadFromFile(path+'\HHmap.csv');
HexMap.Refresh;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
path:String;
begin
path:=ExtractFilePath(Application.Exename); //このアプリのパス
HexMap.SaveToFile(path+'\HHmap.csv');
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x,y:longint;
begin
HexMap:=THexMapCpt.Create(Self);
with HexMap do
begin
parent:=Self;
parentfont:=true; //フォントは親のフォントを使用
parentcolor:=true;//色は親の色を使用
Align:=alClient;
ScrLeft:=0;
ScrTop:=0;
HexWidth:=70;
HexHeight:=65;
HexCorner:=4;
MapSize:=20;
imagelist:=Imagelist1;
imagelistL:=ImageList2;
GeoColor[0]:=clBtnFace;
GeoColor[1]:=clGray;
GeoColor[2]:=$00ABB3C9;
GeoColor[3]:=clsilver;
GeoColor[4]:=clCream;
GeoColor[5]:=clMoneyGreen;
GeoColor[6]:=clTeal;
GeoColor[7]:=clAqua;
onClick:=HexMapClick;
onMouseDown:=HexMapMouseDown;
onDblclick:=HexMapDblClick;
onSelectForce:=HexMapSelectForce;
//test data
gForce[0].Id:=1;
gForce[0].CallSig:='Miko1';
gForce[0].Arrow:=5;
gForce[0].Search:=4;
gForce[0].movable:=8;
gForce[0].Range:=4;
gForce[0].Col:=10;
gForce[0].Row:=5;
gforce[0].found:=False;
gforce[0].IconIndex:=0;
gForce[1].Id:=2;
gForce[1].CallSig:='E1';
gForce[1].Arrow:=2;
gForce[1].Search:=5;
gForce[1].movable:=8;
gForce[1].Range:=4;
gForce[1].Col:=5;
gForce[1].Row:=8;
gforce[1].found:=False;
gforce[1].IconIndex:=1;
//テストマップ作製
for y:=0 to MapSize-1 do
for x:=0 to MapSize-1 do
GeoGraphy[x,y]:=5;
//テスト用の壁
GeoGraphy[6,4]:=1;
GeoGraphy[7,4]:=1;
GeoGraphy[7,5]:=1;
GeoGraphy[7,6]:=1;
GeoGraphy[8,6]:=1;
GeoGraphy[8,7]:=1;
GeoGraphy[9,7]:=1;
GeoGraphy[10,7]:=1;
end;
end;
//自軍ユニット選択
procedure TForm1.HexMapSelectForce(Sender:TObject; var Col,Row,Index:Longint);
begin
Panel1.Caption:=HexMap.gForce[index].CallSig+' : '+IntToStr(Col)+'--'+InttoStr(Row);
gSeForceIx:=Index; //選択中のForceのインデックスを保存
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
HexMap.Free;
end;
procedure TForm1.Panel9Click(Sender: TObject);
begin
with HexMap do
if gForce[SelectForce].id>0 then
begin
Mode:=MdSearch; //索敵モードに移行
Panel1.caption:='索敵実行。見つかりません';
if gEnemyCt>0 then
Panel1.Caption:='敵を発見しました';
end;
end;
procedure TForm1.Panel12Click(Sender: TObject);
begin
with HexMap do
if gForce[SelectForce].Id=1 then
begin
gForce[SelectForce].Arrow:=TPanel(Sender).tag;
if Mode=mdAttack then //攻撃モードのとき
Mode:=mdAttack;
if (gEnemyCt>0)and(Mode=mdAttack2) then
Panel1.caption:='旋回しました。敵キャラ攻撃範囲内。クリックで攻撃'
else
Panel1.caption:='旋回しました。攻撃可能な敵キャラがいません';
if Mode=mdAttack then
Mode:=mdAttack; //攻撃範囲を表示します。
end;
end;
procedure TForm1.Panel8Click(Sender: TObject);
begin
//移動モード
with HexMap do
if AskForceHex(SelectCol,SelectRow)>=0 then
begin
Panel1.caption:='移動先をダブルクリックで選択してください';
Mode:=mdMove;
end
else
Panel1.caption:='移動先のHexを選択してください';
end;
procedure TForm1.Panel11Click(Sender: TObject);
begin
with HexMap do
if gForce[SelectForce].Id=1 then
begin
Mode:=mdAttack;
if (gEnemyCt>0)and(Mode=mdAttack2) then
Panel1.caption:='敵キャラ攻撃範囲内。ダブルクリックで攻撃'
else
Panel1.caption:='攻撃可能な敵キャラがいません';
end;
end;
end.
マップエデット関係 Form2 / Unit2.pas
プログラムはこちらです。
Unit2.pas [クリックで開いてください]
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,HexMapCpts;
type
TForm2 = class(TForm)
Panel2: TPanel;
Panel1: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
procedure Panel2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
gResult:longint;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses Unit1;
procedure TForm2.FormShow(Sender: TObject);
begin
Panel1.Color:=Form1.HexMap.GeoColor[0];
Panel2.Color:=Form1.HexMap.GeoColor[1];
Panel3.Color:=Form1.HexMap.GeoColor[2];
Panel4.Color:=Form1.HexMap.GeoColor[3];
Panel5.Color:=Form1.HexMap.GeoColor[4];
Panel6.Color:=Form1.HexMap.GeoColor[5];
Panel7.Color:=Form1.HexMap.GeoColor[6];
Panel8.Color:=Form1.HexMap.GeoColor[7];
end;
procedure TForm2.Panel2Click(Sender: TObject);
begin
gResult:=Tpanel(sender).tag;
Form2.Close;
end;
end.
起動してみましょう
テスト用プログラムを起動すると、Hex座標(10, 5)に、ガトリング豆鉄砲を装備した青色の巫女さんがいます。
このキャラ（プログラム中では、「Force」と呼んでいます。Unitは予約語だから…）を、クリックして、移動を選択してください。
移動可能範囲が表示されますから、適当なHexをクリックしてください。
移動経路が表示されます。
移動先Hexをダブルクリックすると、キャラが移動します。
マップ中に敵キャラが隠れています。答えをいうと、Hex座標(5,8)にいます。
遮蔽物Hexを左に回り込んでから索敵すると、発見できます。
見つけたら、近づいて、ダブルクリックで攻撃します。
キャラには、「向き」が設定されています。敵キャラの方向を向いて、攻撃をクリック。
攻撃範囲内に敵キャラを捉まえたら、ダブルクリックで攻撃。
そんな感じです。
HexMapCpt.pas の説明
ここからが本題になります。
プログラムの説明
Hexのサイズについて
| プロパティ | 型 | 説明 |
|---|---|---|
| HexWidth | longint | Hexの横幅をPixで指定します |
| HexHeight | longint | Hexの高さをpixで指定します |
| HexCorner | longint | Hexの角丸め量を割る数で指定します。 |
六角形の上と下の辺を、HexWidth div HexCorner だけ、左右から小さくします。
初期値は６です。
したがい、HexWidth の1/6を左右から削って、六角形にしています。
横方向：HexWidth div HexCornerだけ、六角形を左に寄せて位置を詰めています。
縦方向：偶数列を、HexHeight div 2 だけ下へ下げています。
つまり、このコンポーネントで作るHexMapは、円を６０度ずつで区切って六角形を作るのではなく、矩形領域の四隅を折って、六角形にしています。こうすると、整数型だけで計算できます。
また、HexWidthとHexHieghtは同じ数字にすると、正六角形に近くなります。違う数字にすると、扁平にできます。
HexMapの拡大縮小も、このHexWidthとHexHieghtを同時に増減することでできます。
Hex上のキャラ(Force)の向きについて
移動経路（後述）には、移動方向に合わせたキャラの向きを格納しています。
攻撃範囲（後述）には、向きに合わせて、攻撃可能範囲が設定できます。
マップの表示説明
キャラと単一選択選択状態とキャレット
| 項目 | 説明 |
|---|---|
| キャラ(Force) | イラスト載せ可能。六角形の辺に所属(ID)と、向き(Arrow)を現す表示 |
| 選択状態のHex | ClicKで選択状態。図中では緑色 |
| キャレット | MouseMoveで移動。図中は赤色 |
選択Hex色やキャレット色は、プロパティで変更できます。
プロフィール表示
エディットモード以外で、キャラを選択中に右クリックで表示。
HexMap上に、キャラのグラフィックを重ねて表示する機能をつけています。
キャラ画像データは、メインフォーム側にImageListを置いて、格納してください。
| プロパティ | 型 | 説明 |
|---|---|---|
| ImageList | TObject | ImageListのNameをしていします。Hex上の「駒」表示に使用します。HexWidthとHexHeightと同じサイズにしてください。 |
| ImageListL | TObject | ImageListのNameをしていします。Hexのすぐ横にキャラを表示します。255Pixまで。アイコンとして表示しているため、例のように吹き出し表示も可能。 |
画像の指定は、gForce[index].IconIndexとprofileIndexで行います。
移動範囲と移動経路の表示
キャラを中心に、移動可能範囲と、移動経路を自動計算します。
障害物Hex(GeoGraphy= 0 と 1)は、回り込みます。
GeoGraphyが、0:侵入不可・余白と、1:障壁・コンクリート構造物は、遮蔽物になります。移動経路作成や索敵、攻撃の範囲から除外されます。
| 項目 | 説明 | 備考 |
|---|---|---|
| 移動可能範囲表示 | Hex内の数字は距離 | gMultiHex[index] |
| 移動経路表示 | Hex内の数字は、向き(Arrow) | gWayHex[index] |
移動は、Walk(index)メソッドで１Hexずつ行うことも可能です。移動中に、敵を発見して、移動を中断する処理を作ることもできるはず。
処理の流れを図にするとこうなります。
索敵成功範囲と、遮蔽物で索敵失敗した範囲
| 項目 | 説明 | 備考 |
|---|---|---|
| 索敵成功範囲表示 | Hex内の数字は距離 | gSearchHex[index] |
| 索敵失敗範囲 | Hexは赤色 | gObHex[index] |
遮蔽物の影には、敵がいるかも知れません。
索敵の処理の流れです。
キャラの向きと攻撃範囲表示
キャラの向きに合わせて、攻撃可能範囲を設定できます。また、遮蔽物に遮られたHexは攻撃範囲から除外されます。
テストプログラムでは、わるものをダブルクリックすると、何か一瞬だけビーム出ます。
攻撃は、SelectForceからSelectEnemyに向かって行います。
攻撃の処理の流れです。
Appendix プロパティとメソッドとデータ構造
HexMapの座標系
| プロパティ | 型 | 説明 |
|---|---|---|
| ScrLeft | longint | HexMapの左側の開始位置を、Hex数で指定します |
| ScrTop | longint | HexMapの左側の開始位置を、Hex数で指定します |
大きなHexMapでは、画面に収まりきらないことがあります。
左上端の座標を指定することで、マップをスクロールします。
| プロパティ | 型 | 説明 |
|---|---|---|
| MapSize | longint | HexMapの縦横の大きさを、Hex数で指定します。 |
マップは、縦横が同じサイズの正方形にしています。
このHexMapは、偶数列を1/2Hex下げた縦置き型です。まっすぐ突撃できる仕様となってます。
HexMapの色指定
| プロパティ | 型 | 説明 |
|---|---|---|
| SelectColor | TColor | 単一選択中のHexの色 |
| MultiColor | TColor | 複数選択中のHexの色 |
| SearchColor | TColor | 索敵できたHexの色 |
| WayColor | TColor | 移動経路の色 |
| CaretColor | TColor | キャレットの色 |
| LineColor | TColor | Hexの線の色 |
| FontColor | TColor | Fontの色は、通常のFontの指定を使用します |
| ObColor | TColor | 遮蔽物に遮られたHexの色。索敵と攻撃範囲で使用します |
| OwnColor | TColor | 自軍機がいるHexの色 |
| EnemyColor | TColor | 敵軍機がいるHexの色 |
| FriendColor | TColor | 友軍機がいるHexの色。将来予約 |
| UnKnownColor | TColor | 不明機がいるHexの色。将来予約 |
| 配列プロパティ | 型 | 説明 |
|---|---|---|
| GeoColor[kind:longint] | TColor | 地形ごとのHexの色 |
| GeoGraphy[Col,Row:longint] | longint | マップを作る地形の色。値は、GeoColor[index]のIndex番号 |
GeoGraphy[Col,Row]が、HexMapに地形をつくるデータです。ColとRowの値は、0からMapSize-1までです。
後述のメソッドに、SaveTofile()とLoadFromFile()を用意しています。
また、Modeをエデットにすると地形データの編集ができます。
動作関係のプロパティ
Hexの選択の表現（単一Hex）
| プロパティ | 型 | 説明 |
|---|---|---|
| PosX | longint | いまCaretがあるHexのX座標。主に内部で使用 |
| PosY | longint | いまCaretがあるHexのY座標。主に内部で使用 |
| SelelctCol | longint | クリック選択した横Hex座標 |
| SelelctRol | longint | クリック選択した縦Hex座標 |
| SelelctForce | longint | クリック選択した自軍機のIndex番号 |
| SelelctEnemy | longint | クリック選択した敵軍機のIndex番号 |
HexMap上での選択状態は、複数あります。
- キャレットHexは、MouseMoveとMouseDownで更新されます。いま選択しているHexです。Hex座標でPosXとPosYです。
- ClickしたHexは、単一選択Hexと呼んでいます。SelectColとSelelctRowでHex座標です。
- 移動、索敵、攻撃では自軍機をClickで選択指定します。SelectForceでIndex番号です。
- 攻撃では、敵機をClickで選択指定します。SelectEnemyでIndex番号です。
Hexの選択の表現（複数Hex）
| プロパティ | 型 | 説明 |
|---|---|---|
| gMultiHex[Index] | TPosHex構造体 | 汎用の複数選択Hexを収容する配列です。マップエデット、移動範囲、攻撃範囲などで使用します。 |
| gSearchHex[Index] | TPosHex構造体 | 索敵できた範囲のHexを収容する配列です。 |
| gObHex[Index] | TPosHex構造体 | 遮蔽物の影になり索敵を失敗した範囲のHexを収容する配列です。 |
| gWayHex[Index] | TPosHex構造体 | 自機と移動先地点のHexを結ぶ移動経路のHexを収容しています。 |
| gForce[Index] | TForce構造体 | 自軍と敵軍のForceのデータを収容する構造体です。敵も味方もなく一緒に同じ配列に収容されます。 |
| gEnemy[Index] | longint | 索敵で発見した敵ForceのIndexを収容します |
TPosHex構造体は、Hexの選択で使用します
type
TPosHex = record //Hx,Hyは、Hex座標
Hx,Hy,Range:longint; //Rangeは、基準になるHexからの同心円距離
end;
- gMultiHex[Index]は、マップエデットモードでは、[左Shift]+MouseDownで、複数のHexを連続で選択できます。
TForce構造体は、Forse（Unitが予約語なので、言い代え）の定義データを収容します。
type
TForce= record
Id : Byte ; //0存在しない 1自軍 2敵軍 3その他
CallSig : String; //ユニット名
Arrow : Longint; //0-5 向き六角形時計回り
Search : Longint; //2-6 索敵能力範囲
Movable : LongInt; //移動可能Hex距離
Range : LongInt; //攻撃可能距離
Found : boolean; //被発見フラグ True 見つかっている False 隠蔽状態
Col,Row : Longint; //座標値
IconIndex : Longint; //マップ上に表示するアイコンのImageListのIndex
ProfileIndex:LongInt;//プロフィール画像のImageListのIndex
end;
Hexの処理で必要なモノしか用意していないため、ゲームの仕様に合わせて、追加してください。
動作関係のメソッド
function AskMouseHex(x,y:longint):TposHex;
| 引数 | 型 | 説明 |
|---|---|---|
| x,y | Mouse座標 Longint | Mouse座標をHex座標に変換します |
MouseMoveイベント内で、いまMouseがいるHexにキャレットを表示する処理で使用しています。
procedure DrawHex(Col,Row,LineColor,FillColor,TextColor:longint;Caption,Ctl:String);
| 引数 | 書式 | 説明 |
|---|---|---|
| Col, Row | Hex座標 Longint | Hexを描く位置 |
| LineColor | TColor | 線の色 |
| FillColor | TColor | Hexの塗り色 |
| TextColor | TColor | Hexに表示する文字色 |
| Caption | String | 文字列 |
| Ctl | String | 制御文字列。'%S'で遮られHexの表示 |
Col,Rowで指定した位置に、Hexをひとつ描画します。描画プログラムの最下位に位置しており、他のメソッドなどから呼び出されて使用されます。直接使用することもできますが、他のメソッドとの描画タイミングにより、結果が上書きされてしまうことがあります。CTlは、何か個別に違う動作を指定したいときに、拡張用として用意しています。現在、'%S'を含んでいると、遮られHex用の縮小Hexを表示します。
procedure DrawForce(index:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Index | Index番号 Longint | Forceを描きます。 |
Unitが予約語のため、駒、ユニットをforceフォースと呼んでいます。
自軍敵軍を区別せず、Forceをひとつ描きます。
Forceは敵味方を問わず、位置や状態を同じ配列変数に収容しています。Forceには、IDを設けており、IDで敵味方を識別しています。（後述）
procedure PrintMap;
| 引数 | 型 | 説明 |
|---|---|---|
| なし | なし | HexMapを画面全体を描画します |
procedure SaveToFile (filename:string);
| 引数 | 型 | 説明 |
|---|---|---|
| fileName | String | GeoGraphy[Col,Row]の地形データをファイルに保存します。FileNameはフルパスでお願いします。 |
procedure LoadFromFile(filename:string);
| 引数 | 型 | 説明 |
|---|---|---|
| fileName | String | GeoGraphy[Col,Row]の地形データをファイルから読み込みます。FileNameはフルパスでお願いします。 |
移動・索敵・攻撃に関するもの
procedure SeekRing(Col,Row,Range:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Col, Row | Hex座標 Longint | この位置を中心に |
| Range | Hex距離 LongInt | Rangeの距離のHexを環状に選択 |
結果は、TPosHex型の配列gSearchHex[Index] に環状に選択したHexをリストアップします。gSearchCtに集めた数を記憶しています。
procedure MakeWalkMap(Col,Row,Range:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Col, Row | Hex座標 Longint | この位置を中心に |
| Range | Hex距離 LongInt | Rangeの距離のHexを面上に選択。 |
結果は、gMultiHex[Index]に収容します。つまり、移動可能範囲を表示するためのデータを作成します。Rangeには、Forceの移動可能な距離を指定してください。
MakeWalkMapは、障害物を回り込んた歩数で範囲を選択します。
procedure SubWalk(Col,Row,Range:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Col, Row | Hex座標 Longint | この位置を中心に |
| Range | Hex距離 LongInt | Rangeの距離のHexを面上に選択。 |
中間集計用のサブルーチンです。
procedure THexMapCpt.ZeroWalk(Col,Row,Range: LongInt);
| 引数 | 型 | 説明 |
|---|---|---|
| Col, Row | Hex座標 Longint | この位置のHexに隣接する障害物以外のHexをgMultiHex[Index]に選択します |
| Range | Hex距離 LongInt | Rangeは歩数表示のために受け取っています。このサブルーチン内では、演算には使用しません |
ZwroWalk >> SubWalk >> MakeWalk の順に連携して、移動可能範囲を作成します。
function MakeWayHex(Scol,Srow,Dcol,Drow:longint):boolean;
| 引数 | 型 | 説明 |
|---|---|---|
| SCol SRow | longint | 移動開始点のHex座標 |
| DCol DRow | longint | 移動目的点のHex座標 |
成功したら、移動経路を繋ぐHexが、gWayHex[Index]に収容されます。データの数は、MulitCtに入ります。配列に収容されるHexは、目的地から開始点への逆順です。
gWayHex[Index]に含まれるデータは、RangeをArrowに読み替えてください。移動中にForceの向きを移動方向に向けるために、RangeをArrowが間借りしています。
function AskMultiHex(Col,Row:longint):longint;
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
任意のHex(Col,Row)は、gMultiHex[Index]配列に含まれますか？ つまり、任意のHexが複数選択範囲（移動範囲や攻撃可能範囲、複数選択）に含まれていますか？ を回答します。画面描画で使用しています。
含まれる場合は、gMultiHexのIndexを返します。いいえのときは、-1を返します。
function AskWayHex(Col: LongInt; Row: LongInt): longint;
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
任意のHex(Col,Row)は、gWayHex[Index]配列に含まれますか？ つまり、任意のHexが移動経路に含まれていますか？ を回答します。画面描画で使用しています。
含まれる場合は、gWayHexのIndexを返します。いいえのときは、-1を返します。
procedure Walking(Count:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Count | longint | gWayHexのIndex |
移動経路を、Forceがたどって移動するために使用します。
SelectForceで選択されているForceが、移動描写の対象になります。
function AskCenterHex(Col,Row:longint):TCell;
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
任意のHexの中心座標をTCell返します。
TCell構造体のCenterX CenterY は、Pix座標です。
type
TCell = record
CenterX, //中心座標 X 遮り計算で使います
CenterY:longint // Y
end;
索敵や攻撃範囲を計算するときなどで使用します。ただし、AskCenterHexが返す値は、ScrLeft、ScrTopがともに 0 で計算されています。
画面上で、実際に描画される位置(x,y)は、次のように補正してください。
x:=AskCenterHex(SCol,SRow).CenterX;
y:=AskCenterHex(SCol,SRow).CenterY;
x:=x-ScrLeft*(HexWidth-(HexWidth div HexCorner));
y:=y-ScrTop*HexHeight;
procedure MakeCenterMap;
引数はありません。HexMap全体の中心点座標を計算して、FCenterMap[Col,Row]に収容します。
function AskSearchHex(Col: LongInt; Row: LongInt): LongInt;
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
任意のHex(Col,Row)は、gSearchHex[Index]配列に含まれますか？ つまり、任意のHexが索敵できたHex群に含まれていますか？ を回答します。画面描画で使用しています。
含まれる場合は、gSearchHexのIndexを返します。いいえのときは、-1を返します。
function AskObHex(Col: LongInt; Row: LongInt): LongInt;
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
任意のHex(Col,Row)は、gObHex[Index]配列に含まれますか？ つまり、任意のHexが、遮蔽物の影になり索敵が失敗したHex群に含まれていますか？ を回答します。画面描画で使用しています。
含まれる場合は、gObHexのIndexを返します。いいえのときは、-1を返します。ここで回答されるHexには、未確認の敵機が潜んでいる可能性があります。
procedure MakeSearchMap(Col,Row,Range:longint);
| 引数 | 型 | 説明 |
|---|---|---|
| Col Row | longint | 任意のHex座標 |
| Range | longint | Hex数の距離 |
任意のHex(Col,Row)を中心に、RangeのHex数の距離内を索敵します。
結果は、
- 索敵成功Hexは、gSearchHex[Index]に収容します。収容したHexの数は、gSearchCtに入ります。
- 索敵失敗Hexは、gObHex[Index]に収容します。収容したHexの数は、gObCtに入ります。
procedure CountSaerchEnemy(SeekId:byte);
| 引数 | 型 | 説明 |
|---|---|---|
| SeekId | byte | Forceの敵味方識別ID |
索敵範囲 gSerchHex[Index]内の敵の数を、gEnamy[Index]に収容します。
コンポーネントのプログラムはこちらです。
HexMapCpt.pas [クリックで開いてください]
unit HexMapCpts;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls,Vcl.Graphics,
System.Math,System.Types,TypInfo,System.UITypes, Vcl.ImgList;
type
TPosHex = record //Hx,HyはHex座標
Hx,Hy,Range:longint; //Rangeは、基準になるHexからの同心円距離
end;
type
TCell = record
CenterX, //中心座標 X 遮り計算で使います
CenterY:longint // Y
end;
type //動作モード
TMode = (mdNone,MdSearch,MdMove,MdMove2,mdMove3,mdAttack,mdAttack2,mdEdit); //なし 索敵 移動 攻撃 編集
type //イベント型 イベント ハンドラ手続きを指すメソッド ポインタ★
TSelectForceEvent = procedure (Sender:TObject; var Col,Row,Index:Longint) of object;
//Sender:TObjectは必要です。パラメーター不一致になるから。
type //イベント型 イベント ハンドラ手続きを指すメソッド ポインタ★
TSelectenemyEvent = procedure (Sender:TObject; var Col,Row,Index:Longint) of object;
//Sender:TObjectは必要です。パラメーター不一致になるから。
type
TForce= record
Id : Byte ; //0存在しない 1自軍 2敵軍 3その他
CallSig : String; //ユニット名
Arrow : Longint; //0-5 向き六角形時計回り
Search : Longint; //2-6 索敵能力範囲
Movable : LongInt; //移動可能Hex距離
Range : LongInt; //攻撃可能距離
Found : boolean; //被発見フラグ True 見つかっている False 隠蔽状態
Col,Row : Longint; //座標値
IconIndex : Longint; //マップ上に表示するアイコンのImageListのIndex
ProfileIndex:LongInt;//プロフィール画像のImageListのIndex
end;
type
THexMapCpt = class(TCustomControl)
private
{ Private 宣言 }
//Hexの大きさと形状の定義
FHexCorner:longint; //Hexの角丸め
FHexWidth, //Hexの１セル 横
FHexHeight:longint; // 縦
//HexMap画面表示
FScrLeft, //画面表示起点のHEX座標
FScrTop:longint; //
gHexCountX, //Print実行時に計算
gHexCountY:longint; //縦横にHEXがいくつ表示可能？
gfgDrag:boolean;
gSvMouseX,
gSvMouseY:longint; //スクロール処理のために使用。
gProFile_visible:boolean; //キャラプロフィール表示中
//Hex Georaphy データ
FMapSize:longint; //HexMapの縦横のサイズ 正方形で指定
FGeoGraphy:array of array of longint; //地形データ 配列プロパティサイズはMapSize Create
FgeoColor :array [0..9] of TColor; //地形表示色 配列プロパティ THexMapCptのType宣言内に置くこと
FCenterMap:array of array of TCell; //Hex射線計算用中心 配列プロパティサイズはMapSize Create
FMode :Tmode; //動作モード
//経路探索
gWalkIn :array[0..500] of TPosHex;
gWalkOut :array[0..500] of TPosHex;
gWalkInCt :longint;
gWalkOUtCt :longint;
FPosX,FPosY:longint; //キャレットのあるHex座標
FSelectCol,FSelectRow:longint; //選択中のHEX ClickしたHex
FSelectColor, //単一選択HEXの色
FMultiColor, //複数選択HEXの色
FSearchColor, //索敵成功範囲HEXの色
FCaretColor, //キャレットの色
FWaycolor, //移動経路Hexの色
FLineColor, //線の色
FObColor, //遮られHexの色
FOwnColor, //自機の色
FEnemyColor, //敵機の色
FFriendColor, //友軍機の色
FUnKnownColor:TColor; //不明機の色
FOnSelectForce:TSelectForceEvent; //Forceを選択するイベント型のフィールド★
FOnSelectEnemy:TSelectEnemyEvent; //Enemyを選択するイベント型のフィールド
FSelectForce:longint; //選択中のForceのIndex ClickしたForce
FSelectEnemy:longint; //選択中の敵ForceのIndex
FImageList :TObject; //イメージリストをプロパティに持つためのフィールド
FImageListL:TObject; //
protected
{ Protected 宣言 }
procedure SetMode (value:Tmode ); //EditMode
procedure SetHexCorner (value:longint); //Hexの中心
procedure SetHexWidth (value:longint); //Hexのサイズ 横
procedure SetHexHeight (value:longint); //Hexのサイズ 縦
procedure SetScrLeft (value:longint); //描画位置横起点
procedure SetScrTop (value:longint); // 縦起点
procedure SetPosX (value:longint); //選択中のHex 横
procedure SetPosY (value:longint); // 縦
procedure SetSelectCol (value:longint); //選択中のHex 横
procedure SetSelectRow (value:longint); //選択中のHex 縦
procedure SetGeoGraphy (Col,Row :longint; Value:longint); //地形
function GetGeoGraphy (Col,Row :longint):longint; //地形
procedure SetMapSize (Value:longint); //HexMapの大きさ正方形
procedure SetGeoColor (kind:longint; Value: TColor); //HexMapの地形ごとの色 配列プロパティ
function GetGeoColor (kind: LongInt): TColor; // 配列プロパティ
procedure SetSelectforce(value:longint); //選択したForceのIndex
procedure SetSelectEnemy(value:longint); //選択した敵ForceのIndex
public
{ Public 宣言 }
//作戦機ユニットデータ
gForce :array of TForce; //ユニット配置 配列プロパティサイズはMapSize Create
//Range Seek
gSearchHex:array [0..1000] of TPosHex; //Hexの座標を格納
gSearchCt:longint; //格納座標数
//多目的複数選択
gMultiHex:array [0..1000] of TPosHex;//SelectHex格納
gMultiCt:longint; //移動範囲、索敵範囲、複数選択
//遮られHex
gObHex:array [0..1000] of TPosHex; //障害物に遮られて索敵不能だったHex
gObCt:longint;
//移動ルート
gWayHex:array [0..1000] of TPosHex; //移動ルート 目的地->始点の順に座標が並んでいます
gWayCt:longint;
//発見した敵機
gEnemy:array [0..100] of longint; //発見した敵のIndex
gEnemyCt:longint;
procedure ClearSearchHex;
procedure ClearMultiHex;
procedure ClearObHex;
procedure ClearWayHex;
procedure ClearEnemy;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure Click; override;
procedure DblClick; override;
procedure Resize; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
//移動経路
function MakeWayHex(Scol,Srow,Dcol,Drow:longint):boolean; //成功したらTrue データは、qWayHex[ix]
function AskWayHex(Col: LongInt; Row: LongInt): longint;
function AskCenterHex(Col,Row:longint):TCell; //Hexの中心点計算
procedure MakeCenterMap;
function AskObHex(Col: LongInt; Row: LongInt): LongInt;
//マップ画面描画
procedure PrintMap; //1ページまるごとHexMap 描画
//Hex1個を描画
procedure DrawHex(Col,Row,LineColor,FillColor,TextColor:longint;Caption,Ctl:String); //Hexをひとつ描くx,y,線色,塗色,文字
//ユニット1個を描画
procedure DrawForce(index:longint);
//環状にHexを選択
procedure SeekRing(Col,Row,Range:longint); //Range の Hexを配列へリスト Rangeは距離
//索敵可能範囲 遮り入り
procedure MakeSearchMap(Col,Row,Range:longint);
//索敵範囲内の敵をリスト、数える
procedure CountForce(SeekId:byte); // SeekIdは 捜索対象 1味方 2敵
//攻撃可能範囲の敵をリスト、数える
procedure CountAttckEnemy(SeekId:byte); //ID 1自軍 2敵 3友軍
//移動可能範囲作成
procedure MakeWalkMap(Col,Row,Range:longint);
//移動可能範囲中間集計
procedure SubWalk(Col,Row,Range:longint);
//移動実行１
procedure Walking(Count:longint);
//Multi選択領域の中から、隣接Hexから指定のRange値を持つHexのインデックスを返す
function ReachHex(Sx,Sy,Range,Way: LongInt):longint;
//隣接セルをリスト
procedure ZeroWalk(Col,Row,Range:longint); //隣接するHexをgMulti[]へリスト
//射線領域
//Col,Rowを起点にArea指定 レンジ距離の攻撃範囲 遮りアリ/ナシ
procedure Cannon(Col: LongInt; Row: LongInt; Area: LongInt; Range: LongInt;Obstruct:boolean);
procedure SubCannon(Col,Row,Area,Range:longint); //射角探索
//Col,Rowにユニットがいますか？
function AskforceHex(Col,Row:longint):longint;
//Col,Rowは複数選択されていますか？ index 0
function AskMultiHex(Col,Row:longint):longint;
//Col,Rowは、レンジ選択されているか？ レンジ 0-n 非選択 -1
function AskSearchHex(Col,Row:longint):longint;
//mouse座標 x,y をHex座標に換算します
function AskMouseHex(x,y:longint):TposHex;
//遮り判定
procedure IsShade(Scol,SRow,DCol,DRow:longint);
//fx,fyに、中心距離が重なる遮られたHexを探す
function SeekShadeMap(fx,fy,DCol,DRow:longint):boolean;
//Indexのフォースのプロフィール画像を描画します。
procedure DrawProfile(Index:Longint);
//地形データgGeoGraphyをファイルに出力/読込
procedure LoadFromFile(filename:string);
procedure SaveToFile (filename:string);
procedure DrawAttack(SCol,SRow,DCol,DRow:longint); //攻撃簡易描画
//配列プロパティ置き場
//地形別の色 配列プロパティはpublishに置けない
property GeoColor [kind: longint] :Tcolor read GetGeoColor write SetGeoColor;
//書き込み Setメソッド 読み出しも Getメソッド必要
property GeoGraphy[Col,Row:longint] :Longint read GetGeoGraphy write SetGeoGraphy;
published
{ Published 宣言 }
property Align;
property Enabled;
property left;
property top;
property width;
property height;
property font;
property Color;
property Visible;
property onResize;
property onClick;
property onDblClick;
property onDragover;
property onDragDrop;
property onMouseEnter;
property onMouseLeave;
property onMouseUp;
property onMouseDown;
property onMouseMove;
property onMouseWheel;
property onMouseWheelDown;
property onMouseWheelup;
property onKeyDown;
property onSelectForce:TSelectForceEvent read FOnSelectForce write FOnSelectForce; //★フィールドです
property onSelectEnemy:TSelectEnemyEvent read FOnSelectEnemy write FOnSelectEnemy;
property Mode :Tmode read FMode write SetMode; //EditMode
property ScrLeft :longint read FScrLeft write SetScrLeft; //描画位置横起点
property ScrTop :longint read FScrTop write SetScrTop; // 縦起点
property HexWidth :longint read FHexWidth write SetHexWidth; //Hexのサイズ 横
property HexHeight :longint read FHexHeight write SetHexHeight; //Hexのサイズ 縦
property HexCorner :longint read FHexCorner write SetHexCorner; //Hexの中心
property PosX :longint read FPosX write SetPosX; //選択中のHex 座標横
property PosY :longint read FPosY write SetPosY; //選択中のHex 座標横
property SelectCol :longint read FSelectCol write SetSelectCol; //選択中のHex 座標横
property SelectRow :longint read FSelectRow write SetSelectRow; //選択中のHex 座標横
property MapSize :longint read FMapSize write SetMapSize; //HexMapの大きさを正方形で指定
property SelectColor:TColor read FSelectColor write FSelectColor; //単一選択HEXの色
property MultiColor :TColor read FMultiColor write FMultiColor; //複数選択HEXの色
property SearchColor:TColor read FSearchColor write FSearchColor; //レンジ選択HEXの色
property CaretColor :TColor read FCaretColor write FCaretColor; //キャレットの色
property WayColor :TColor read FWaycolor write FWayColor; //移動経路の色
property LineColor :TColor read FLinecolor write FLineColor; //線の色
property ObColor :TColor read FObColor write FObColor; //遮られHexの色
property OwnColor :TColor read FOwnColor write FOwnColor; //自機色
property EnemyColor:TColor read FEnemyColor write FEnemycolor; //敵機色
property FriendColor:TColor read FFriendColor write FFriendColor; //友軍機色
property UnKnownColor:TColor read FUnKnownColor write FUnKnownColor;
property ImageList :TObject read Fimagelist write Fimagelist; //キャラアイコン表示用イメージリスト
property ImageListL :TObject read FimagelistL write FimagelistL; //キャラプロフィール表示用イメージリスト
property SelectForce:longint read FSelectForce write SetSelectForce; //選択中のForceのインデックス
property SelectEnemy:longint read FSelectEnemy write SetSelectEnemy;
end;
const CRLF=chr($0d)+chr($0a); //改行コード
const EOF_CODE=chr($03); //終端コード
const MaxMapSize=64; //最大マップサイズ上限
const MaxForceCount=32; //敵味方併せてのforceの最大上限数
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [THexMapCpt]);
end;
procedure THexMapCpt.ClearSearchHex;
var
i:longint;
begin
for i:=0 to 999 do
begin
gSearchHex[i].Hx:=0;
gSearchHex[i].Hy:=0;
gSearchHex[i].Range:=0;
end;
gSearchCt:=0;
end;
procedure THexMapCpt.ClearMultiHex;
var
i:longint;
begin
for i:=0 to 999 do
begin
gMultiHex[i].Hx:=0;
gMultiHex[i].Hy:=0;
gMultiHex[i].Range:=0;
end;
gMultiCt:=0;
end;
procedure THexMapCpt.ClearObHex;
var
i:longint;
begin
for i:=0 to 999 do
begin
gObHex[i].Hx:=0;
gObHex[i].Hy:=0;
gObHex[i].Range:=0;
end;
gObCt:=0;
end;
procedure THexMapCpt.ClearWayHex;
var
i:longint;
begin
for i:=0 to 999 do
begin
gWayHex[i].Hx:=0;
gWayHex[i].Hy:=0;
gWayHex[i].Range:=0;
end;
gWayCt:=0;
end;
procedure THexMapCpt.ClearEnemy;
var
i:longint;
begin
for i:=0 to 99 do
gEnemy[i]:=0;
gEnemyCt:=0;
end;
procedure THexMapCpt.DrawProfile(Index: LongInt);
var
LICon:TIcon;
ix,sx,sy:longint;
begin
//プロフ画像表示
ix:=AskForceHex(SelectCol,SelectRow);
if ix>=0 then
if (gforce[Ix].found=true)or(gforce[Ix].id<>2) then
if FImageListL<>nil then //ImageListを割り当ててないとき
begin
LIcon := TIcon.Create;
try
TImageList(FImageListL).GetIcon(gforce[ix].IconIndex, LIcon);
Sx:=AskCenterHex(gForce[Ix].Col,gForce[Ix].Row).CenterX;
Sy:=AskCenterHex(gForce[Ix].Col,gForce[Ix].Row).CenterY;
Sx:=Sx-(ScrLeft*(HexWidth-(HexWidth div HexCorner)));
Sy:=Sy-HexHeight-120-(ScrTop*HexHeight);
Canvas.Draw(Sx,Sy,LIcon);
gProFile_visible:=True;
finally
FreeAndNil(LIcon);
end;
end;
end;
procedure THexMapCpt.DrawAttack(SCol,SRow,DCol,DRow:longint); //攻撃簡易描画
var
ix,Eix,Sx,Sy,Dx,Dy,px,py,i,L,Q:longint;
R:real;
begin
ix :=AskForceHex(SCol,SRow); //自機 ix
eix:=AskForceHex(DCol,Drow); //敵機eix
if (ix<0)or(eix<0) then //選択されていることを確認
exit;
if (gForce[ix].Id<>1)or(gForce[eix].id<>2) then //自機=1 敵機=2 を確認
exit;
Sx:=AskCenterHex(SCol,SRow).CenterX;
Sy:=AskCenterHex(SCol,SRow).CenterY;
Dx:=AskCenterHex(DCol,DRow).CenterX;
Dy:=AskCenterHex(DCol,DRow).CenterY;
Sx:=Sx-ScrLeft*(HexWidth-(HexWidth div HexCorner)); //表示位置を補正
Sy:=Sy-ScrTop*HexHeight;
Dx:=Dx-ScrLeft*(HexWidth-(HexWidth div HexCorner));
Dy:=Dy-ScrTop*HexHeight;
Q:=20;
R:=ArcTan2(Dy-Sy,Dx-Sx); //R 角度 ラジアン ArcTan2 傾きから角度
L:=trunc(sqrt((dx-sx)*(dx-sx)+(dy-sy)*(dy-sy))); //L 距離
L:=L div Q; //攻撃ビームの表示間隔
with Canvas do
begin
for i:=0 to L do
begin
px:=trunc(cos(R)*i*Q+sx); //X:= Cos(ラジアン)*距離+原点からのオフセット
py:=trunc(sin(R)*i*Q+sy); //Y:= Sin(ラジアン)*距離+原点からのオフセット
pen.color:=clRed;
rectangle(px-4,py-4,px+4,py+4);
end;
moveto(sx,sy);
lineto(dx,dy);
end;
end;
//Col,Rowにユニットがいますか？ 存在するix いない-1
function THexMapCpt.AskforceHex(Col,Row:longint):longint;
var
i:longint;
begin
Result:=-1; //いないとき
for i:=0 to 31 do
if (gForce[i].Col=Col)and(gForce[i].Row=Row) then
if gForce[i].Id>0 then
Result:=i;
end;
//索敵範囲内のForceをリスト
procedure THexMapCpt.CountForce(SeekId:byte); //ID 1自軍 2敵 3友軍
var
i,eix:longint;
begin
if gSearchCt<=0 then //先に索敵を実行してください。
exit;
ClearEnemy;
for i:=0 to gSearchCt-1 do
begin
eix:=AskforceHex(gSearchHex[i].Hx,gSearchHex[i].Hy);
if eix>0 then
if gForce[eix].Id=SeekId then //発見したForceのIdを確認
begin
gEnemy[gEnemyct]:=eix;
gForce[eix].found:=True; //フラグを被発見に書き換え
gEnemyCt:=gEnemyCt+1;
end;
end;
end;
procedure THexMapCpt.CountAttckEnemy(SeekId:byte); //ID 1自軍 2敵 3友軍 攻撃可能な敵をリスト
var
i,eix:longint;
begin
if gMultiCt<=0 then //先に索敵を実行してください。
exit;
ClearEnemy;
for i:=0 to gMultiCt-1 do
begin
eix:=AskforceHex(gMultiHex[i].Hx,gMultiHex[i].Hy);
if eix>0 then
if gForce[eix].Id=SeekId then //発見したForceのIdを確認
if gForce[eix].found=True then
begin
gEnemy[gEnemyct]:=eix;
gEnemyCt:=gEnemyCt+1;
end;
end;
end;
//遮り付き索敵範囲作成
//自機Col,Row から距離RangeのHexを、索敵可能見えるHex=gSearchHex[] 遮り見えないHex=gObHex[]にわける
procedure THexMapCpt.MakeSearchMap(Col,Row,Range:longint); //索敵可能範囲 遮り入り
var
i,x,y:longint;
begin
ClearObHex;
ClearSearchHex;
for i:=0 to Range-1 do //Range内のHexを選択
Seekring(Col,Row,i); //gSearchHexにCol,Rowから距離RangeのHexをリストアップ
for y:= Row-(Range) to Row+(range) do //gSearchHexにリストしたHexを遮り確認
for x:=Col-(Range) to Col+(Range) do
IsShade(Col,Row,x,y);
for i:=0 to gObCt-1 do
begin
if AskSearchHex(gObHex[i].Hx,gObHex[i].Hy)<0 then //遮り確認は四角領域なので
begin //六角形からはみ出るHexを削除
gObHex[i].Hx:=0;
gObHex[i].Hy:=0;
end;
end;
for i:=0 to gSearchCt-1 do
begin
if (AskObHex(gSearchHex[i].Hx,gSearchHex[i].Hy)>=0) //OkHex[]にあるとき
or(GeoGraphy[gSearchHex[i].Hx,gSearchHex[i].Hy]<2) then //障害物自体があるHex
begin //はMultiHex[]から削除
gSearchHex[i].Hx:=0;
gSearchHex[i].Hy:=0;
end;
end;
end;
//Scol,SRow - DCol,Drow の直線上に遮りの有り無し判定のためサンプリング点を計算
procedure THexMapCpt.IsShade(SCol,SRow,DCol,DRow:longint);
var
sx,sy,dx,dy,R,L:real;
px,py,i:longint;
begin
if (SCol<0)or(SRow<0)or(Dcol<0)or(Drow<0) then
exit;
if (Scol>MapSize-1)or(SRow>MapSize-1)or(Dcol>MapSize-1)or(DRow>MapSize-1) then
exit;
sx:=Trunc(FCenterMap[SCol,SRow].CenterX); //整数型から実数型に代入はTrunc()
sy:=Trunc(FCenterMap[SCol,SRow].CenterY);
dx:=Trunc(FCenterMap[DCol,DRow].CenterX);
dy:=Trunc(FCenterMap[DCol,DRow].CenterY);
R:=ArcTan2(dy-sy,dx-sx); //R 角度 ラジアン ArcTan2 傾きから角度
L:=sqrt((dx-sx)*(dx-sx)+(dy-sy)*(dy-sy)); //L 距離
with Canvas do
begin
i:=0;
while i < Trunc(L) do
begin
i:=i+HexWidth div 4; //サンプリング周期は、Hexwidth の1/4幅にしてます
px:=trunc(cos(R)*i+sx); //X:= Cos(ラジアン)*距離+原点からのオフセット
py:=trunc(sin(R)*i+sy); //Y:= Sin(ラジアン)*距離+原点からのオフセット
if gObCt<999 then
SeekShadeMap(px,py,Dcol,DRow); //px,py付近に遮蔽GeoGraphyがある/ない確認
{ if SeekShadeMap(px,py,Dcol,DRow)=True then
pen.Color:=clRed
else //コメントアウトを外すと遮り確認を表示します。
Pen.Color:=clWhite;
rectangle(px-2-ScrLeft*(HexWidth+(HexWidth div HexCorner)),py-2-Scrtop*HexHeight,px+2-ScrLeft*(HexWidth+(HexWidth div HexCorner)),py+2-Scrtop*HexHeight);
}
end;
end;
end;
//サンプリング点fx,fy が、障害物Hexの中心点±HexWidth*1.5内にあるとき、遮り判定=True
function THexMapCpt.SeekShadeMap(fx,fy,DCol,DRow:longint):boolean;
var
i,j,x,y,cx,cy:longint;
begin
Result:=False;
x:= fx div (HexWidth-(HexWidth div HexCorner)); //座標fx,fy をHexに直す
y:= fy div HexHeight;
if (x<0)or(Y<0)or(x>MapSize-1)or(y>MapSize-1) then //範囲外はExit
exit;
for i := 0 to MapSize-1 do
for j := 0 to MapSize-1 do
if FGeoGraphy[x,y]<2 then //地形FGeoGraphy=0,1は障害物
begin
cx:=FCenterMap[x,y].CenterX;
if (x mod 2)=0 then
cy:=FCenterMap[x,y].CenterY+HexHeight //偶数列Hexは1/2下
else
cy:=FCenterMap[x,y].CenterY; //奇数列Hexはそのまま
//三平方の定理で、 fx,fyが、障害物Hexの中心からHexWidth*1.5の距離内にあるか？
//距離が小さい場合は、遮り判定
if sqrt((fx-cx)*(fx-cx)+(fy-cy)*(fy-cy))<=HexWidth+(HexWidth div 2) then
begin
gObHex[gObCt].Hx:=DCol; //遮り判定のときは、gObHexに座標をリストアップ
gObHex[gObCt].Hy:=DRow;
gObCt:=gObCt+1;
result:=True;
exit;
end;
end;
end;
//射線が通るHexをリストアップ
//Col,Rowに自機 Areaは射角6角形の三角0-5 Rangeき距離 Obstructは遮りのあり/なし
procedure THexMapCpt.Cannon(Col: LongInt; Row: LongInt; Area: LongInt; Range: LongInt;Obstruct:boolean);
var
i,k:longint;
begin
for i:=0 to Range-1 do
SubCannon(Col,Row,Area,i); //Areaは0-5 必要に応じて複数のSubCannonを組み合わせる
//gMultiCtはここでクリアせず、累計します。
if Obstruct=False then
exit; //遮り判定なしのとき
//遮り判定
for k:=0 to gMultiCt-1 do
IsShade(col,Row,gMultiHex[k].Hx,gMultiHex[k].Hy); //IsShade(自機 SCol,SRow, 敵機 Dcol,DRow); 間に障害の有り無し判定
//gMultiHexにリストされたすべてのHexについて確認
for k:=0 to gMultiCt-1 do
begin
if AskObHex(gMultiHex[k].Hx,gMultiHex[k].Hy)>=0 then //gMultiHex[ix]がgObHexに含まれるときは、遮り判定
begin
gMultiHex[k].Hx:=0; //位置情報を0にしてどかします
gMultiHex[k].Hy:=0;
end;
end;
end;
//射線が届くHexをgMultiHexにリストアップ
//Col,Rowに自機 Areaは射角6角形の三角0-5 Rangeき距離
procedure THexMapCpt.SubCannon(Col: LongInt; Row: LongInt; Area: LongInt; Range: LongInt);
var
x,y,i,ct:longint;
begin
//初期化 //SubCannonは、複数の選択領域を組み合わせるため
ct:=gMultiCt; //gMultiCtをクリアしません。累計します。
case Area of
0:
for x:=0 to Range do
begin
y:=-1*Range ; //六角形の上側 右
gMultiHex[ct].Hx:=Col+x;
gMultiHex[ct].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gMultiHex[ct].Hx Mod 2 <>0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy+1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
1:
for i :=0 to Range do
begin //六角形 右
gMultiHex[ct].Hx:=Col+Range;
gMultiHex[ct].Hy:=Row-(Range div 2)+i;
if ((Col Mod 2)<>0)and(gMultiHex[ct].Hx Mod 2 =0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy-1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
2:
for x := 0 to Range do
begin
y:=Range-abs(x) ; //六角形の下側 右
gMultiHex[ct].Hx:=Col+x;
gMultiHex[ct].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gMultiHex[ct].Hx Mod 2 <>0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy+1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
3:
for x := -1*Range to 0 do
begin
y:=Range-abs(x) ; //六角形の下側 左
gMultiHex[ct].Hx:=Col+x;
gMultiHex[ct].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gMultiHex[ct].Hx Mod 2 <>0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy+1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
4:
for i :=0 to Range do
begin //六角形 左
gMultiHex[ct].Hx:=Col-Range;
gMultiHex[ct].Hy:=Row-(Range div 2)+i;
if ((Col Mod 2)<>0)and(gMultiHex[ct].Hx Mod 2 =0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy-1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
5:
for x := -1*Range to 0 do
begin
y:=-1*Range ; //六角形の上側 左
gMultiHex[ct].Hx:=Col+x;
gMultiHex[ct].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gMultiHex[ct].Hx Mod 2 <>0) then
gMultiHex[ct].Hy:=gMultiHex[ct].Hy+1;
gMultiHex[ct].Range:=Range;
ct:=ct+1;
end;
end;
gMultiCt:=ct;
end;
//移動ルート上を１歩ずつ歩きます
procedure THexMapCpt.Walking(Count: LongInt); //移動中に敵索敵範囲に掛かり
begin //攻撃を受ける想定で、
if (gWayCt-1<Count)or(Count<0) then //１Hexずつ移動します。
exit;
gForce[SelectForce].Col:=gWayHex[Count].hx;
gForce[SelectForce].Row:=gWayHex[Count].hy;
gForce[SelectForce].Arrow:=gWayHex[Count].range;
printMap;
end;
//移動ルート作成 Dcol,Drow --> Scol,Srow の順
function THexMapCpt.MakeWayHex(Scol,Srow,Dcol,Drow:longint):boolean; //成功したらTrue データは、qWayHex[ix]
var
i,x,y,ix,Dix,Rg,Way:longint;
begin
result:=false;
for i:=0 to 999 do //初期化
begin
gWayHex[i].Hx:=0;
gWayHex[i].Hy:=0;
end;
//Walkメソッドを実行後に歩行ルートを戻り抜き出します。
Dix:=AskMultiHex(DCol,DRow);
if Dix<0 then
exit; //Walkを先に実行してください。
x:=DCol;
y:=Drow;
gWayHex[0].Hx:=DCol; //目的地をgWayHex[0]に登録
gWayHex[0].Hy:=DRow;
gWayct:=1;
for Rg := gMultiHex[Dix].Range-1 downto 0 do //目的地HexのRange から出発地Hex隣接の0まで
for Way:=0 to 5 do //六角形を時計回りに調べる0-5
begin //for Way:=5 downto 0 にすると反時計回りにしらべる
ix:=ReachHex(x,y,Rg,way); //近接Hex ix 見つからないときはresult -1
if (ix<0)or(ix>999) then //見つからないときは、次の方向に進む
continue;
gWayHex[gWayCt]:=gMultiHex[ix]; //発見したHex分をコピー
//移動方位にforceの向きを変えるため、Rangeを間借りします
if Way<3 then
gWayHex[gWayCt].Range:=Way+3 //反対向きなので+3
else
gWayHex[gWayCt].Range:=Way-3; //5を越えたら-6
x:=gWayHex[gWayCt].Hx; //次のHex探索のためにx,yを更新
y:=gWayHex[gWayCt].Hy;
gWayCt:=gWayCt+1;
break;
end;
gWayHex[0].Range:=gWayHex[1].Range; //目的地での向きは、ひとつ前のHexでの向きを使用
//結果は gWayHex[n]
result:=true; //発見=Result True
end;
//Multi選択領域の中から、隣接Hexから指定のRange値を持つHexのインデックスを返す
function THexMapCpt.ReachHex(Sx,Sy,Range,Way: LongInt):longint;
var
H,Ix:longint;
begin
ix:=-1;
result:=ix;
if Sx Mod 2 = 0 then
H:=0 //偶数
else
H:=1; //奇数
case Way of //Wayは探す方向 0-5 六角形のそれぞれの隣接セル6個を時計回りに指定
0:
//12時
ix:=AskMultiHex(Sx,Sy-1);
1:
//2時
ix:=AskMultiHex(Sx+1,Sy-H);
2:
//4時
ix:=AskMultiHex(Sx+1,Sy-H+1);
3:
//6時
ix:=AskMultiHex(Sx,Sy+1);
4:
//8時
ix:=AskMultiHex(Sx-1,Sy-H+1);
5:
//10時
ix:=AskMultiHex(Sx-1,Sy-H);
else
Result:=-1;
end;
if ix>=0 then
if gMultiHex[ix].Range=Range then
Result:=ix;
end;
//Col Row から歩数Range で行けるHexを障害物回り込みでリストアップ
procedure THexMapCpt.MakeWalkMap(Col, Row, Range: LongInt);
var
i,k,Rg:longint;
begin
// gMultiCt:=0; //初期化
ClearMultiHex;
gWalkInCt :=0;
gWalkOutCt:=0;
//1歩目
ZeroWalk(Col,Row,0);
for i:=0 to gMultiCt-1 do
begin
gWalkIn[i].Hx:=gMultiHex[i].Hx; //2歩目に引継ぎ
gWalkIn[i].Hy:=gMultiHex[i].Hy;
gWalkIn[i].Range:=0;
end;
gWalkInCt:=gMultiCt;
gMultiHex[gMultiCt].Hx:=Col;
gMultiHex[gMultiCt].Hy:=Row;
gMultiCt:=gMultiCt+1;
//2歩目からループ
for Rg:=1 to Range-1 do //ループで調べるHex は、gWalkIn[]
begin //ループで見つけたHexは、gWalkOut[]
gWalkOutCt:=0;
for i := 0 to gWalkInCt-1 do
SubWalk(gWalkIn[i].Hx,gWalkIn[i].Hy,Rg); //
gWalkInCt:=0;
for k := 0 to gWalkOutCt-1 do
begin
gWalkIn[k].Hx:=gWalkOut[k].Hx; //次のループのために、gWalkOutからgWalkInに
gWalkIn[k].Hy:=gWalkOut[k].Hy; //Hexの座標をコピー
gWalkIn[k].Range:=gWalkOut[k].Range;
end;
gWalkInCt:=gWalkOutCt;
end;
printmap;
end;
//歩数カウントの中間集計サブルーチン ZeroWalk()の結果をgMultiHex[]に格納
procedure THexMapCpt.SubWalk(Col, Row, Range: LongInt);
var
i,SvMultiCt:longint;
begin
SvMultiCt:=gMultiCt;
ZeroWalk(Col,Row,Range);
for i:=SvMultiCt to gMultiCt-1 do
begin
gWalkOut[gWalkOutCt].Hx:=gMultiHex[i].Hx; //次段に引継ぎ
gWalkOut[gWalkOutCt].Hy:=gMultiHex[i].Hy;
gWalkOut[gWalkOutCt].Range:=Range;
gWalkOutCt:=gWalkOutCt+1;
end;
end;
//歩数カウントの最下位サブルーチン 隣接セル6個を回答します
procedure THexMapCpt.ZeroWalk(Col,Row,Range: LongInt);
var
H:longint;
begin
if Col Mod 2 = 0 then
H:=0 //偶数
else
H:=1; //奇数
//12時
if (AskMultiHex(Col,Row-1) < 0)and(GeogRaphy[Col,Row-1]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col;
gMultiHex[gMultiCt].Hy:= Row-1;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
//2時
if (AskMultiHex(Col+1,Row-H) < 0)and(GeogRaphy[Col+1,Row-H]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col+1;
gMultiHex[gMultiCt].Hy:= Row-H;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
//4時
if (AskMultiHex(Col+1,Row-H+1) < 0)and(GeogRaphy[Col+1,Row-H+1]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col+1;
gMultiHex[gMultiCt].Hy:= Row-H+1;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
//6時
if (AskMultiHex(Col,Row+1) < 0)and(GeogRaphy[Col,Row+1]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col;
gMultiHex[gMultiCt].Hy:= Row+1;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
//8時
if (AskMultiHex(Col-1,Row-H+1) < 0)and(GeogRaphy[Col-1,Row-H+1]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col-1;
gMultiHex[gMultiCt].Hy:= Row-H+1;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
//10時
if (AskMultiHex(Col-1,Row-H) < 0)and(GeogRaphy[Col-1,Row-H]>=2) then
begin
gMultiHex[gMultiCt].Hx:= Col-1;
gMultiHex[gMultiCt].Hy:= Row-H;
gMultiHex[gMultiCt].Range:=Range;
gMultiCt:=gMultiCt+1;
end;
end;
//遮り計算用の中心点座標図Cells[x,y]作成
procedure THexMapCpt.MakeCenterMap;
var
x,y:longint;
begin
for y:=0 to MapSize-1 do
for x:=0 to MapSize-1 do
FCenterMap[x,y]:= AskCenterHex(x,y);
end;
//モード設定 0なし 1移動 2索敵 3攻撃 9マップエデット
procedure THexMapCpt.SetMode(value: Tmode);
var
arrow:longint;
begin
FMode:=value;
if FMode=mdMove then
begin
ClearSearchHex;
ClearMultiHex;
ClearWayHex;
ClearObHex;
MakeWalkMap(gForce[SelectForce].Col,gForce[SelectForce].Row,gForce[SelectForce].movable);
printMap;
exit;
end;
if FMode=mdMove2 then
begin
MakeWayHex(gForce[SelectForce].Col,gForce[SelectForce].Row,PosX,PosY);
FMode:=mdMove3;
printMap;
Exit;
end;
if FMode=mdSearch then
begin
MakeSearchMap(gForce[SelectForce].Col,gForce[SelectForce].Row,gForce[SelectForce].Search);
CountForce(2); //2=「敵」 索敵範囲内の捜索
FMode:=mdNone; //索敵後に通常モードに戻します
printMap;
exit;
end;
if FMode=mdAttack then
if gForce[SelectForce].Id=1 then //自軍機
begin
ClearMultiHex;
ClearSearchHex;
ClearObHex;
ClearEnemy;
Arrow:=gForce[SelectForce].Arrow; //方位
Cannon(gForce[SelectForce].Col,gForce[SelectForce].Row,Arrow,gForce[SelectForce].Range,True);
if Arrow=0 then
Cannon(gForce[SelectForce].Col,gForce[SelectForce].Row,5,gForce[SelectForce].Range,True)
else
Cannon(gForce[SelectForce].Col,gForce[SelectForce].Row,gForce[SelectForce].Arrow-1,gForce[SelectForce].Range,True);
CountAttckEnemy(2); //攻撃可能範囲内の敵をリスト
if gEnemyCt>0 then
Mode:=mdAttack2; //攻撃可能範囲に敵がいる>>mdAttack2 いないときはmdAttackを継続
printMap;
exit;
end;
end;
//GeoGraphy 配列プロパティのアクセスWrite指定子
procedure THexMapCpt.SetGeoGraphy(Col: LongInt; Row: LongInt; Value: longint);
begin
if (Col>=0)and(Col<=MapSize-1)and(Row>=0)and(Row<=MapSize-1) then
begin
FGeoGraphy[col,Row]:=Value;
end;
end;
//GeoGraphy 配列プロパティのアクセスRead指定子
function THexMapCpt.GetGeoGraphy(Col: LongInt; Row: LongInt): longint;
begin
if (Col>=0)and(Col<=MapSize-1)and(Row>=0)and(Row<=MapSize-1) then
Result:=FGeoGraphy[Col,Row]
else
ReSult:=FGeoGraphy[0,0];
end;
//col,Rowが、gSearchHex[]のレンジ選択に含まれるか？ 含む indexを解答 ない -1
function THexMapCpt.AskSearchHex(Col: LongInt; Row: LongInt): LongInt;
var
i:longint;
begin
Result:=-1; //非選択
for i:=0 to gSearchCt-1 do
if (gSearchHex[i].Hx=Col)and(gSearchHex[i].Hy=Row) then
begin
Result:=i; //所属中のレンジ インデックス
Exit;
end;
end;
//col,Rowが、gObHex[]の遮られHexに含まれるか？ 含む indexを解答 ない -1
function THexMapCpt.AskObHex(Col: LongInt; Row: LongInt): LongInt;
var
i:longint;
begin
Result:=-1; //非選択
for i:=0 to gObCt-1 do
if (gObHex[i].Hx=Col)and(gObHex[i].Hy=Row) then
begin
Result:=i; //インデックスを返します
Exit;
end;
end;
//col,Rowが、gMultiHex[]の複数選択に含まれるか？ 含む indexを解答 ない -1
function THexMapCpt.AskMultiHex(Col: LongInt; Row: LongInt): longint;
var
i:longint;
begin
Result:=-1;
for i:=0 to gMultiCt-1 do
if (gMultiHex[i].Hx=Col)and(gMultiHex[i].Hy=Row) then
begin
Result:=i; //発見したインデックスを返す
Exit;
end;
end;
//col,Rowが、gWayHex[]の移動ルートに含まれるか？ 含む indexを解答 ない -1
function THexMapCpt.AskWayHex(Col: LongInt; Row: LongInt): longint;
var
i:longint;
begin
Result:=-1;
for i:=0 to gWayCt-1 do
if (gWayHex[i].Hx=Col)and(gWayHex[i].Hy=Row) then
begin
Result:=i; //発見したインデックスを返す
Exit;
end;
end;
//gGeoGraphyの地形データを保存します
procedure THexMapCpt.SaveToFile(filename: String);
var
x,y:longint;
S:String;
Sl:TStringList;
begin
Sl:=TStringList.Create;
Sl.add(InttoStr(MapSize)); //1番目にマップサイズを保存
try
for y:=0 to MapSize-1 do
begin
S:='';
for X:=0 to MapSize-1 do
S:=S+IntToStr(geography[x,y]);
Sl.add(S);
end;
Sl.SaveToFile(filename);
finally
Sl.free;
end;
end;
//gGeoGraphyの地形データを読込します
procedure THexMapCpt.LoadFromFile(filename: string);
var
x,y:longint;
M:string;
Sl:TStringList;
begin
if FileExists(filename)=false then //file存在しない
exit;
Sl:=TStringList.Create;
try
Sl.LoadFromFile(filename);
MapSize:=StrtoInt(Sl[0]);
for y:=0 to MapSize-1 do
begin
M:=Sl[y+1];
for x:=0 to MapSize-1 do
geography[x,y]:=StrToInt(Copy(M,x+1,1));
end;
finally
Sl.free;
end;
end;
//単一選択中のHexを設定 Col
procedure THexMapCpt.SetSelectCol(value: LongInt);
begin
if (value>=0)and(value<=MapSize) then
FSelectCol:=value;
end;
//単一選択中のHexを設定 Row
procedure THexMapCpt.SetSelectRow(value: LongInt);
begin
if (value>=0)and(value<=MapSize) then
FSelectRow:=value;
end;
//GeoGraphy ごとの色を設定する 0-9
procedure THexMapCpt.SetGeoColor(kind: LongInt; Value: TColor);
begin
if (Kind>=0)and(kind<=9) then
FGeoColor[kind]:=value;
end;
//GeoGraphy ごとの色を答える 0-9
function THexMapCpt.GetGeoColor(kind: LongInt): TColor;
begin
if (Kind>=0)and(kind<=9) then
result:=FGeoColor[kind]
else
result:=clBlack; //
end;
//Hexマップの縦横のサイズのHex数を設定
procedure THexMapCpt.SetMapSize(value: LongInt);
begin
if value>8 then //マップサイズ 最小 8*8
FMapSize:=value
else
FMapSize:=8;
if value<=MaxMapSize then //マップサイズ 最大64*64
FMapSize:=value
else
FMapSize:=MaxMapSize;
SetLength(FCenterMap ,MapSize,MapSize); //HexMapの縦横Hex数を設定
SetLength(FGeoGraphy ,MapSize,MapSize); //HexMapの縦横Hex数を設定 ★
MakeCenterMap; //遮り計算用のHex中心座標マップ作成
end;
//画面表示左位置 この数字で画面表示位置を移動
procedure THexMapCpt.SetScrLeft(value: LongInt);
begin
if value>MapSize then
FScrLeft:=MapSize
else
if value>MapSize-gHexCountX then
FScrLeft:=MapSize-gHexCountX
else
if value<0 then
FScrLeft:=0
else
FScrLeft:=value;
end;
//画面表示上位置 この数字で画面表示位置を移動
procedure THexMapCpt.SetScrTop(value: LongInt);
begin
if value>MapSize then
FScrTop:=MapSize
else
if value>MapSize-gHexCountY then
FScrTop:=MapSize-gHexCountY
else
if value<0 then
FScrTop:=0
else
FScrTop:=value;
end;
//Hexひとつのwidth
procedure THexMapCpt.SetHexWidth(value: LongInt);
begin
if (value>=0)and(value<=100) then
FHexWidth:=value;
end;
//HexひとつのHeight
procedure THexMapCpt.SetHexHeight(value: LongInt);
begin
if (value>=0)and(value<=100) then
FHexHeight:=value;
end;
//Hexひとつの六角形の角まるめ量
procedure THexMapCpt.SetHexCorner(value: LongInt);
begin
if (value>=0)and(value<=8) then
FHexCorner:=value;
end;
//キャレットHexの位置設定 横
procedure THexMapCpt.SetPosX(value: LongInt);
begin
if (value>=0)and(value<=MapSize-1) then
FPosX:=value;
end;
//キャレットHexの位置設定 縦
procedure THexMapCpt.SetPosY(value: LongInt);
begin
if (value>=0)and(value<=MapSize-1) then
FPosY:=value;
end;
procedure THexMapCpt.Click;
begin
//選択中座標をセット
SelectCol:=PosX;
SelectRow:=PosY;
//イベント★ force選択
if AskForceHex(PosX,PosY)>=0 then
SetSelectForce(AskForceHex(PosX,PosY));
//範囲表示を終了
if Mode=mdNone then
begin
ClearWayHex;
ClearSearchHex;
ClearObHex;
end;
printMap;
//規定処理
inherited;
end;
procedure THexMapCpt.SetSelectForce(value: LongInt);
begin
//イベント★ force選択
if (value<0)or(value>MaxForceCount-1) then //Forceのindex
exit;
if gForce[value].Id=1 then //自軍はFSelectForceに格納
FSelectForce:=value;
if gForce[value].Id=2 then //敵のみFSelectEnemyに格納
SelectEnemy:=value;
if Assigned(FonSelectForce) then //イベント発生
onSelectForce(Self,fPosX,fPosY,FSelectForce);
end;
procedure THexMapCpt.SetSelectEnemy(value: LongInt);
begin
//イベント★ force選択
if (value<0)or(value>MaxForceCount-1) then //Forceのindex
exit;
if gForce[value].Id=2 then //敵のみFSelectEnemyに格納
FSelectEnemy:=value;
if Assigned(FonSelectenemy) then //イベント発生
onSelectEnemy(Self,fPosX,fPosY,FSelectForce);
end;
procedure THexMapCpt.DblClick;
begin
inherited;
end;
//Col,RowからRangeの距離にあるHexをgMultiHexにリストアップ。遮り判定なしの環状
procedure THexMapCpt.SeekRing(Col,Row,Range:longint); //Range の Hexを配列へリスト
var
x,y,i,p:longint;
begin
//初期化 //gSearchCtの初期化は呼び出し側で行うこと
for x := -1-Range to 1+Range do
begin
y:=-1-Range ; //六角形の上側
gSearchHex[gSearchCt].Hx:=Col+x;
gSearchHex[gSearchCt].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gSearchHex[gSearchCt].Hx Mod 2 <>0) then
gSearchHex[gSearchCt].Hy:=gSearchHex[gSearchCt].Hy+1;
gSearchHex[gSearchCt].Range:=Range;
gSearchCt:=gSearchCt+1;
y:=1+Range-abs(x) ; //六角形の下側
gSearchHex[gSearchCt].Hx:=Col+x;
gSearchHex[gSearchCt].Hy:=Row+y+(Abs(x) Div 2);
if ((Col Mod 2)=0)and(gSearchHex[gSearchCt].Hx Mod 2 <>0) then
gSearchHex[gSearchCt].Hy:=gSearchHex[gSearchCt].Hy+1;
gSearchHex[gSearchCt].Range:=Range;
gSearchCt:=gSearchCt+1;
if (X= -1-Range) or (x= 1+Range) then //六角形の両側面
begin
if Col Mod 2 =0 then //中心が奇数と偶数で調整
p:=1
else
p:=0;
for i:=Row+(-1-Range)+(Range div 2)+1+p to Row+(1+Range-abs(x))+(Range div 2) do //Xが開始点と終了点のとき
begin //上と下をつなぐ
gSearchHex[gSearchCt].Hx:=Col+x;
gSearchHex[gSearchCt].Hy:=i;
gSearchHex[gSearchCt].Range:=Range;
gSearchCt:=gSearchCt+1;
end;
end;
end;
end;
//Col,Rowの中心座標を返します。遮り判定の基礎データを提供します
function THexMapCpt.AskCenterHex(Col,Row:longint):Tcell; //Hexの中心点計算
var
bx,ws,H:longint;
begin
bx:=0;
if (Col mod 2) =0 then //偶数列を1/2 下げる
H:=HexHeight div 2
else
H:=0;
Ws:= HexWidth div HexCorner;
bx:=bx-Ws*Col; //Hexの列のX位置は、HexCorner*Col 分詰める
if (Col>=0)and(Col<=MapSize)and(Row>=0)and(Row<=MapSize) then
begin
Result.CenterX:=bx+HexWidth*Col+(HexWidth div 2);
result.CenterY:=HexHeight*Row+H+(HexHeight div 2);
end
else
begin
Result.CenterX:=0;
result.CenterY:=0;
end;
end;
//MouseDownイベントをoverride 複数Hex選択機能を処理します。
procedure THexMapCpt.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
var
ix:longint;
ph:TPosHex;
begin
ph:=AskMouseHex(x,y); //キャレットHexは、MouseMoveとMouseDownで更新
PosX:=Ph.Hx;
PosY:=Ph.Hy;
ix:=AskMultiHex(PosX,PosY);
//左シフトキー + MoueDownで複数選択 MapEditなどで使用を想定しています
if Shift = [ssShift,ssleft] then
if ix<0 then
begin
gMultiHex[gMultiCt].Hx:=PosX;
gMultiHex[gMultiCt].Hy:=PosY;
gMultiCt:=gMultiCt+1;
DrawHex(PosX,PosY,LineColor,MultiColor,clwhite,'','')
end
else
begin
gMultiHex[ix].Hx:=0; //すでに複数選択があるときは選択解除
gMultiHex[ix].Hy:=0; //0に指定
end;
printMap;
inherited;
if Button=mbright then //右ボタンでプロフィール表示
DrawProfile(SelectForce);
//画面スクロールモードに移行
if (Button=mbLeft)and(Mode<>mdEdit) then //Editモード以外で左ボタン
begin
gfgDrag:=True;
gSvMouseX:=x;
gSvMouseY:=y;
end;
end;
procedure THexMapCpt.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
if gProFile_visible=True then
begin
Refresh;
gProFile_visible:=False;
end;
//画面スクロールモード解除
if gfgDrag=True then
begin
gfgDrag:=False;
Refresh;
end;
end;
//MouseMoveイベントをoverride キャレットを移動します。
procedure THexMapCpt.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ph:TposHex;
fg:boolean;
begin
inherited;
//画面スクロール
if gfgDrag=True then
begin
fg:=false;
if abs(gSvMouseX-x)>HexWidth then
begin
ScrLeft:=ScrLeft+(gSvMouseX-x) div HexWidth;
gSvMouseX:=X;
fg:=True;
end;
if abs(gSvMouseY-y)>HexHeight then
begin
ScrTop:=ScrTop+(gSvMouseY-y) div HexHeight;
gSvMouseY:=y;
fg:=true;
end;
if fg=true then
printMap;
exit;
end;
//キャレットの表示と更新
ph:=AskMouseHex(x,y); //mouse(x,y) >> Hex座標変換
//キャレット更新不要のとき
if (ph.hx=Posx)and(ph.Hy=Posy) then
begin
PosX:=ph.Hx;
PosY:=ph.Hy;
exit;
end;
//古いHex表示を消す/更新 するとき PosX,PosY 古い座標値
//通常状態のHex表示を描き戻すとき
//ユニット存在セルを描き戻すとき
if AskForceHex(PosX,PosY)>=0 then
DrawForce(AskForceHex(PosX,PosY))
else
//移動経路Hexを描き戻すとき
if AskWayHex(PosX,PosY)>=0 then
DrawHex(PosX,PosY,clBlue,clSkyblue,clwhite,IntToStr(gWayHex[AskWayHex(PosX,PosY)].Range),'')
else
//複数選択Hexを描き戻すとき
if AskMultiHex(PosX,PosY)>=0 then
DrawHex(PosX,PosY,LineColor,MultiColor,clwhite,IntToStr(gMultiHex[AskMultiHex(PosX,PosY)].Range),'')
else
//レンジ選択Hexを描き戻すとき
if AskSearchHex(PosX,PosY)>=0 then
DrawHex(PosX,PosY,LineColor,SearchColor,clWhite,IntToStr(gSearchHex[AskSearchHex(PosX,PosY)].Range),'')
else
//遮り判定Hexを描き戻すとき
if AskObHex(PosX,PosY)>=0 then
DrawHex(PosX,PosY,ObColor,Geocolor[geography[Posx,Posy]],clwhite,'','+%S')
else
DrawHex(PosX,PosY,LineColor,Geocolor[geography[Posx,Posy]],clWhite,'','');
//キャレット表示
DrawHex(ph.Hx,ph.Hy,Caretcolor,clBlack,clWhite,'','%C');
//単一選択Hex表示
if (SelectCol>=0)and(SelectRow>=0) then
DrawHex(SelectCol,SelectRow,SelectColor,clBlack,clWhite,'','%C');
PosX:=ph.Hx; //キャレットHexは、MouseMoveとMouseDownで更新
PosY:=ph.Hy;
end;
//Muse座標 x,y が、どのHexを指しているか？
function THexMapCpt.AskMouseHex(x,y:longint):TposHex;
var
ws,Px,Py:longint; //Hex座標
begin
Ws:= HexWidth div HexCorner; //画面上の座標とHEX座標の換算
Px:=(x-(ws div 2)) div (HexWidth-ws);
Px:=Px+ScrLeft;
if (Px Mod 2)=0 then
Py:=((y-(HexHeight div 2)) div HexHeight) // 偶数列 H:=ny div 2 ;
else
Py:=y div HexHeight;
Py:=Py+ScrTop;
//マップからのはみ出しチェック
if Px<0 then
Px:=0;
if Px>MapSize-1 then
Px:=MapSize-1;
if Py<0 then
Py:=0;
if Py>MapSize-1 then
Py:=MapSize-1;
//最大表示範囲からのはみ出しチェック
if Px<ScrLeft then
Px:=ScrLeft;
if Py<ScrTop then
Py:=ScrTop;
if Px>ScrLeft +gHexCountX then
Px:=ScrLeft +gHexCountX;
if Py>Scrtop +gHexCountY then
PY:=ScrTop +gHexCountY;
Result.Hx:=px;
Result.Hy:=py;
end;
procedure THexMapCpt.ReSize;
begin
PrintMap;
Refresh;
end;
//Paintメソッドをoverride 描画イベントを処理します
procedure THexMapCpt.Paint;
begin
PrintMap;
end;
//画面全体を描画します
procedure THexMapCpt.PrintMap;
var
k,x,y,nx,ny,Ws,ix:longint;
begin
//画面の幅nx 高さny を計算
Ws:= HexWidth div HexCorner;
nx:=width div (HexWidth-ws);
if nx+ScrLeft<MapSize-1 then
nx:=MapSize-1-ScrLeft;
ny:=(Height-(HexHeight div 2)) div HexHeight;
if ny+ScrTop>MapSize then
ny:=MapSize-ScrTop;
//画面を描画
for y:=ScrTop to ny+ScrTop-1 do
for x:=ScrLeft to nx+ScrLeft-1 do
begin
//索敵範囲を描画
if AskSearchHex(x,y)>=0 then
DrawHex(x,y,LineColor,SearchColor,clwhite,IntToStr(gSearchHex[AskSearchHex(x,y)].Range)+'','')
//連続選択を描画
else if AskMultiHex(x,y)>=0 then
DrawHex(x,y,LineColor,MultiColor,clwhite,IntToStr(gMultiHex[AskMultiHex(x,y)].Range),'')
else
//それ以外
DrawHex(x,y,LineColor,GeoColor[geography[x,y]],clwhite,'','');
//遮りHexを上書き
ix:=AskObHex(x,y);
if ix>=0 then
DrawHex(gObHex[ix].Hx,gObHex[ix].Hy,clRed,clBlack,clwhite,'','%S');
//単一選択Hex表示 SelectCol,SelectRowが選択状態Hexの座標値
if (SelectCol>=0)and(SelectRow>=0) then
begin
Canvas.Pen.width:=3;
DrawHex(SelectCol,SelectRow,SelectColor,clBlack,clWhite,'','');
Canvas.Pen.width:=1;
end;
end;
//経路表示を別途で上書き
if gWayCt>0 then
for k:=gWayCt-1 downto 0 do
DrawHex(gWayHex[k].Hx,gWayHex[k].Hy,clBlue,clSkyblue,clwhite,IntToStr(gWayHex[k].Range),'');
//ユニット表示
for ix:=0 to 31 do
if gForce[ix].id>0 then
DrawForce(ix);
//計算した表示可能Hex行と列 を格納
gHexCountX:=nx;
gHexCountY:=ny;
end;
//ixで指定したユニットを描画します
procedure THexMapCpt.DrawForce(index:longint);
var
x,y,Clr:longint;
begin
x:=gForce[index].Col;
y:=gForce[index].Row;
case gForce[index].Id of
0: //存在しない。撃破済み。
exit;
1: //自機
Clr:=OwnColor; //clSkyBlue;
2: //敵機
Clr:=EnemyColor; //$00DECAFD;
3: //友軍機
Clr:=FriendColor; //$00BDFFFF;
4: //不明機
Clr:=UnKnownColor; //$00505050;
else
Clr:=clBlack;
end;
if (gForce[index].id=1) or (gForce[index].found=True) then //自軍とfoundした敵
if Selectforce=index then
DrawHex(x,y,Linecolor,Clr,clWhite, gForce[index].CallSig,'%C')
else
DrawHex(x,y,LineColor,Clr,clWhite, gForce[index].CallSig,'');
end;
//Hexひとつ分を描画します。
procedure THexMapCpt.DrawHex(Col,Row,LineColor,FillColor,TextColor:longint;Caption,Ctl:String); //Hexをひとつ描くx,y,線色,塗色,文字
var
bx,by,ws,Hs,H,P,ix:longint;
pts:array [0..5] of TPoint; //Hex
LIcon : TIcon;
begin
//画面外にはみ出しちを確認
if (Col<0)or(Row<0)or(gHexCountX+ScrLeft<Col)or(gHexCountY+ScrTop<Row) then
exit;
bx:= 0;
Ws:= HexWidth div HexCorner;
Hs:= HexHeight div 2;
if (Col mod 2) =0 then //偶数列を1/2 下げる
H:=HexHeight div 2
else
H:=0;
//表示位置調整
bx:=bx-Ws*Col; //Hexの列のX位置は、HexCorner*Col 分詰める
bx:=bx-ScrLeft*(HexWidth-Ws);
by:=ScrTop*Hexheight*-1;
with Canvas do
begin
brush.Color:=FillColor;
brush.Style:=bsSolid;
pen.color:=LineColor;
if FillColor=clBlack then //clBlack 黒指定で透明塗り
brush.style:=bsClear
else
brush.style:=bsSolid;
if LineColor=clBlack then //clBlack 黒指定で透明線
pen.style:=psClear
else
Pen.style:=psSolid;
if Pos('%S',Ctl)>0 then //制御文字に%Sあるときは縮小HEX枠
P:=3
else
P:=0;
//ヘクス表示
pts[0]:=point(bx+HexWidth*Col+Ws+P ,By+HexHeight*Row +H+P);
pts[1]:=point(bx+HexWidth*Col+HexWidth-Ws-P,By+HexHeight*Row +H+P);
pts[2]:=point(bx+HexWidth*Col+HexWidth-P ,By+HexHeight*Row+Hs +H);
pts[3]:=point(bx+HexWidth*Col+HexWidth-Ws-P,By+HexHeight*Row+HexHeight +H-P);
pts[4]:=point(bx+HexWidth*Col+Ws+P ,By+HexHeight*Row+HexHeight +H-P);
pts[5]:=point(bx+HexWidth*Col+P ,By+HexHeight*Row+Hs +H);
Polygon(pts);
//キャレット表示
if Pos('%C',Ctl)>0 then //制御文字に%S があるときキャレット表示
begin
Pen.Width:=3;
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row +H+4);
LineTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row +H+4);
MoveTo(bx+HexWidth*Col+HexWidth-6 ,By+HexHeight*Row+Hs +H+2);
LineTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row+HexHeight +H-4);
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row+HexHeight +H-4);
LineTo(bx+HexWidth*Col+6 ,By+HexHeight*Row+Hs +H+2);
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row +H+4);
Pen.Width:=1;
end;
//ユニットアイコン表示
ix:=AskForceHex(Col,Row);
if ix>=0 then
if (gforce[Ix].found=true)or(gforce[Ix].id<>2) then
if FImageList<>nil then //ImageListを割り当ててないとき
begin
LIcon := TIcon.Create;
try
TImageList(FImageList).GetIcon(gforce[ix].IconIndex, LIcon);
Canvas.Draw(bx+HexWidth*Col+4, By+HexHeight*Row+H-4, LIcon);
finally
FreeAndNil(LIcon);
end;
end;
//ユニット方向表示
ix:=AskForceHex(Col,Row);
if ix>=0 then
if (gforce[Ix].found=true)or(gforce[Ix].id<>2) then
begin
Pen.Width:=3;
case gForce[ix].Id of
1:
pen.color:=clBlue;
2:
pen.Color:=clRed;
3:
Pen.Color:=clYellow;
else
Pen.Color:=clBlack;
end;
case gForCe[ix].Arrow of
0:
begin
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row +H+4);
LineTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row +H+4);
end;
1:
begin
MoveTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row +H+4);
LineTo(bx+HexWidth*Col+HexWidth-6 ,By+HexHeight*Row+Hs +H);
end;
2:
begin
MoveTo(bx+HexWidth*Col+HexWidth-6 ,By+HexHeight*Row+Hs +H+2);
LineTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row+HexHeight +H-4);
end;
3:
begin
MoveTo(bx+HexWidth*Col+HexWidth-Ws-3 ,By+HexHeight*Row+HexHeight +H-4);
LineTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row+HexHeight +H-4);
end;
4:
begin
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row+HexHeight +H-4);
LineTo(bx+HexWidth*Col+6 ,By+HexHeight*Row+Hs +H+2);
end;
5:
begin
MoveTo(bx+HexWidth*Col+Ws+3 ,By+HexHeight*Row +H+4);
LineTo(bx+HexWidth*Col+6 ,By+HexHeight*Row+Hs +H);
end;
end;
Pen.Width:=1;
end;
font.color:=TextColor;
Brush.Style:=bsClear;
TextOut(bx+HexWidth*Col+Ws+2, By+HexHeight*Row+Hs-10 +H,Caption); //test
TextOut(bx+HexWidth*Col+Ws+2, By+HexHeight*Row+Hs +H,IntToStr(Col)+'-'+IntToStr(Row));
Brush.Style:=bsSolid;
end;
end;
//コンストラクタ
constructor THexMapCpt.Create(AOwner: TComponent);
var
i:longint;
begin
inherited Create(AOwner); //規定コンストラクターを呼び出し
//初期化
PosX:=0; //過去位置
PosY:=0;
ScrLeft:=20; //HexMap 画面表示起点HEX座標位置 X
ScrTop :=20; // Y
HexWidth :=52; //HexのWidth
HexHeight:=50; //HexのHeight
HexCorner:=6; //HexWidth div 6; //Hexの六角形
MapSize:=60; //HexMapの大きさ 縦横16Hex
SetLength(FCenterMap,MapSize,MapSize); //HexMapの縦横Hex数を設定 ★
SetLength(FGeoGraphy,MapSize,MapSize); //HexMapの縦横Hex数を設定 ★
SetLength(gForce,MaxForcecount); //Forceの最大数★
for i:=0 to 15 do
GeoColor[i]:=clWhite;
SelectColor:= $0050A090; // 選択状態の色
MultiColor := $00D2D2A8; // 移動範囲色
SearchColor:= $00A0C0A0; // 索敵成功範囲の色
CaretColor := $008080C0; // キャレットの色
WayColor := clSkyBlue; // 移動経路の色
LineColor := clWhite; // 線の色
ObColor := clRed; // 遮られHexの色
OwnColor := clSkyBlue; //自軍機のHexの色
EnemyColor := $00DECAFD; //敵軍機のHexの色
FFriendColor:= $00BDFFFF; //友軍機のHexの色
UnknownColor:=$00505050; //不明機のHexの色
MakeCenterMap; //遮り計算用のHex中心座標マップ作成
DoubleBuffered:=True; //ちらつき防止
gProFile_visible:=False;
end;
destructor THexMapCpt.Destroy;
begin
inherited; //規定ディストラクターを呼び出し
end;
end.
改造できそうなポイント
気づいた人は、笑っていると思うけど、このプログラムって、表示関係にかなり無駄があります。
-
スクロール関係
毎度、画面、全部を描き直すのじゃなくて、移動する差分の１行や１列を書き換えるようにしたら、実行速度が上がります。 -
範囲関係の表示
説明しやすくするためと、弄って遊ぶために、移動、索敵、攻撃、移動経路など、バラバラに選択範囲を作っています。表示の際は、PrintMap( )内で、１Hexずつ、「このHexはどの範囲に含まれますか？」を問い合わせています。そんなことしなくても、最初から、表示用にひとつだけ配列を作って、移動も索敵も全部ひとつの配列に集計したら、問合せ処理自体が要らなくなりますよね？
参考サイト様
-
画像をアイコンで表示関係
MRXRAY様のホームページから「092_TImageList に格納されている画像を取得」
http://mrxray.on.coocan.jp/Delphi/plSamples/092_TImageList_GetImage.htm#04 -
遮り計算と移動経路を逆順でたどるアイディア関係で参考にさせていただきました。
https://www.redblobgames.com/grids/hexagons/