Here is the source... nothing overly complex, and I tried to add some meaningful comments.
Code: Select all
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, FindFile, StdCtrls, ExtCtrls, ComCtrls, ShellAPI;
const
ShipExtension = '.shp';
{ As we have a 0-based file offset, we use 0 to 4,107 for our file size. }
ShipFileSize = 4108 - 1;
{ Byte definition of ship asset classes. We would normally not be interested
in Passenger and Cargo, but they are put in here for completeness. }
Nothing = 0;
Engine = 1;
Shield = 2;
Missile = 3;
Radar = 4;
Command = 6;
Cargo = 8;
Passenger = 9;
DShield = 10;
Repair = 12;
Stealth = 13;
{ Constant definitions for number of assets allowed per ship side, the file
offset locations of the beginning of each side and the byte offset of each
successive asset location after the initial asset location per side. }
AssetsPerSide = 24;
FrontStart = 3472;
LeftStart = 3568;
RightStart = 3664;
RearStart = 3760;
AssetOffset = 4;
{ Definition of what an empty side will look like in this program. }
EmptySide = '________________________';
{ Location of the Ship name in the file, and its maximum length. }
NameStart = 108;
NameLength = 18;
{ This is our standard ship that will be used when the user presses the
button to create a new ship. Basically just Critical Mass's standard ship
with a little "H" embedded onto the hull. }
NewShip : array [0..ShipFileSize] of Byte =
(160,15,0,0,1,0,0,0,0,0,0,0,83,112,97,99,101,115,104,105,112,32,99,114,101,97,116,101,
100,32,98,121,32,72,67,114,105,116,105,99,97,108,32,77,97,115,115,32,83,104,105,112,32,
69,100,105,116,111,114,46,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,84,101,115,116,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,0,0,0,0,0,0,0,180,194,0,0,0,0,0,0,180,194,0,0,52,66,0,
0,180,66,0,0,0,0,0,0,0,0,0,0,72,66,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,180,66,
0,0,0,0,0,0,180,194,0,0,52,66,0,0,180,66,0,0,0,0,0,0,0,0,0,0,72,66,0,0,0,0,0,0,0,0,0,0,
0,0,2,255,255,0,0,0,0,0,0,0,88,193,0,0,0,0,0,0,153,194,0,0,52,194,0,0,52,194,0,0,32,65,
0,0,32,65,0,0,112,65,3,0,0,0,0,0,0,0,0,0,0,0,2,255,255,0,0,0,0,0,0,0,88,65,0,0,0,0,0,0,
153,194,0,0,52,194,0,0,52,194,0,0,32,65,0,0,32,65,0,0,112,65,2,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,255,0,0,216,193,0,0,216,193,0,0,144,193,0,0,0,0,0,0,106,66,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,216,65,0,0,216,65,0,0,144,65,0,0,0,0,0,0,
106,66,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,144,193,0,
0,216,193,0,0,144,193,0,0,0,0,0,0,106,66,0,0,106,66,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,255,0,0,144,65,0,0,216,65,0,0,144,65,0,0,0,0,0,0,106,66,0,0,106,66,
0,0,0,0,0,0,0,0,0,0,0,0,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,144,193,0,0,144,193,0,0,
88,65,0,0,216,65,0,0,20,66,0,0,16,66,0,0,0,0,0,0,0,0,0,0,0,0,9,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,255,0,0,144,65,0,0,144,65,0,0,88,193,0,0,216,65,0,0,20,66,0,0,16,66,0,0,0,0,0,0,0,
0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,0,128,0,0,144,193,0,0,0,128,0,0,16,66,
0,0,216,65,0,0,216,65,0,0,0,0,0,0,0,0,0,0,0,0,11,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,0,
0,0,0,144,65,0,0,0,0,0,0,16,66,0,0,216,65,0,0,216,65,0,0,0,0,0,0,0,0,0,0,0,0,10,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,2,0,0,0,2,0,0,0,2,0,0,0,2,0,0,0,6,0,0,0,6,0,0,0,3,0,0,0,3,0,0,0,4,0,0,0,4,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,2,0,0,0,2,0,0,0,1,0,0,0,1,0,0,0,4,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,2,0,0,0,2,0,0,0,1,0,0,0,1,0,0,0,
4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,2,0,0,0,1,0,
0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,154,46,67,63,0,0,144,64,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,255,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
type
TForm1 = class(TForm)
lbShips : TListBox;
Label1 : TLabel;
ffFindShips : TFindFile;
bSave: TButton;
iShip: TImage;
eFrontAssets: TEdit;
mKey: TMemo;
eRearAssets: TEdit;
eRightAssets: TEdit;
eLeftAssets: TEdit;
eName: TEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
rgSides: TRadioGroup;
rgAssets: TRadioGroup;
bAddAsset: TButton;
bRemoveAsset: TButton;
bNew: TButton;
sdSaveShip: TSaveDialog;
sbStatus: TStatusBar;
procedure FormShow(Sender: TObject);
procedure ffFindShipsFileMatch(Sender: TObject; const Folder: String; const FileInfo: TSearchRec);
procedure FormCreate(Sender: TObject);
procedure lbShipsClick(Sender: TObject);
procedure bSaveClick(Sender: TObject);
procedure bAddAssetClick(Sender: TObject);
procedure bRemoveAssetClick(Sender: TObject);
procedure bNewClick(Sender: TObject);
procedure sbStatusClick(Sender: TObject);
procedure eLeftAssetsClick(Sender: TObject);
procedure eFrontAssetsClick(Sender: TObject);
procedure eRightAssetsClick(Sender: TObject);
procedure eRearAssetsClick(Sender: TObject);
private
function ReturnDataForOffset (Offset : Integer) : String;
procedure FindShips;
procedure InterpretShipData;
procedure UpdateShipName;
public
end;
var
ShipsLocation : String;
Form1 : TForm1;
ShipsFound : Integer;
{ The byte array that we will use to read in and write out the ship files. }
Ship : array [0..ShipFileSize] of Byte;
ShipFile : File;
ShipFileName : String;
implementation
{$R *.dfm}
{ This function returns a 24 character string to the caller that will contain
a representation of the assets along one side of the ship in question. The
string will be in the form... "CR1RR_1_RRR_____________". }
function TForm1.ReturnDataForOffset ( Offset : Integer
) : String;
var
Loop : Integer;
begin
Result := EmptySide;
{ Loop from 1 to 24 possible asset locations per side from the offset. }
for Loop := 1 to AssetsPerSide do
begin
{ Check the byte value that is held in each asset location. }
case Ship[Offset + (Pred (Loop) * AssetOffset)] of
Nothing : Result[Loop] := '_';
Engine : Result[Loop] := 'E';
Shield : Result[Loop] := '1';
Missile : Result[Loop] := 'M';
Radar : Result[Loop] := 'R';
Command : Result[Loop] := 'C';
DShield : Result[Loop] := '2';
Repair : Result[Loop] := 'B';
Stealth : Result[Loop] := 'S';
{ Useless assets to us at this moment in time. }
Passenger : Result[Loop] := 'P';
Cargo : Result[Loop] := 'O';
end;
end;
end;
{ As the program initialises and becomes visible, it will check the current
directory for Critical Mass .shp files, it will then list them in the list
box at the left-hand side of the screen. It does not recurse down folders. }
procedure TForm1.FormShow ( Sender : TObject
);
begin
FindShips;
if (ShipsFound = 0) then
begin
ShowMessage ('No Critical Mass .shp files were found in the current folder.');
end;
bNewClick (Self);
end;
{ This procedure finds the available .shp files when the program initially
loads. The code was placed into a function, so it could be re-used to refresh
the list of available .shp files when a Save operation takes place. Kind of
lazy, but who cares? }
procedure TForm1.FindShips;
begin
ShipsFound := 0;
lbShips.Clear;
ffFindShips.Criteria.Attribute.Attributes := [ffArchive,ffReadonly];
ffFindShips.Criteria.Files.FileName := '*' + ShipExtension;
ffFindShips.Criteria.Files.Location := '.';
ffFindShips.Criteria.Files.Subfolders := False;
ffFindShips.Execute;
end;
{ For each .shp file that is found, add it to the list box. }
procedure TForm1.ffFindShipsFileMatch ( Sender : TObject;
const Folder : String;
const FileInfo : TSearchRec
);
begin
Inc (ShipsFound);
lbShips.Items.Add (FileInfo.Name);
end;
procedure TForm1.FormCreate ( Sender : TObject
);
begin
ShipsLocation := ExtractFilePath (ParamStr (0));
end;
procedure TForm1.lbShipsClick ( Sender : TObject
);
begin
if (lbShips.ItemIndex <> -1) then
begin
AssignFile (ShipFile,ShipsLocation + lbShips.Items.Strings[lbShips.ItemIndex]);
Reset (ShipFile,1);
if (FileSize (ShipFile) <> (ShipFileSize + 1)) then
begin
CloseFile (ShipFile);
ShowMessage ('The .shp file selected does not have a standard .shp file size of 4,108 bytes.');
end else
begin
{ We want to get the 4,108 bytes read in. }
Reset (ShipFile,ShipFileSize + 1);
BlockRead (ShipFile,Ship,1);
CloseFile (ShipFile);
ShipFileName := lbShips.Items.Strings[lbShips.ItemIndex];
InterpretShipData;
end;
end;
end;
{ When attempting to save a .shp file, we will use the directory we are running
from as the location, and the Ship name text box as the new ship filename. If
users give ships different names to the files they are contained in, then this
is something they should be aware of - shouldn't cause too much of a problem
and the filename can be edited before saving actually takes place regardless. }
procedure TForm1.bSaveClick ( Sender : TObject
);
begin
if ((eName.Text <> '') and (eFrontAssets.Text <> EmptySide) and
(eLeftAssets.Text <> EmptySide) and (eRightAssets.Text <> EmptySide) and
(eRearAssets.Text <> EmptySide)) then
begin
{ Set the folder and filename that we intend to save the. shp file in. }
sdSaveShip.InitialDir := ShipsLocation;
sdSaveShip.FileName := eName.Text + ShipExtension;
{ Ensure that the ship name is written to the byte data before saving. }
UpdateShipName;
if (sdSaveShip.Execute) then
begin
AssignFile (ShipFile,sdSaveShip.FileName);
{ Need to write out the whole 4,108 bytes. }
ReWrite (ShipFile,ShipFileSize + 1);
BlockWrite (ShipFile,Ship,1);
CloseFile (ShipFile);
{ Update the list of available .shp files we have and select the current. }
FindShips;
lbShips.ItemIndex := lbShips.Items.IndexOf (eName.Text + ShipExtension);
end;
end else
begin
ShowMessage ('Sadly, you cannot save an empty .shp file.');
end;
end;
{ This procedure cycles through the important things about a .shp file, i.e.
its name and its assets, and displays them on the screen. The function that
is defined at the top of the file is used here for each ship side. }
procedure TForm1.InterpretShipData;
var
Loop : Integer;
ShipName : String;
begin
ShipName := '';
for Loop := 0 to Pred (NameLength) do
begin
ShipName := ShipName + Chr (Ship[NameStart + Loop]);
end;
eName.Text := ShipName;
eFrontAssets.Text := ReturnDataForOffset (FrontStart);
eLeftAssets.Text := ReturnDataForOffset (LeftStart);
eRightAssets.Text := ReturnDataForOffset (RightStart);
eRearAssets.Text := ReturnDataForOffset (RearStart);
end;
{ This procedure handles the addition of a new asset to a side of the ship. It
has an inner worker procedure that knows how to add an asset to each side of
a ship via the offset value passed to it. The offset value passed to this
procedure is determined by the radio check box that the user has selected. }
procedure TForm1.bAddAssetClick ( Sender : TObject
);
var
Offset : Integer;
{ Add an asset to a side. Find the first asset location on this side that is
empty and add our new asset to it. If an empty asset location is found then
jump out of the loop, if there are no empty asset locations nothing will be
added but, also, we should not get here as there is a check before calling. }
procedure AddAsset ( Offset : Integer
);
var
Loop : Integer;
AssetAdded : Boolean;
begin
AssetAdded := False;
{ Check each asset location for this side. }
for Loop := 1 to AssetsPerSide do
begin
{ Is this asset location currently empty? }
if (Ship[Offset + (Pred (Loop) * AssetOffset)] = Nothing) then
begin
{ If it was, change it from empty to whichever asset we want to add. }
case rgAssets.ItemIndex of
0 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Radar;
1 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Stealth;
2 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Engine;
3 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Shield;
4 : Ship[Offset + (Pred (Loop) * AssetOffset)] := DShield;
5 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Repair;
6 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Command;
7 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Missile;
8 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Cargo;
9 : Ship[Offset + (Pred (Loop) * AssetOffset)] := Passenger;
end;
AssetAdded := True;
Break;
end;
end;
{ If an asset was added successfully, refresh the view of the ship's assets. }
if (AssetAdded) then
begin
case Offset of
FrontStart : eFrontAssets.Text := ReturnDataForOffset (FrontStart);
LeftStart : eLeftAssets.Text := ReturnDataForOffset (LeftStart);
RightStart : eRightAssets.Text := ReturnDataForOffset (RightStart);
RearStart : eRearAssets.Text := ReturnDataForOffset (RearStart);
end;
end else
{ Should never happen, the outer procedure should catch this eventuality. }
begin
ShowMessage ('Asset was not added, possible reason is that the side is full.');
end;
end;
begin
Offset := 0;
{ Check which side we are wanting to add an asset to, and ensure that that
side has space for a new asset. If we are OK, we set the file offset. }
if ((rgSides.ItemIndex = 0) and (Pos ('_',eFrontAssets.Text) > 0)) then
begin
Offset := FrontStart;
end else
if ((rgSides.ItemIndex = 1) and (Pos ('_',eLeftAssets.Text) > 0)) then
begin
Offset := LeftStart;
end else
if ((rgSides.ItemIndex = 2) and (Pos ('_',eRightAssets.Text) > 0)) then
begin
Offset := RightStart;
end else
if ((rgSides.ItemIndex = 3) and (Pos ('_',eRearAssets.Text) > 0)) then
begin
Offset := RearStart;
end;
if (Offset <> 0) then
begin
AddAsset (Offset);
end else
{ If we get here, we either did not select a side (impossible) or the side
currently has no "_" characters in its representation, which means that it
has no space left. }
begin
ShowMessage ('Is it possible that there is no space remaining, "_", on the side that you wish to add an asset?');
end;
end;
{ This procedure handles the removal of an asset from a side of the ship. It
has an inner worker procedure that knows how to remove an asset from each side
of the ship via the offset value passed to it. The offset value passed to this
procedure is determined by the radio check box that the user has selected. }
procedure TForm1.bRemoveAssetClick ( Sender : TObject
);
var
Offset : Integer;
{ Remove an asset from a side. Find the first asset location on this side that
is of the type we want to remove and then change it to be Nothing. If there
is no asset of the type selected a dialogue box will inform the user of that
and no harm done. }
procedure RemoveAsset ( Offset : Integer
);
var
Loop : Integer;
AssetRemoved : Boolean;
AssetToRemove : Byte;
begin
AssetRemoved := False;
AssetToRemove := Nothing;
{ Define the asset type that we would like to remove. }
case rgAssets.ItemIndex of
0 : AssetToRemove := Radar;
1 : AssetToRemove := Stealth;
2 : AssetToRemove := Engine;
3 : AssetToRemove := Shield;
4 : AssetToRemove := DShield;
5 : AssetToRemove := Repair;
6 : AssetToRemove := Command;
7 : AssetToRemove := Missile;
8 : AssetToRemove := Cargo;
9 : AssetToRemove := Passenger;
end;
{ If we somehow haven't selected an asset type, could / should not happen,
then don't bother even searcing for it. }
if (AssetToRemove <> Nothing) then
begin
{ Check each asset location for this side. }
for Loop := 1 to AssetsPerSide do
begin
{ Have we found an asset location that contains the asset type we want? }
if (Ship[Offset + (Pred (Loop) * AssetOffset)] = AssetToRemove) then
begin
{ If so, change it back to Nothing. }
Ship[Offset + (Pred (Loop) * AssetOffset)] := Nothing;
AssetRemoved := True;
Break;
end;
end;
end;
{ If an asset was removed from a side successfully, then update our view. }
if (AssetRemoved) then
begin
case Offset of
FrontStart : eFrontAssets.Text := ReturnDataForOffset (FrontStart);
LeftStart : eLeftAssets.Text := ReturnDataForOffset (LeftStart);
RightStart : eRightAssets.Text := ReturnDataForOffset (RightStart);
RearStart : eRearAssets.Text := ReturnDataForOffset (RearStart);
end;
end else
begin
ShowMessage ('Asset was not removed, possible reason is that the asset you selected did not exist on the side you have selected.');
end;
end;
begin
Offset := 0;
if ((rgSides.ItemIndex = 0) and (eFrontAssets.Text <> EmptySide)) then
begin
Offset := FrontStart;
end else
if ((rgSides.ItemIndex = 1) and (eLeftAssets.Text <> EmptySide)) then
begin
Offset := LeftStart;
end else
if ((rgSides.ItemIndex = 2) and (eRightAssets.Text <> EmptySide)) then
begin
Offset := RightStart;
end else
if ((rgSides.ItemIndex = 3) and (eRearAssets.Text <> EmptySide)) then
begin
Offset := RearStart;
end;
if (Offset <> 0) then
begin
RemoveAsset (Offset);
end else
{ If we get here, we either did not select a side (impossible) or the side is
currently completely empty, i.e. its represenation is equal to EmptySide. }
begin
ShowMessage ('Is it possible that there are already no assets on this side?');
end;
end;
procedure TForm1.bNewClick ( Sender : TObject
);
var
Loop : Integer;
begin
ShipFileName := '';
for Loop := 0 to ShipFileSize do
begin
Ship[Loop] := NewShip[Loop];
end;
InterpretShipData;
eName.Text := 'New Ship';
end;
procedure TForm1.UpdateShipName;
var
Loop : Integer;
ShipName : String;
begin
ShipName := eName.Text;
for Loop := 0 to Pred (NameLength) do
begin
if (Loop <= Length (ShipName)) then
begin
Ship[NameStart + Loop] := Ord (ShipName[Loop + 1]);
end else
begin
Ship[NameStart + Loop] := 0;
end;
end;
end;
procedure TForm1.sbStatusClick ( Sender : TObject
);
begin
ShellExecute (Handle,'open','http://www.hmusiccentre.org.uk',Nil,Nil,SW_NORMAL);
end;
procedure TForm1.eFrontAssetsClick ( Sender : TObject
);
begin
rgSides.ItemIndex := 0;
end;
procedure TForm1.eLeftAssetsClick ( Sender : TObject
);
begin
rgSides.ItemIndex := 1;
end;
procedure TForm1.eRightAssetsClick ( Sender : TObject
);
begin
rgSides.ItemIndex := 2;
end;
procedure TForm1.eRearAssetsClick ( Sender : TObject
);
begin
rgSides.ItemIndex := 3;
end;
end.