Subversion Repositories spacemission

Compare Revisions

No changes between revisions

Regard whitespace Rev 2 → Rev 1

/LevEdit.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property
/SpaceMission.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property
/Signaturen.txt
File deleted
/Global.pas
File deleted
/_PreBuild.bat
File deleted
/_PostBuild.bat
File deleted
/Compiler.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property
/SplInfo.dfm
9,13 → 9,15
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
PixelsPerInch = 106
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object HomeLbl: TLabel
Left = 32
36,9 → 38,9
object FirmaLbl: TLabel
Left = 88
Top = 8
Width = 74
Width = 31
Height = 13
Caption = 'ViaThinkSoft'
Caption = 'Firma'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
50,9 → 52,9
object NameLbl: TLabel
Left = 104
Top = 24
Width = 66
Width = 28
Height = 13
Caption = 'SpaceMission'
Caption = 'Name'
Transparent = True
end
object VersionLbl: TLabel
74,9 → 76,9
object CopyrightLbl: TLabel
Left = 8
Top = 80
Width = 137
Width = 44
Height = 13
Caption = '(C) 2001 - 2011 ViaThinkSoft'
Caption = 'Copyright'
Transparent = True
end
object Copyright2Lbl: TLabel
106,10 → 108,10
object URL1: TLabel
Left = 152
Top = 120
Width = 155
Width = 118
Height = 13
Cursor = crHandPoint
Caption = 'daniel-marschall@viathinksoft.de'
Caption = 'info@daniel-marschall.de'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -11
119,7 → 121,7
Transparent = True
OnClick = URL1Click
end
object OkBtn: TButton
object ElPopupButton1: TButton
Left = 208
Top = 160
Width = 107
126,6 → 128,6
Height = 25
Caption = 'OK'
TabOrder = 0
OnClick = OkBtnClick
OnClick = ElPopupButton1Click
end
end
/LevEdit.dpr
14,10 → 14,9
LevText in 'LevText.pas' {TextForm},
LevSplash in 'LevSplash.pas' {SplashForm},
LevSpeicherung in 'LevSpeicherung.pas' {SpeicherungForm},
SplInfo in 'SplInfo.pas' {InfoForm},
LevInfo in 'LevInfo.pas' {InfoForm},
LevSource in 'LevSource.pas' {SourceForm},
LevOptions in 'LevOptions.pas' {LevelForm},
Global in 'Global.pas';
LevOptions in 'LevOptions.pas' {LevelForm};
 
{$R *.RES}
 
/LevEdit.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/_InnoSetup/Output/setup.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property
/_InnoSetup/SpaceMission.iss
9,7 → 9,7
AppName=SpaceMission
AppVerName=SpaceMission 1.1
AppVersion=1.1
AppCopyright=© Copyright 2001 - 2011 ViaThinkSoft.
AppCopyright=© Copyright 2001 - 2007 ViaThinkSoft.
AppPublisher=ViaThinkSoft
AppPublisherURL=http://www.viathinksoft.de/
AppSupportURL=http://www.daniel-marschall.de/
17,7 → 17,7
DefaultDirName={pf}\SpaceMission
DefaultGroupName=SpaceMission
VersionInfoCompany=ViaThinkSoft
VersionInfoCopyright=© Copyright 2001 - 2011 ViaThinkSoft.
VersionInfoCopyright=© Copyright 2001 - 2007 ViaThinkSoft.
VersionInfoDescription=SpraceMission Setup
VersionInfoTextVersion=1.0.0.0
VersionInfoVersion=1.1
/SplMain.pas
5,7 → 5,7
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem, Dialogs,
StdCtrls, ExtCtrls, Menus, SplInfo, DIB, DXClass, DXSprite, DXDraws, DXInput,
DXSounds, INIFiles, ShellAPI, wininet;
DXSounds, PJVersionInfo, INIFiles, shellapi, wininet;
 
type
TGameScene = (
20,8 → 20,7
TGameInterval = (
giMittel,
giLeicht,
giSchwer,
giMaster
giSchwer
);
 
TMusicTrack = (
44,6 → 43,158
sfLevIntro
);}
 
TMainForm = class(TDXForm)
MainMenu: TMainMenu;
Spiel: TMenuItem;
GameStart: TMenuItem;
GamePause: TMenuItem;
Beenden: TMenuItem;
Einstellungen: TMenuItem;
OptionFullScreen: TMenuItem;
OptionMusic: TMenuItem;
Leer2: TMenuItem;
Leer4: TMenuItem;
Hilfe: TMenuItem;
OptionSound: TMenuItem;
Mitarbeiter: TMenuItem;
Leer3: TMenuItem;
Spielstand: TMenuItem;
Leer5: TMenuItem;
Neustart: TMenuItem;
OptionBreitbild: TMenuItem;
Spielgeschwindigkeit: TMenuItem;
Leicht: TMenuItem;
Mittel: TMenuItem;
Schwer: TMenuItem;
Informationen: TMenuItem;
Leer6: TMenuItem;
Leer1: TMenuItem;
Cheat: TMenuItem;
AufUpdatesprfen1: TMenuItem;
procedure DXDrawFinalize(Sender: TObject);
procedure DXDrawInitialize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
procedure DXTimerActivate(Sender: TObject);
procedure DXTimerDeactivate(Sender: TObject);
procedure OptionFullScreenClick(Sender: TObject);
procedure DXDrawInitializing(Sender: TObject);
procedure GameStartClick(Sender: TObject);
procedure GamePauseClick(Sender: TObject);
procedure BeendenClick(Sender: TObject);
procedure OptionSoundClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure OptionMusicClick(Sender: TObject);
procedure MitarbeiterClick(Sender: TObject);
procedure SpielstandClick(Sender: TObject);
procedure NeustartClick(Sender: TObject);
procedure OptionBreitbildClick(Sender: TObject);
procedure LeichtClick(Sender: TObject);
procedure MittelClick(Sender: TObject);
procedure SchwerClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure InformationenClick(Sender: TObject);
procedure CheatClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure AufUpdatesprfen1Click(Sender: TObject);
private
FInterval: TGameInterval;
FScene: TGameScene;
FMusic: TMusicTrack;
FBlink: DWORD;
FBlinkTime: DWORD;
FFrame, FAngle, FCounter, FEnemyAdventPos: Integer;
procedure StartScene(Scene: TGameScene);
procedure EndScene;
procedure BlinkStart;
procedure BlinkUpdate;
procedure StartSceneTitle;
procedure SceneTitle;
procedure EndSceneTitle;
procedure StartSceneMain;
procedure SceneMain;
procedure EndSceneMain;
procedure StartSceneGameOver;
procedure SceneGameOver;
procedure EndSceneGameOver;
procedure StartSceneWin;
procedure SceneWin;
procedure EndSceneWin;
procedure StartSceneNewLevel;
procedure SceneNewLevel;
procedure EndSceneNewLevel;
public
FDirectory: string;
FEngineVersion: string;
FNextScene: TGameScene;
FScore: Integer;
FNotSave: boolean;
FLife: integer;
FLevel: integer;
FMenuItem: integer;
FBossLife: integer;
FRestEnemys: integer;
FCheat: boolean;
{ VCL-Ersatz }
dxdraw: TDxDraw;
imagelist: TDxImageList;
spriteengine: tdxspriteengine;
dxsound: tdxsound;
wavelist: tdxwavelist;
dxinput: tdxinput;
dxtimer: tdxtimer;
versioninfo: tpjversioninfo;
{ Level-Routinen }
procedure NewLevel(lev: integer);
procedure DeleteArray;
{ MCI-Routinen }
function StatusMusic(Name: TMusicTrack): string;
procedure PlayMusic(Name: TMusicTrack);
//procedure StopMusic(Name: TMusicTrack);
procedure PauseMusic(Name: TMusicTrack);
procedure ResumeMusic(Name: TMusicTrack);
procedure DestroyMusic(Name: TMusicTrack);
procedure OpenMusic(Name: TMusicTrack);
{ Sound-Routinen }
function SoundKarte: boolean;
procedure PlaySound(Name: string; Wait: Boolean);
{ Initialisiations-Routinen }
procedure DXInit;
procedure SoundInit;
procedure MusicInit;
{ Einstellungs-Routinen }
procedure LoadOptions;
procedure WriteOptions;
{ Farb-Routinen }
function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
procedure PalleteAnim(Col: TRGBQuad; Time: Integer);
end;
 
var
MainForm: TMainForm;
 
const
conleicht = 650 div 60;
conmittel = 1000 div 60;
conschwer = 1350 div 60;
lives = 6;
FCompVersion = '1.0';
 
implementation
 
uses
SplSplash, SplSpeicherung, SplText, SplCheat;
 
const
FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';
 
{$R *.DFM}
 
{$R WindowsXP.res}
 
type
 
TBackground = class(TBackgroundSprite)
private
FSpeed: Double;
78,7 → 229,6
procedure DoMove(MoveCount: Integer); override;
public
constructor Create(AParent: TSprite); override;
procedure FlyAway;
end;
 
TTamaSprite = class(TImageSprite)
99,7 → 249,7
FMode: Integer;
procedure Hit; virtual;
protected
procedure HitEnemy(ADead: Boolean); virtual;
procedure HitEnemy(Deaded: Boolean); virtual;
public
constructor Create(AParent: TSprite); override;
destructor Destroy; override;
117,7 → 267,7
TEnemyMeteor = class(TEnemy)
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
125,7 → 275,7
TEnemyUFO = class(TEnemy)
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
137,7 → 287,7
FOldTamaTime: Integer;
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
145,7 → 295,7
TEnemyAttacker = class(TEnemy)
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
158,7 → 308,7
FPutTama: Boolean;
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
170,7 → 320,7
FOldTamaTime: Integer;
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
184,180 → 334,28
waiter1, waiter2: integer;
protected
procedure DoMove(MoveCount: Integer); override;
procedure HitEnemy(ADead: Boolean); override;
procedure HitEnemy(Deaded: Boolean); override;
public
constructor Create(AParent: TSprite); override;
end;
 
TNothing = class(TImageSprite);
TNoting = class(TImageSprite);
 
TSpriteClass = class of TSprite;
 
TEnemyAdvent = record
spriteClass: TSpriteClass;
c: TSpriteClass;
x: extended;
y: extended;
lifes: integer;
l: integer;
end;
 
TMainForm = class(TDXForm)
MainMenu: TMainMenu;
Spiel: TMenuItem;
GameStart: TMenuItem;
GamePause: TMenuItem;
Beenden: TMenuItem;
Einstellungen: TMenuItem;
OptionFullScreen: TMenuItem;
OptionMusic: TMenuItem;
Leer2: TMenuItem;
Leer4: TMenuItem;
Hilfe: TMenuItem;
OptionSound: TMenuItem;
Mitarbeiter: TMenuItem;
Leer3: TMenuItem;
Spielstand: TMenuItem;
Leer5: TMenuItem;
Neustart: TMenuItem;
OptionBreitbild: TMenuItem;
Spielgeschwindigkeit: TMenuItem;
Leicht: TMenuItem;
Mittel: TMenuItem;
Schwer: TMenuItem;
Informationen: TMenuItem;
Leer6: TMenuItem;
Leer1: TMenuItem;
Cheat: TMenuItem;
CheckUpdates: TMenuItem;
Master: TMenuItem;
procedure DXDrawFinalize(Sender: TObject);
procedure DXDrawInitialize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
procedure DXTimerActivate(Sender: TObject);
procedure DXTimerDeactivate(Sender: TObject);
procedure OptionFullScreenClick(Sender: TObject);
procedure DXDrawInitializing(Sender: TObject);
procedure GameStartClick(Sender: TObject);
procedure GamePauseClick(Sender: TObject);
procedure BeendenClick(Sender: TObject);
procedure OptionSoundClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure OptionMusicClick(Sender: TObject);
procedure MitarbeiterClick(Sender: TObject);
procedure SpielstandClick(Sender: TObject);
procedure NeustartClick(Sender: TObject);
procedure OptionBreitbildClick(Sender: TObject);
procedure LeichtClick(Sender: TObject);
procedure MittelClick(Sender: TObject);
procedure SchwerClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure InformationenClick(Sender: TObject);
procedure CheatClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure CheckUpdatesClick(Sender: TObject);
procedure MasterClick(Sender: TObject);
private
ProgrammGestartet: boolean;
FInterval: TGameInterval;
FScene: TGameScene;
FMusic: TMusicTrack;
FBlink: DWORD;
FBlinkTime: DWORD;
FFrame, FAngle, FCounter, FEnemyAdventPos: Integer;
PlayerSprite: TPlayerSprite;
procedure StartScene(Scene: TGameScene);
procedure EndScene;
procedure BlinkStart;
procedure BlinkUpdate;
procedure StartSceneTitle;
procedure SceneTitle;
procedure EndSceneTitle;
procedure StartSceneMain;
procedure SceneMain;
procedure EndSceneMain;
procedure StartSceneGameOver;
procedure SceneGameOver;
procedure EndSceneGameOver;
procedure StartSceneWin;
procedure SceneWin;
procedure EndSceneWin;
procedure StartSceneNewLevel;
procedure SceneNewLevel;
procedure EndSceneNewLevel;
public
FNextScene: TGameScene;
FScore: Integer;
FNotSave: boolean;
FLife: integer;
FLevel: integer;
FMenuItem: integer;
FBossLife: integer;
FRestEnemys: integer;
FCheat: boolean;
{ VCL-Ersatz }
dxdraw: TDxDraw;
imagelist: TDxImageList;
spriteengine: tdxspriteengine;
dxsound: tdxsound;
wavelist: tdxwavelist;
dxinput: tdxinput;
dxtimer: tdxtimer;
{ Level-Routinen }
procedure NewLevel(lev: integer);
procedure DeleteArray;
{ MCI-Routinen }
function StatusMusic(Name: TMusicTrack): string;
procedure PlayMusic(Name: TMusicTrack);
//procedure StopMusic(Name: TMusicTrack);
procedure PauseMusic(Name: TMusicTrack);
procedure ResumeMusic(Name: TMusicTrack);
procedure DestroyMusic(Name: TMusicTrack);
procedure OpenMusic(Name: TMusicTrack);
{ Sound-Routinen }
function SoundKarte: boolean;
procedure PlaySound(Name: string; Wait: Boolean);
{ Initialisiations-Routinen }
procedure DXInit;
procedure SoundInit;
procedure MusicInit;
{ Einstellungs-Routinen }
procedure LoadOptions;
procedure WriteOptions;
{ Farb-Routinen }
function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
procedure PalleteAnim(Col: TRGBQuad; Time: Integer);
end;
 
var
MainForm: TMainForm;
 
const
conleicht = 650 div 60; // 10
conmittel = 1000 div 60; // 16
conschwer = 1350 div 60; // 22
conmaster = 2000 div 60; // 33
lives = 6;
 
implementation
 
uses
SplSplash, SplSpeicherung, SplText, SplCheat, Global;
 
resourcestring
FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';
 
{$R *.DFM}
 
{$R WindowsXP.res}
 
var // TODO: irgendwo hinpacken. irgendwo!!!
EnemyAdventTable: array[0..9999] of TEnemyAdvent; // TODO: dyn
EnemyAdventTable: array[0..9999] of TEnemyAdvent;
Crash2, ec: integer;
BossExists, Crash, crashsound: boolean;
BossExists, Crash, crashsound, SpielerFliegtFort: boolean;
pos: array[1..4] of integer;
enemys: array[1..27] of TSpriteClass;
levact: integer;
 
const
DXInputButton = [isButton1, isButton2, isButton3,
366,15 → 364,6
isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,
isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32];
 
const // TODO: Auch für Enemies
PLAYER_MODE_NORMAL = 0;
PLAYER_MODE_DEAD = 1;
PLAYER_MODE_DEAD_VANISHED = 2;
PLAYER_MODE_FLYAWAY = 3;
PLAYER_MODE_ENTER = 4;
 
// TODO: Code komplett überarbeiten. Bessere Ableitungen machen
 
constructor TPlayerSprite.Create(AParent: TSprite);
begin
inherited Create(AParent);
387,7 → 376,7
AnimCount := Image.PatternCount;
AnimLooped := True;
AnimSpeed := 15/1000;
FMode := PLAYER_MODE_ENTER;
FMode := 4;
end;
 
procedure TPlayerSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
404,7 → 393,7
MainForm.PlaySound('Explosion', false);
Collisioned := false;
FCounter := 0;
FMode := PLAYER_MODE_DEAD;
FMode := 1;
Done := false;
Image := MainForm.ImageList.Items.Find('Explosion');
Width := Image.Width;
427,11 → 416,10
end;
 
procedure TPlayerSprite.DoMove(MoveCount: Integer);
const
WegduesKonstante = 1.75;
begin
inherited DoMove(MoveCount);
if FMode=PLAYER_MODE_NORMAL then
if SpielerFliegtFort then FMode := 3;
if FMode=0 then
begin
if isUp in MainForm.DXInput.States then Y := Y - (250/1000)*MoveCount;
if isDown in MainForm.DXInput.States then Y := Y + (250/1000)*MoveCount;
457,15 → 445,15
end;
end;
Collision;
end else if FMode=PLAYER_MODE_DEAD then
end else if FMode=1 then
begin
if FCounter>200 then
begin
FCounter := 0;
FMode := PLAYER_MODE_DEAD_VANISHED;
FMode := 2;
Visible := false;
end;
end else if FMode=PLAYER_MODE_DEAD_VANISHED then
end else if FMode=2 then
begin
if FCounter>1500 then
begin
474,10 → 462,9
MainForm.PalleteAnim(RGBQuad(0, 0, 0), 300);
Sleep(200);
end;
end else if FMode=PLAYER_MODE_FLYAWAY then
end else if FMode=3 then
begin
// FUT: "Wusch" sound?
X := X + MoveCount*(300/1000) * (X/MainForm.DXDraw.Width + WegduesKonstante);
X := X + MoveCount*(300/1000);
if X > MainForm.DXDraw.Width+Width then
begin
Dead;
486,19 → 473,14
MainForm.PlaySound('SceneMov', false);
MainForm.PalleteAnim(RGBQuad(0, 0, 0), 300);
end;
end else if FMode = PLAYER_MODE_ENTER then
end else if FMode=4 then
begin
X := X + MoveCount*(300/1000);
if X > 19 then FMode := PLAYER_MODE_NORMAL;
if X > 19 then FMode := 0;
end;
inc(FCounter, MoveCount);
end;
 
procedure TPlayerSprite.FlyAway;
begin
FMode := PLAYER_MODE_FLYAWAY;
end;
 
procedure TMainForm.DXInit;
begin
try
709,9 → 691,9
HitEnemy(False);
end;
 
procedure TEnemy.HitEnemy(ADead: Boolean);
procedure TEnemy.HitEnemy(Deaded: Boolean);
begin
if ADead then MainForm.PlaySound('Explosion', False);
if Deaded then MainForm.PlaySound('Explosion', False);
end;
 
constructor TEnemyUFO.Create(AParent: TSprite);
723,7 → 705,7
AnimCount := Image.PatternCount;
AnimLooped := True;
AnimSpeed := 15/1000;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
end;
 
constructor TEnemy.Create(AParent: TSprite);
739,9 → 721,9
dec(ec);
end;
 
procedure TEnemyUFO.HitEnemy(ADead: Boolean);
procedure TEnemyUFO.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 2;
789,9 → 771,9
inc(FCounter, MoveCount);
end;
 
procedure TEnemyUFO2.HitEnemy(ADead: Boolean);
procedure TEnemyUFO2.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 2;
820,7 → 802,7
AnimCount := Image.PatternCount;
AnimLooped := True;
AnimSpeed := 15/1000;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
end;
 
procedure TEnemyUFO.DoMove(MoveCount: Integer);
849,12 → 831,12
AnimLooped := True;
AnimSpeed := 15/1000;
PixelCheck := True;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
end;
 
procedure TEnemyAttacker.HitEnemy(ADead: Boolean);
procedure TEnemyAttacker.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 2;
902,15 → 884,15
AnimSpeed := 15/1000;
PixelCheck := True;
Collisioned := False;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
MainForm.FBossLife := FLife;
waiter1 := 0;
waiter2 := 0;
end;
 
procedure TEnemyBoss.HitEnemy(ADead: Boolean);
procedure TEnemyBoss.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 2;
1008,12 → 990,12
AnimLooped := True;
AnimSpeed := 15/1000;
PixelCheck := True;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
end;
 
procedure TEnemyAttacker2.HitEnemy(ADead: Boolean);
procedure TEnemyAttacker2.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 2;
1083,9 → 1065,9
inc(FCounter, MoveCount);
end;
 
procedure TEnemyAttacker3.HitEnemy(ADead: Boolean);
procedure TEnemyAttacker3.HitEnemy(Deaded: Boolean);
begin
if ADead then
if Deaded then
begin
MainForm.PlaySound('Explosion', False);
FMode := 1;
1141,7 → 1123,7
AnimLooped := True;
AnimSpeed := 15/1000;
PixelCheck := True;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].lifes;
FLife := EnemyAdventTable[mainform.FEnemyAdventPos].l;
end;
 
function TMainForm.SoundKarte: boolean;
1153,9 → 1135,13
var
Ergebnis: string;
daten: textfile;
i: integer;
punkt: integer;
ok: boolean;
begin
{ Beginne VCL-Ersatz }
versioninfo := tpjversioninfo.Create(self);
 
dxtimer := tdxtimer.Create(self);
dxtimer.Interval := 33;
dxtimer.OnActivate := DXTimerActivate;
1205,7 → 1191,15
 
{ Ende VCL-Ersatz }
 
Application.Title := 'SpaceMission '+ProgramVersion;
punkt := 0;
FDirectory := extractfilepath(paramstr(0));
versioninfo.filename := paramstr(0);
for i := 1 to length(versioninfo.ProductVersion) do
begin
if copy(versioninfo.ProductVersion, i, 1) = '.' then inc(punkt);
if punkt < 2 then fengineversion := fengineversion+copy(versioninfo.ProductVersion, i, 1);
end;
Application.Title := 'SpaceMission '+FEngineVersion;
LoadOptions;
DXInit;
SoundInit;
1217,7 → 1211,7
Reset(daten);
ok := true;
ReadLN(daten, Ergebnis);
if Ergebnis <> '; SpaceMission '+ProgramVersion then ok := false;
if Ergebnis <> '; SpaceMission '+mainform.FEngineVersion then ok := false;
ReadLN(daten, Ergebnis);
if ergebnis <> '; SAV-File' then ok := false;
if not ok then
1337,7 → 1331,7
Result := resStr;
end;
 
procedure TMainForm.CheckUpdatesClick(Sender: TObject);
procedure TMainForm.AufUpdatesprfen1Click(Sender: TObject);
var
temp: string;
begin
1348,7 → 1342,7
end
else
begin
if GetHTML('http://www.viathinksoft.de/update/?id=spacemission') <> ProgramVersion then
if GetHTML('http://www.viathinksoft.de/update/?id=spacemission') <> '1.1d' then
begin
if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@spacemission'), '', '', sw_normal);
1474,6 → 1468,9
DXTimer.Enabled := False;
end;
 
var
ProgrammGestartet: boolean;
 
procedure TMainForm.DXTimerActivate(Sender: TObject);
begin
Caption := Application.Title;
1560,7 → 1557,6
if FInterval = giLeicht then INIDatei.WriteInteger('Settings', 'Speed', 1);
if FInterval = giMittel then INIDatei.WriteInteger('Settings', 'Speed', 2);
if FInterval = giSchwer then INIDatei.WriteInteger('Settings', 'Speed', 3);
if FInterval = giMaster then INIDatei.WriteInteger('Settings', 'Speed', 4);
INIDatei.Free;
end;
 
1588,11 → 1584,6
FInterval := giSchwer;
Schwer.checked := true;
end;
if INIDatei.ReadInteger('Settings', 'Speed', 2) = 4 then
begin
FInterval := giMaster;
Master.checked := true;
end;
INIDatei.Free;
WriteOptions;
end;
1713,6 → 1704,7
i, j: Integer;}
begin
sleep(500);
SpielerFliegtFort := false;
FCounter := 0;
NewLevel(FLevel);
BossExists := false;
1719,7 → 1711,7
PlayMusic(mtGame);
FEnemyAdventPos := 1;
FFrame := -4;
PlayerSprite := TPlayerSprite.Create(SpriteEngine.Engine);
TPlayerSprite.Create(SpriteEngine.Engine);
with TBackground.Create(SpriteEngine.Engine) do
begin
SetMapSize(1, 1);
1862,19 → 1854,20
var
i: integer;
begin
for i := Low(EnemyAdventTable) to High(EnemyAdventTable) do
for i := 1 to 9999 do
begin
EnemyAdventTable[i].spriteClass := TNothing;
EnemyAdventTable[i].c := tnoting;
EnemyAdventTable[i].x := 0;
EnemyAdventTable[i].y := 0;
EnemyAdventTable[i].lifes := 0;
EnemyAdventTable[i].l := 0;
end;
FRestEnemys := 0;
end;
 
var
levact: integer;
 
procedure TMainForm.NewLevel(lev: integer);
resourcestring
LNG_LEVEL_INVALID = 'Das Level Nr. %d ist ungültig!'+#13#10+'Das Programm wird beendet.';
var
act: integer;
filex: textfile;
1914,17 → 1907,17
for act := 1 to lev*75-1 do
begin
inc(FRestEnemys);
EnemyAdventTable[act].spriteClass := enemys[random(lev+2)+1];
if EnemyAdventTable[act].spriteClass = TEnemyAttacker2 then EnemyAdventTable[act].spriteClass := enemys[random(lev+2)+1]; {O_o}
EnemyAdventTable[act].c := enemys[random(lev+2)+1];
if EnemyAdventTable[act].c = TEnemyAttacker2 then EnemyAdventTable[act].c := enemys[random(lev+2)+1]; {O_o}
EnemyAdventTable[act].x := act*30 + random(85-(lev+(random(lev))*2)){O_o};
EnemyAdventTable[act].y := random(dxdraw.surfaceheight);
if (EnemyAdventTable[act].spriteClass <> TEnemyMeteor) and (EnemyAdventTable[act].spriteClass <> TEnemyAttacker2) then EnemyAdventTable[act].lifes := random(lev)+1;
if EnemyAdventTable[act].spriteClass = TEnemyAttacker2 then EnemyAdventTable[act].lifes := random(6)+1{O_o};
if (EnemyAdventTable[act].c <> TEnemyMeteor) and (EnemyAdventTable[act].c <> TEnemyAttacker2) then EnemyAdventTable[act].l := random(lev)+1;
if EnemyAdventTable[act].c = TEnemyAttacker2 then EnemyAdventTable[act].l := random(6)+1{O_o};
end;
EnemyAdventTable[lev*75].spriteClass := TEnemyBoss;
EnemyAdventTable[lev*75].c := TEnemyBoss;
EnemyAdventTable[lev*75].x := lev*75*30{O_o} div lev;
EnemyAdventTable[lev*75].y := (dxdraw.surfaceheight div 2) - (MainForm.ImageList.Items.Find('Enemy-boss').height div 2);
EnemyAdventTable[lev*75].lifes := lev*5;
EnemyAdventTable[lev*75].l := lev*5;
inc(FRestEnemys);
end
else
1948,7 → 1941,7
readln(filex, ergebniss);
if ergebniss <> '; SpaceMission '+FCompVersion then
begin
showmessage(Format(LNG_LEVEL_INVALID, [lev]));
showmessage('Das Level '+inttostr(lev)+' ist ungültig!'+#13#10+'Das Programm wird beendet.');
application.terminate;
exit;
end;
1955,7 → 1948,7
readln(filex, ergebniss);
if ergebniss <> '; LEV-File' then
begin
showmessage(Format(LNG_LEVEL_INVALID, [lev]));
showmessage('Das Level '+inttostr(lev)+' ist ungültig!'+#13#10+'Das Programm wird beendet.');
application.terminate;
exit;
end;
1968,7 → 1961,7
begin
inc(pos[levact]);
inc(FRestEnemys);
EnemyAdventTable[pos[levact]].spriteClass := enemys[strtoint(ergebniss)];
EnemyAdventTable[pos[levact]].c := enemys[strtoint(ergebniss)];
end;
if levact = 2 then
begin
1983,7 → 1976,7
if levact = 4 then
begin
inc(pos[levact]);
EnemyAdventTable[pos[levact]].lifes := strtoint(ergebniss);
EnemyAdventTable[pos[levact]].l := strtoint(ergebniss);
end;
end;
closefile(filex);
2034,18 → 2027,17
Textout((dxdraw.surfaceWidth div 2)-150, (dxdraw.surfaceheight div 2), 'Zufallslevel');
Textout((dxdraw.surfaceWidth div 2)-185, (dxdraw.surfaceheight div 2), '>');
end;
{ if (FBlink div 300) mod 2=0 then
if (FBlink div 300) mod 2=0 then
begin
Font.Color := clGreen;
Textout((dxdraw.surfaceWidth div 2)-187, dxdraw.surfaceheight-117, 'Weiter mit Leertaste');
Font.Color := clLime;
Textout((dxdraw.surfaceWidth div 2)-185, dxdraw.surfaceheight-115, 'Weiter mit Leertaste');
end; }
end;
BlinkUpdate;
Release;
end;
// Weiter mit Leertaste oder Enter
if (isButton1 in DXInput.States) or (isButton2 in DXInput.States) then
if isButton1 in DXInput.States then
begin
FLevel := 1;
if ((FMenuItem=1) and (fileexists(FDirectory+'Levels\Level '+inttostr(FLevel)+'.lev')=false)) or ((FMenuItem=2) and (FLevel > 20)) then
2068,7 → 2060,6
if FInterval = giLeicht then SpriteEngine.Move(conleicht);
if FInterval = giMittel then SpriteEngine.Move(conmittel);
if FInterval = giSchwer then SpriteEngine.Move(conschwer);
if FInterval = giMaster then SpriteEngine.Move(conmaster);
SpriteEngine.Dead;
while (Low(EnemyAdventTable)<=FEnemyAdventPos) and
(FEnemyAdventPos<=High(EnemyAdventTable)) and
2075,11 → 2066,11
((EnemyAdventTable[FEnemyAdventPos].x / 4)<=FFrame) and
(FRestEnemys>0) do
begin
if EnemyAdventTable[FEnemyAdventPos].spriteClass <> TNothing then
if EnemyAdventTable[FEnemyAdventPos].c <> TNoting then
begin
with EnemyAdventTable[FEnemyAdventPos] do
begin
Enemy := spriteClass.Create(SpriteEngine.Engine);
Enemy := c.Create(SpriteEngine.Engine);
Enemy.x := dxdraw.surfacewidth;
//Enemy.y := y;
if y <> 0 then Enemy.y := dxdraw.surfaceheight / (480{maximale Bandbreite im alten Format} / y)
2141,10 → 2132,8
Font.Color := clFuchsia;
Textout(450, 440, 'Einheiten: ' + IntToStr(RestlicheEinheiten));
end;}
if BossExists and (FBossLife>0) then
if BossExists and (FBossLife>0) and (FRestEnemys>0) then
begin
if (FRestEnemys>0) then
begin
Font.Color := clGreen;
Textout(dxdraw.surfacewidth-191, dxdraw.surfaceheight-81, 'Boss: ' + IntToStr(FBossLife));
Textout(dxdraw.surfacewidth-191, dxdraw.surfaceheight-41, 'Einheiten: ' + IntToStr(FRestEnemys));
2152,7 → 2141,7
Textout(dxdraw.surfacewidth-190, dxdraw.surfaceheight-80, 'Boss: ' + IntToStr(FBossLife));
Textout(dxdraw.surfacewidth-190, dxdraw.surfaceheight-40, 'Einheiten: ' + IntToStr(FRestEnemys));
end;
if (FRestEnemys<1) then
if BossExists and (FBossLife>0) and (FRestEnemys<1) then
begin
Font.Color := clGreen;
Textout(dxdraw.surfacewidth-191, dxdraw.surfaceheight-41, 'Boss: ' + IntToStr(FBossLife));
2159,8 → 2148,7
Font.Color := clLime;
Textout(dxdraw.surfacewidth-190, dxdraw.surfaceheight-40, 'Boss: ' + IntToStr(FBossLife));
end;
end;
if (FRestEnemys>0) and not Bossexists then
if (FRestEnemys>0) and (Bossexists=false) then
begin
Font.Color := clGreen;
Textout(dxdraw.surfacewidth-191, dxdraw.surfaceheight-41, 'Einheiten: ' + IntToStr(FRestEnemys));
2172,7 → 2160,7
end
else
begin
DXDraw.Surface.Canvas.Font.Color := clGreen; // Grüne schrift bei gescheitert? FIXME
DXDraw.Surface.Canvas.Font.Color := clGreen;
DXDraw.Surface.Canvas.Textout(dxdraw.surfacewidth-251, dxdraw.surfaceheight-41, 'Mission gescheitert!');
DXDraw.Surface.Canvas.Font.Color := clLime;
DXDraw.Surface.Canvas.Textout(dxdraw.surfacewidth-250, dxdraw.surfaceheight-40, 'Mission gescheitert!');
2179,8 → 2167,7
DXDraw.Surface.Canvas.Release;
end;
if FRestEnemys<0 then FRestEnemys := 0; //Muss das sein?
if (Ec=0) and (FRestEnemys=0){ and (SpielerFliegtFort = false)}
and ((BossExists and (FBossLife=0)) or not BossExists) then
if (Ec=0) and (FRestEnemys=0){ and (SpielerFliegtFort = false)} then
begin
DXDraw.Surface.Canvas.Font.Color := clGreen;
DXDraw.Surface.Canvas.Textout(dxdraw.surfacewidth-251, dxdraw.surfaceheight-41, 'Mission erfolgreich!');
2189,7 → 2176,7
DXDraw.Surface.Canvas.Release;
Sleep(1);
inc(FCounter);
if FCounter>150{200} then PlayerSprite.FlyAway;
if FCounter>150{200} then SpielerFliegtFort := true;
end;
end;
end;
2325,38 → 2312,23
procedure TMainForm.OptionMusicClick(Sender: TObject);
begin
OptionMusic.Checked := not OptionMusic.Checked;
if OptionMusic.Checked then
begin
PlayMusic(FMusic)
end
else
begin
DestroyMusic(FMusic);
end;
if OptionMusic.Checked then PlayMusic(FMusic)
else DestroyMusic(FMusic);
WriteOptions;
end;
 
procedure TMainForm.MasterClick(Sender: TObject);
begin
master.checked := true;
FInterval := giMaster;
writeoptions;
end;
 
procedure TMainForm.MitarbeiterClick(Sender: TObject);
resourcestring
LNG_NOTFOUND = 'Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!';
const
MitwirkendeTxt = 'Texte\Mitwirkende.txt';
begin
if not fileexists(fdirectory+MitwirkendeTxt) then
if not fileexists(mainform.fdirectory+'Texte\Mitwirkende.txt') then
begin
MessageDLG(Format(LNG_NOTFOUND, [MitwirkendeTxt]), mtWarning, [mbOK], 0);
Exit;
MessageDLG('Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',
mtWarning, [mbOK], 0);
end
else
begin
TextForm.memo1.lines.loadfromfile(mainform.FDirectory+'Texte\Mitwirkende.txt');
TextForm.showmodal;
end;
 
TextForm.memo1.lines.loadfromfile(FDirectory+MitwirkendeTxt);
TextForm.ShowModal;
end;
 
procedure TEnemyMeteor.DoMove(MoveCount: Integer);
2365,9 → 2337,9
if X < -Width then Dead;
end;
 
procedure TEnemyMeteor.HitEnemy(ADead: Boolean);
procedure TEnemyMeteor.HitEnemy(Deaded: Boolean);
begin
if ADead then Collisioned := True;
if deaded then Collisioned := True;
MainForm.PlaySound('Hit', False);
end;
 
2459,9 → 2431,7
 
procedure TMainForm.InformationenClick(Sender: TObject);
begin
dxtimer.enabled := false;
InfoForm.showmodal;
if not mainform.gamepause.checked then mainform.dxtimer.enabled := true;
end;
 
procedure TMainForm.CheatClick(Sender: TObject);
2480,6 → 2450,7
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
versioninfo.free;
imagelist.free;
spriteengine.free;
dxdraw.Free;
/LevSpeicherung.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/ComMain.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplSpeicherung.dfm
9,7 → 9,7
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
16,7 → 16,7
Position = poMainFormCenter
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 106
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 8
/LevMain.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplMain.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/Einstellungen/SpaceMission.ini
1,6 → 1,6
[Settings]
Music=0
Sound=0
Music=1
Sound=1
FullScreen=0
ScreenAutoSize=1
Speed=4
Speed=2
/SplCheat.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/LevSource.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SpaceMission.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplSplash.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplInfo.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SpaceMission.cfg
31,12 → 31,12
-M
-$M16384,1048576
-K$00400000
-LE"C:\Users\Daniel Marschall\Documents\Borland Studio-Projekte\Bpl"
-LN"C:\Users\Daniel Marschall\Documents\Borland Studio-Projekte\Bpl"
-U"VCL_DELPHIX_D6"
-O"VCL_DELPHIX_D6"
-I"VCL_DELPHIX_D6"
-R"VCL_DELPHIX_D6"
-LE"D:\Eigene Dateien\Borland Studio-Projekte\Bpl"
-LN"D:\Eigene Dateien\Borland Studio-Projekte\Bpl"
-U"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-O"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-I"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-R"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-w-HIDDEN_VIRTUAL
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
/Compiler.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplSpeicherung.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Compiler.bdsproj.local
0,0 → 1,2
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>
/LevText.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplMain.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SpaceMission.dpr
13,8 → 13,7
SplSplash in 'SplSplash.pas' {SplashForm},
SplSpeicherung in 'SplSpeicherung.pas' {SpeicherungForm},
SplInfo in 'SplInfo.pas' {InfoForm},
SplCheat in 'SplCheat.pas' {CheatForm},
Global in 'Global.pas';
SplCheat in 'SplCheat.pas' {CheatForm};
 
{$R *.RES}
 
/LevInfo.pas
0,0 → 1,75
unit LevInfo;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ShellAPI, ExtCtrls;
 
type
TInfoForm = class(TForm)
ElPopupButton1: TButton;
HomeLbl: TLabel;
Image: TImage;
FirmaLbl: TLabel;
NameLbl: TLabel;
VersionLbl: TLabel;
EMailLbl: TLabel;
CopyrightLbl: TLabel;
Copyright2Lbl: TLabel;
URL2: TLabel;
URL1: TLabel;
procedure ElPopupButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure URL1Click(Sender: TObject);
procedure URL2Click(Sender: TObject);
end;
 
var
InfoForm: TInfoForm;
 
implementation
 
uses
LevMain;
 
{$R *.DFM}
 
procedure TInfoForm.ElPopupButton1Click(Sender: TObject);
begin
close;
end;
 
procedure TInfoForm.FormCreate(Sender: TObject);
begin
VersionLbl.caption := 'Version ' + mainform.fengineversion;
CopyrightLbl.caption := mainform.versioninfo.LegalCopyright + '.';
FirmaLbl.caption := mainform.versioninfo.CompanyName;
NameLbl.caption := 'SpaceMission' + #13#10 + 'Leveleditor'; // auslesen!
image.picture.loadfromfile(mainform.FDirectory + 'Bilder\Delphi.bmp');
end;
 
procedure TInfoForm.FormShow(Sender: TObject);
begin
mainform.dxtimer.enabled := false;
end;
 
procedure TInfoForm.FormHide(Sender: TObject);
begin
mainform.dxtimer.enabled := true;
end;
 
procedure TInfoForm.URL2Click(Sender: TObject);
begin
shellexecute(application.Handle, 'open', pchar('http://'+url2.caption+'/'), nil, nil, SW_SHOW);
end;
 
procedure TInfoForm.URL1Click(Sender: TObject);
begin
shellexecute(application.Handle, 'open', pchar('mailto:'+url1.Caption+'?subject=SpaceMission ' + mainform.fengineversion), nil, nil, SW_SHOW);
end;
 
end.
 
/LevEdit.bdsproj.local
0,0 → 1,2
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>
/SpaceMission.bdsproj.local
0,0 → 1,2
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>
/SpaceMission.bdsproj
123,7 → 123,7
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath">VCL_DELPHIX_D6</Directories>
<Directories Name="SearchPath">VCL_DELPHIX_D6;VCL_PJVERSIONINFO</Directories>
<Directories Name="Packages">VCL50;VCLX50;VCLSMP50;VCLDB50;VCLADO50;ibevnt50;VCLBDE50;VCLDBX50;QRPT50;TEEUI50;TEEDB50;TEE50;DSS50;TEEQR50;VCLIB50;VCLMID50;VCLIE50;INETDB50;INET50;NMFAST50;WEBMID50;dclocx50;dclaxserver50;packapi</Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
149,7 → 149,7
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">1</VersionInfo>
<VersionInfo Name="Release">4</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
162,9 → 162,9
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">Ein spannendes Weltraumspiel...</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.1.4.0</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.1.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">SpaceMission 1.1</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Copyright 2001 - 2011 ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Copyright 2001 - 2007 ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks">Keine</VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">SpaceMission.exe</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">SpaceMission 1.1</VersionInfoKeys>
172,8 → 172,7
<VersionInfoKeys Name="Homepage">www.viathinksoft.de</VersionInfoKeys>
<VersionInfoKeys Name="Projektleiter">Daniel Marschall - www.daniel-marschall.de</VersionInfoKeys>
<VersionInfoKeys Name="Webseite">www.viathinksoft.de</VersionInfoKeys>
</VersionInfoKeys>
<Excluded_Packages>
</VersionInfoKeys> <Excluded_Packages>
<Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclib100.bpl">Borland InterBase Express Components</Excluded_Packages>
<Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclIntraweb_80_100.bpl">Intraweb 8.0 Design Package for Borland Development Studio 2006</Excluded_Packages>
<Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclIndyCore100.bpl">Indy 10 Core Design Time</Excluded_Packages>
/LevSpeicherung.pas
52,10 → 52,13
var
SpeicherungForm: TSpeicherungForm;
 
const
FCompVersion = '1.0';
 
implementation
 
uses
Global, LevMain;
LevMain;
 
{$R *.DFM}
 
89,7 → 92,7
end;}
for i := 1 to 9999 do
begin
if fileexists(fdirectory+'Levels\Level '+inttostr(i)+'.lev') then
if fileexists(mainform.fdirectory+'Levels\Level '+inttostr(i)+'.lev') then
LevelListBox.items.Add('Level ' + inttostr(i));
end;
end;
117,7 → 120,7
liw.visible := true;
LadenBtn.enabled := false;
LoeschenBtn.enabled := false;
deletefile(FDirectory+'Levels\'+
deletefile(mainform.FDirectory+'Levels\'+
LevelListBox.Items.strings[LevelListBox.itemindex]+'.lev');
SearchLevels;
end;
155,7 → 158,7
MainForm.DestroyLevel;
MainForm.LevChanged := false;
// Öffnen
AssignFile(SavGame, FDirectory+'Levels\'+
AssignFile(SavGame, mainform.FDirectory+'Levels\'+
LevelListBox.Items.strings[LevelListBox.itemindex]+'.lev');
Reset(SavGame);
// Laden
283,7 → 286,7
exit;
end;
// Öffnen oder erstellen
AssignFile(SavGame, FDirectory+'Levels\Level '+inttostr(SpinEdit.Position)+'.lev');
AssignFile(SavGame, mainform.FDirectory+'Levels\Level '+inttostr(SpinEdit.Position)+'.lev');
Rewrite(SavGame);
// Sortierung
for j := 0 to mainform.enemys.Count - 2 do
340,7 → 343,7
end;
temp := LevelListBox.Items.strings[LevelListBox.itemindex];
SpinEdit.Position := strtoint(RightStr(temp, length(temp)-6));
AssignFile(SavGame, FDirectory+'Levels\'+
AssignFile(SavGame, mainform.FDirectory+'Levels\'+
LevelListBox.Items.strings[LevelListBox.itemindex]+'.lev');
Reset(SavGame);
ReadLN(SavGame, Ergebnis);
/LevInfo.dfm
0,0 → 1,126
object InfoForm: TInfoForm
Left = 289
Top = 184
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Informationen'
ClientHeight = 193
ClientWidth = 321
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object HomeLbl: TLabel
Left = 32
Top = 136
Width = 48
Height = 13
Caption = 'Webseite:'
end
object Image: TImage
Left = 8
Top = 8
Width = 65
Height = 57
Center = True
Stretch = True
end
object FirmaLbl: TLabel
Left = 88
Top = 8
Width = 31
Height = 13
Caption = 'Firma'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object NameLbl: TLabel
Left = 104
Top = 24
Width = 28
Height = 13
Caption = 'Name'
end
object VersionLbl: TLabel
Left = 232
Top = 24
Width = 35
Height = 13
Caption = 'Version'
end
object EMailLbl: TLabel
Left = 32
Top = 120
Width = 32
Height = 13
Caption = 'E-Mail:'
end
object CopyrightLbl: TLabel
Left = 8
Top = 80
Width = 44
Height = 13
Caption = 'Copyright'
end
object Copyright2Lbl: TLabel
Left = 8
Top = 96
Width = 117
Height = 13
Caption = 'Alle Rechte vorbehalten!'
end
object URL2: TLabel
Left = 152
Top = 136
Width = 117
Height = 13
Cursor = crHandPoint
Caption = 'www.daniel-marschall.de'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
Transparent = True
OnClick = URL2Click
end
object URL1: TLabel
Left = 152
Top = 120
Width = 118
Height = 13
Cursor = crHandPoint
Caption = 'info@daniel-marschall.de'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
Transparent = True
OnClick = URL1Click
end
object ElPopupButton1: TButton
Left = 208
Top = 160
Width = 107
Height = 25
Caption = 'OK'
TabOrder = 0
OnClick = ElPopupButton1Click
end
end
/Unit1.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/LevMain.pas
5,7 → 5,7
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem,
Dialogs, StdCtrls, ExtCtrls, Menus, DIB, DXClass, DXSprite, DXDraws,
DXSounds, Spin, ComCtrls;
DXSounds, Spin, ComCtrls, PjVersionInfo;
 
type
TMainForm = class(TDXForm)
78,10 → 78,13
public
{ VCL-Ersatz }
spriteengine: tdxspriteengine;
versioninfo: tpjversioninfo;
dxtimer: tdxtimer;
imagelist: tdximagelist;
dxdraw: tdxdraw;
{ Variablen }
FDirectory: string;
FEngineVersion: string;
FMenuItem: integer;
Enemys: TStrings;
ArtChecked: integer;
108,10 → 111,13
var
MainForm: TMainForm;
 
const
FCompVersion = '1.0';
 
implementation
 
uses
Global, LevSplash, LevSpeicherung, LevText, SplInfo, LevSource, LevOptions;
LevSplash, LevSpeicherung, LevText, LevInfo, LevSource, LevOptions;
 
const
FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';
191,9 → 197,14
var
Ergebnis: string;
daten: textfile;
i: integer;
punkt: integer;
ok: boolean;
begin
{ VCL-Ersatz start }
 
versioninfo := tpjversioninfo.create(self);
 
dxtimer := tdxtimer.create(self);
dxtimer.Interval := 100;
dxtimer.ActiveOnly := false;
236,9 → 247,17
LiveEdit := 1;
// Leeres Level am Anfang braucht keine Beenden-Bestätigung.
// LevChanged := true;
 
//Application.Title := 'SpaceMission '+ProgramVersion+' - Leveleditor';
Caption := 'SpaceMission '+ProgramVersion+' - Leveleditor';
punkt := 0;
FDirectory := extractfilepath(paramstr(0));
versioninfo.filename := paramstr(0);
for i := 1 to length(versioninfo.ProductVersion) do
begin
if copy(versioninfo.ProductVersion, i, 1) = '.' then inc(punkt);
if punkt < 2 then fengineversion :=
fengineversion+copy(versioninfo.ProductVersion, i, 1);
end;
//Application.Title := 'SpaceMission '+FEngineVersion+' - Leveleditor';
Caption := 'SpaceMission '+FEngineVersion+' - Leveleditor';
DXInit;
if (paramcount > 0) and (fileexists(paramstr(1))) then
begin
271,6 → 290,7
begin
Enemys.Free;
//spriteengine.Free;
versioninfo.free;
dxtimer.Free;
imagelist.Free;
dxdraw.free;
444,7 → 464,7
 
procedure TMainForm.MitarbeiterClick(Sender: TObject);
begin
if not fileexists(fdirectory+'Texte\Mitwirkende.txt') then
if not fileexists(mainform.fdirectory+'Texte\Mitwirkende.txt') then
begin
MessageDLG('Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',
mtWarning, [mbOK], 0);
451,7 → 471,7
end
else
begin
TextForm.memo1.lines.loadfromfile(FDirectory+'Texte\Mitwirkende.txt');
TextForm.memo1.lines.loadfromfile(mainform.FDirectory+'Texte\Mitwirkende.txt');
TextForm.showmodal;
end;
end;
/SplText.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplCheat.pas
32,7 → 32,7
 
implementation
 
uses SplMain, Global;
uses SplMain, SplInfo;
 
{$R *.DFM}
 
125,7 → 125,7
 
procedure TCheatForm.Label3Click(Sender: TObject);
begin
shellexecute(handle, 'open', pchar('mailto:daniel-marschall@viathinksoft.de?subject=Cheats für SpaceMission '+ProgramVersion), '', '', 1);
shellexecute(handle, 'open', pchar('mailto:daniel.marschall@surfeu.de?subject=Cheats für SpaceMission '+MainForm.FEngineVersion), '', '', 1);
end;
 
end.
/SpaceMission.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/LevSpeicherung.dfm
9,7 → 9,7
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
16,7 → 16,7
Position = poMainFormCenter
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 106
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 8
/LevSource.pas
26,10 → 26,13
var
SourceForm: TSourceForm;
 
const
FCompVersion = '1.0';
 
implementation
 
uses
Global, LevMain, LevSpeicherung;
LevMain, LevSpeicherung;
 
{$R *.DFM}
 
81,13 → 84,13
 
procedure TSourceForm.Label1Click(Sender: TObject);
begin
if not fileexists(Fdirectory+'Dokumentation.pdf') then
if not fileexists(mainform.fdirectory+'Dokumentation.pdf') then
begin
MessageDLG('Die Datei "Dokumentation.pdf" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',
mtWarning, [mbOK], 0);
end
else
shellexecute(handle, 'open', pchar(fdirectory+'Dokumentation.pdf'), '', '', 1);
shellexecute(handle, 'open', pchar(mainform.fdirectory+'Dokumentation.pdf'), '', '', 1);
end;
 
end.
/Texte/Mitwirkende.txt
9,4 → 9,4
 
Entwickelt mit Borland Turbo Delphi.
 
Verwendete Komponenten: DelphiX 2000.
Verwendete Komponenten: DelphiX 2000, PJSoft VersionInfo.
/LevEdit.cfg
31,8 → 31,8
-M
-$M16384,1048576
-K$00400000
-LE"C:\Users\Daniel Marschall\Documents\Borland Studio-Projekte\Bpl"
-LN"C:\Users\Daniel Marschall\Documents\Borland Studio-Projekte\Bpl"
-LE"D:\Eigene Dateien\Borland Studio-Projekte\Bpl"
-LN"D:\Eigene Dateien\Borland Studio-Projekte\Bpl"
-U"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-O"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
-I"VCL_DELPHIX_D6;VCL_PJVERSIONINFO"
/VCL_DELPHIX_D6/DXConsts.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXDraws.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXPlayFm.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DAnim.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXETable.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXTexImg.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX_for6.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXGUIDEdit.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXInput.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXPictEdit.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXPlay.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXWaveEdit.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXSounds.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXReg.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXRender.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXInptEdit.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DShow.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DIB.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXFFBEdit.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXClass.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DXSprite.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DirectX.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/Wave.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/SplInfo.pas
8,7 → 8,7
 
type
TInfoForm = class(TForm)
OkBtn: TButton;
ElPopupButton1: TButton;
HomeLbl: TLabel;
Image: TImage;
FirmaLbl: TLabel;
19,8 → 19,10
Copyright2Lbl: TLabel;
URL2: TLabel;
URL1: TLabel;
procedure OkBtnClick(Sender: TObject);
procedure ElPopupButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure URL2Click(Sender: TObject);
procedure URL1Click(Sender: TObject);
end;
31,11 → 33,11
implementation
 
uses
Global;
SplMain;
 
{$R *.DFM}
 
procedure TInfoForm.OkBtnClick(Sender: TObject);
procedure TInfoForm.ElPopupButton1Click(Sender: TObject);
begin
close;
end;
42,10 → 44,23
 
procedure TInfoForm.FormCreate(Sender: TObject);
begin
VersionLbl.caption := 'Version ' + ProgramVersion;
image.picture.loadfromfile(FDirectory + 'Bilder\Delphi.bmp');
VersionLbl.caption := 'Version ' + mainform.fengineversion;
CopyrightLbl.caption := mainform.versioninfo.LegalCopyright + '.';
FirmaLbl.caption := mainform.versioninfo.CompanyName;
NameLbl.caption := 'SpaceMission';
image.picture.loadfromfile(mainform.FDirectory + 'Bilder\Delphi.bmp');
end;
 
procedure TInfoForm.FormShow(Sender: TObject);
begin
mainform.dxtimer.enabled := false;
end;
 
procedure TInfoForm.FormHide(Sender: TObject);
begin
if not mainform.gamepause.checked then mainform.dxtimer.enabled := true;
end;
 
procedure TInfoForm.URL2Click(Sender: TObject);
begin
shellexecute(application.Handle, 'open', pchar('http://'+url2.caption+'/'), nil, nil, SW_SHOW);
53,7 → 68,7
 
procedure TInfoForm.URL1Click(Sender: TObject);
begin
shellexecute(application.Handle, 'open', pchar('mailto:'+url1.Caption+'?subject=SpaceMission ' + ProgramVersion), nil, nil, SW_SHOW);
shellexecute(application.Handle, 'open', pchar('mailto:'+url1.Caption+'?subject=SpaceMission ' + mainform.fengineversion), nil, nil, SW_SHOW);
end;
 
end.
/VCL_PJVERSIONINFO/PJVersionInfo.htm
0,0 → 1,282
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
 
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<TITLE>PJSoft Info Sheet: TPJVersionInfo Component (32 bit)</TITLE>
<BASE target="_blank">
</HEAD>
 
<BODY>
<h1>TPJVersionInfo Component (32 bit)</h1>
<p></P>
 
<P>
<HR noshade>
<p></P>
 
<H2>Contents</H2>
 
<UL>
<LI><A HREF="#Description" target="_self">Description</A>
<LI><A HREF="#Compatibility" target="_self">Compatibility</A>
<LI><A HREF="#Installation" target="_self">Installation</A>
<LI><A HREF="#Issues" target="_self">Known Issues</A>
<LI><A HREF="#Update" target="_self">Update History</A>
<LI><A HREF="#License" target="_self">License and Disclaimer</A>
<LI><A HREF="#Author" target="_self">About the Author</A>
</UL>
 
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Description"></A>Description</H2>
 
<P>This is a 32 bit non-visual component for Delphi 2 to 6 that encapsulates file
version resource information contained in a file.</P>
 
<P>The component reads information from the file's VERSIONINFO resource. If the
file has no such resource then this component returns no information. The HaveInfo
property informs whether the component has been able to get version information
from the file. The 32 bit version of TPJVersionInfo can access variable file
information for each language provided in the resource.</P>
 
<P>The file from which resource information is gleaned is determined by the FileName
property. Setting the file name property to the empty string makes the component
read information from the executable file in which it embedded. Apart from the
usual Name and Tag properties the FileName property is the only design-time
property of the component. With the exception of the property that selects the
language for which variable file information is to be returned, all other properties
are read only. These properties present the information from the VERSIONINFO
resource to the user. See the help file for further information.</P>
<P>The component introduces no new methods and it has no events.</P>
 
<H3>Limitations</H3>
 
<P>This version of the component makes calls to the 32 bit Windows API. It is
not suitable for compilation using the 16 bit Delphi 1 compiler.</P>
 
<H3>Further information</H3>
 
<P>For detailed information about file version information refer to the Win32
SDK.</P>
 
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Compatibility"></A>Compatibility</H2>
 
<P>This version of the component works only with 32 bit versions of Delphi. It
has been tested with Delphi versions 2, 3, 4 and 6. It is assumed to work correctly
with Delphi 5. A separate version of the component is available for 16 bit Delphi
1.</P>
 
<P>The unit name has changed to <code>PJVersionInfo</code> in this release of
the code - this means that programs using earlier versions will need to be modified
(or to have an alias set in Delphi's Project Options) before being recompiled
using the new version.</P>
<P>This component is backward compatible with previous 32 bit releases. In previous
releases the help file was designed for integration with the Delphi 2 IDE but
was not compatible with the OpenHelp system used from Delphi 3 onwards. From
this release the help file has been updated to integrate with the Delphi 3 and
later IDE. It is no longer compatible with the Delphi 2 IDE, although can be
used separately.</P>
 
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Installation"></A>Installation</H2>
 
<P>In these instructions <CODE><STRONG>$(DELPHI)</STRONG></CODE> is to be taken to represent the path where your 32 bit version of Delphi was installed. For example, if you have Delphi 4 installed on the path <CODE>C:\Program&nbsp;Files\Borland\Delphi4</CODE> then <CODE>$(DELPHI)</CODE> represents that path.</P>
 
<H3>Installation with Delphi 2</H3>
 
<p>Note that although the provided help file gives information about using the
component it cannot be linked into the Delphi 2 environment.</p>
<OL>
<LI>Unzip the component's <code>.zip</code> file into a folder, preserving the
directory structure.
<li>Copy the files <CODE>PJVersionInfo.pas</CODE> and <CODE>PJVersionInfo.dcr</CODE>
to the folder from where you wish to install the component into the Delphi
Component Palette. This will probably be an existing folder where you keep
the library components - say the default <CODE>$(DELPHI)\lib</CODE> folder.
</li>
<li>Start Delphi. Select the <EM>Options | Install Components</EM> menu option.
Click the <EM>Add</EM> button, then the <EM>Browse</EM> button and navigate
to the <CODE>PJVersionInfo.pas</CODE> file in the folder where you placed
it. Click <EM>OK</EM> to recompile the components library. </li>
<LI>You can now delete <code>PJVersionInfo.pas</code> from the place where you
copied it if you wish. The component will appear on a palette called <EM>PJ
Stuff</EM>. You can move the component to a different palette as required,
or hack the source code (before installing the component) by finding the <CODE>Register</CODE>
procedure at the end of the code and changing the string <CODE>'PJ stuff'</CODE>
to the name of the required palette.
</OL>
 
<H3>Installation with Delphi 3 and later</H3>
 
<OL>
<LI>Unzip the component's <code>.zip</code> file into a folder, preserving the
directory structure.
<li>Copy the files <CODE>PJVersionInfo.pas</CODE> and <CODE>PJVersionInfo.dcr</CODE>
to the folder from where you wish to install the component into the Delphi
Component Palette. This will probably be a sub-folder of the <CODE>$(DELPHI)\lib</CODE>
folder. </li>
<LI>Install the component into the palette by choosing the <EM>Component | Install
Component</EM> menu option. The following instructions assume you are installing
into the default "users components" package:
<UL>
<LI>Select the "Into existing package" page of the <EM>Install Components</EM>
dialogue box.
<LI>Browse to the folder where you saved <CODE>PJVersionInfo.pas</CODE>
and select the file.
<LI>Ensure that the "Package file name" edit box contains <CODE>$(DELPHI)\lib\dclusrX0.dpk</CODE>
(where X is the version number of Delphi).
<LI>Accept that the package will be rebuilt.
<LI>A dialogue box should be displayed saying that <em>TPJVersionInfo</em>
has been added to the component palette.
</UL>
<LI>You can now delete <CODE>PJVersionInfo.pas</CODE> from the place where you
copied it if you wish. The component will appear on a palette called <EM>PJ
Stuff</EM>. You can move the component to a different palette as required,
or hack the source code (before installing the program) by finding the <CODE>Register</CODE>
procedure at the end of the code and changing the string <CODE>'PJ stuff'</CODE>
to the name of the required palette.
<li>The simplest way to install the help file is to use the <em>PJSoft Component
Help Installer Expert,</em> available from my website. To install manually,
proceed as follows (replace X is your version of Delphi): </li>
<ul>
<li>Copy <code>PJVersionInfo.hlp</code> to whichever folder you wish to install
it to. </li>
<li>Create a text file named <code>PJVersionInfo.cfg</code> in your Delphi
Help folder. Enter the following two lines:<code><br>
&nbsp;&nbsp;&nbsp;:Index PJSoft Version Info Component=PJVersionInfo.hlp<br>
&nbsp;&nbsp;&nbsp;:Link PJVersionInfo.hlp</code><br>
</li>
<li>Edit the <code>DelphiX.cnt</code> file (where is is your Delphi version)
and add the line:<br>
<code>&nbsp;&nbsp;&nbsp;:Include PJVersionInfo.cfg </code></li>
<li>Using RegEdit open the key <code>HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Help</code>
and add a new string value named <code>PJVersionInfo.hlp</code> whose value
is the path where you copied the help file (probably <code>($DELPHI)\Help</code>).
</li>
</ul>
</OL>
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Issues"></A>Known Issues</H2>
 
<UL>
<LI>None known.
</UL>
 
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Update"></A>Update History</H2>
 
<P><STRONG>Unreleased</STRONG><BR>
<EM>VerInfo v1.0 of 26/04/1998</EM></P>
<UL>
<LI>Original version - 16 bit only.
</UL>
 
<P><STRONG>Unreleased</STRONG><BR>
<EM>VerInfo v2.0 of 06/12/1998</EM></P>
<UL>
<LI>Revised for use with Win32. Not compatible with v1.0 which continued to
be used with 16 bit Delphi (see <CODE>vinfo16.htm</CODE> for continued update
history of v1).
</UL>
 
<P><STRONG>Release 2.0.1 of 08/07/1999</STRONG><BR>
<EM>VerInfo v2.0.1 of 09/04/1999</EM> <BR>
(This release also included Release 1.0 of 16 bit VerInfo v1.0.1 - see <CODE>vinfo16.htm</CODE> for details).</P>
<UL>
<LI>Changed palette where component installs to "PJ Stuff" from "Own".
<LI>Added HTML documentation (shared documentation with Release 1.0.1).
</UL>
 
<P><STRONG>Release 2.1 of 28/11/1999</STRONG><BR><EM>VInfo v2.1 of 28/11/1999</EM>
<BR>(Separated 16 bit and 32 bits versions into separate releases).</P>
<UL>
<LI>Changed unit name from VerInfo to VInfo to allow component to install under Delphi 3 &amp; 4
(VerInfo clashes with an existing unit in these versions).
<LI>Removed superfluous conditional compilation directives.
<LI>Updated HTML documentation to separate 16 bit from 32 bit version, to to include
installation notes for Delphi 3/4 and to include update history.
</UL>
 
<P><strong>Release 3.0 of 17/02/2002</strong><br>
<em>PJVersionInfo v3.0 of 17/02/2002</em>
<ul>
<li>Added ability to access all "translations" stored in a file's version information,
rather than just first one. This has been done so that code using earlier
versions of this component should continue to work unchanged.
<li>Added new property to expose fixed file information record.
<li>Added new "string array" property to give access to string information by
name: this property can access any custom string information if the name is
known.
<li>Added properties to return number of "translations" and to select index
of "translation" to be used.
<li>Added properties to return language and character set codes in addition
to descriptive strings.
<li>All string info, language and character set properties now return values
from the currently selected translation (which defaults to the first translation
maintaining backward compatibilty).
<li>Empty FileName property now accesses name of host application per command
line rather than using Application.ExeName.
<li>CharSet property now returns '' for unknown value rather than 'Unknown'.
<li>Renamed TVersionNumber record to TPJVersionNumber.
<li>Replaced Tvs_FixedFileInfo record with use of Windows unit defined type
TVSFixedFileInfo
<li>Renamed unit to PJVersionInfo.
<li>Changed component palette from PJ Stuff to PJSoft.
</ul>
<p>
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="License"></A>License &amp; Disclaimer</H2>
 
<P>This component is copyright &copy; P.D.Johnson, 1998-2002.</P>
 
<P>The source code and help files can be freely distributed on a not-for-profit basis providing that:</P>
 
<OL>
<LI>the source code is not altered.
<LI>this readme file is distributed with it unchanged
</OL>
 
<P>By not-for-profit I mean that you may recover out of pocket expenses incurred in distributing the code, but should not make a profit from this.</P>
 
<P>If you discover any bugs in this implementation, or if you have any update suggestions, please contact me on <A HREF="mailto:peter.johnson@openlink.org">peter.johnson@openlink.org</A>.</P>
 
<P>Please do modify the code for you own use. I'd like to see any changes you make - I could incorporate them into future versions. Please notify me of changes on at the above e-mail address.</P>
 
<P>This software is provided as is - no warranty is given as to its suitability for any purposes to which you may wish to put it.</P>
 
<P>
<HR noshade>
<p></P>
 
<H2><A NAME="Author"></A>About the Author</H2>
 
<P>I'm Peter Johnson - a hobbyist programmer living in Ceredigion in West Wales,
UK, writing mainly in Delphi. My programs are available for download on my
website: <a href="http://www.pjsoft.contactbox.co.uk/">http://www.pjsoft.contactbox.co.uk/</a>.</P>
 
<P>I can be contacted by e-mail on <A HREF="mailto:peter.johnson@openlink.org">peter.johnson@openlink.org</A>.
 
</BODY>
 
</HTML>
 
 
/VCL_PJVERSIONINFO/PJVersionInfo.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_PJVERSIONINFO/PJVersionInfo.pas
0,0 → 1,582
{ ##
@FILE PJVersionInfo.pas
@COMMENTS Version Information Component (32 bit) source code
(development split from 16 bit version after v1.0).
@PROJECT_NAME Version Information Component
@PROJECT_DESC Component that reads version information from files.
@OTHER_NAMES + Original unit name was VerInfo.pas
+ Changed to VInfo.pas at v2.1
+ Changed to PJVersionInfo.pas at v3.0
@AUTHOR Peter Johnson, LLANARTH, Ceredigion, Wales, UK
@EMAIL peter.johnson@openlink.org
@WEBSITE http://www.pjsoft.contactbox.co.uk/
@COPYRIGHT © 1998-2002, Peter D Johnson.
@LEGAL_NOTICE This component is placed in the public domain. It
may be freely copied and circulated on a not for
profit basis providing that the code is unmodified
and this notice and information about the author and
his copyright remains attached to the source code.
@CREDITS In producing this component some techniques were
used which were learned from FVersion by PJ Veger,
Best, The Netherlands (Feb/96). In particular the
method of accessing language and char-set tables was
taken from PJ Veger's code.
@HISTORY(
@REVISION(
@VERSION 1.0
@DATE 25/04/1998
@COMMENTS Original version - 16 bit only.
)
@REVISION(
@VERSION 2.0
@DATE 06/12/1998
@COMMENTS Revised for use with 32 bit Windows. Not compatible
with v1.
)
@REVISION(
@VERSION 2.0.1
@DATE 09/04/1999
@COMMENTS Changed installation palette from "Own" to "PJ
Stuff".
)
@REVISION(
@VERSION 2.1
@DATE 28/11/1999
@COMMENTS + Changed unit name to VInfo from VerInfo to allow
component to install under Delphi 3 & 4 (VerInfo
clashes with an existing unit in these versions).
+ Removed superfluous conditional compilation
directives.
)
@REVISION(
@VERSION 3.0
@DATE 17/02/2002
@COMMENTS Major update:
+ Added ability to access all "translations" stored
in a file's version information, rather than just
first one. This has been done so that code using
earlier versions of this component should continue
to work unchanged.
+ Added new property to expose fixed file
information record.
+ Added new "string array" property to give access
to string information by name: this property can
access any custom string information if the name
is known.
+ Added properties to return number of
"translations" and to select index of
"translation" to be used.
+ Added properites to return language and character
set codes in addition to descriptive strings.
+ All string info, language and character set
properties now return values from the currently
selected translation (which defaults to the first
translation maintaining backward compatibilty).
+ Empty file name string now accesses name of host
application per command line rather than using
Application.ExeName. This enables this code to
work correctly even if user changes name of
executable file.
+ CharSet property now returns '' for unknown value
rather than 'Unknown'
+ Renamed unit to PJVersionInfo from VInfo.
+ Renamed TVersionNumber record to TPJVersionNumber
+ Replaced Tvs_FixedFileInfo record with use of
Windows unit defined type TVSFixedFileInfo.
+ Changed component palette from PJ Stuff to PJSoft
)
)
}
 
 
unit PJVersionInfo;
 
interface
 
uses
// Delphi
Windows, Classes;
 
type
 
{
TPJVersionNumber:
Record holding version numbers.
}
TPJVersionNumber = record
V1, V2, V3, V4: WORD;
end;
 
{
TPJVersionInfo:
Component that exposes the version information embedded in an executable
file and exposed the detail as properties.
}
TPJVersionInfo = class(TComponent)
private // properties
fFileName: string;
fHaveInfo: Boolean;
fNumTranslations: Integer;
fCurrentTranslation: Integer;
fFixedFileInfo: TVSFixedFileInfo;
procedure SetFileName(AName: string);
function GetProductVersionNumber: TPJVersionNumber;
function GetFileVersionNumber: TPJVersionNumber;
function GetLanguage: string;
function GetCharSet: string;
function GetCharSetCode: WORD;
function GetLanguageCode: WORD;
function GetCurrentTranslation: Integer;
procedure SetCurrentTranslation(const Value: Integer);
function GetStringFileInfo(const Name: string): string;
function GetStringFileInfoByIdx(Index: Integer): string;
private
fPInfoBuffer: PChar;
{Pointer to info buffer}
fPTransBuffer: Pointer;
{Pointer to translation buffer}
procedure GetInfoBuffer(Len: DWORD);
{Creates an info buffer of required size}
procedure GetTransBuffer(Len: UINT);
{Creates a translation table buffer of required size}
function GetTransStr: string;
{Translation info encoded in string: takes into account current
translation}
protected
procedure ClearProperties; virtual;
{Forces properties to return cleared values}
procedure ReadVersionInfo; virtual;
{Reads version info from file}
public
constructor Create(AOwner: TComponent); override;
{Class constructor: sets default values}
destructor Destroy; override;
{Class destructor: frees allocated memory}
{Properties}
property HaveInfo: Boolean
read fHaveInfo;
{Property true if file version info for the file per FileName property has
been successfully read}
property FixedFileInfo: TVSFixedFileInfo
read fFixedFileInfo;
{Exposes the whole fixed file info record: following properties expose
the various fields of it}
property FileVersionNumber: TPJVersionNumber read
GetFileVersionNumber;
{Version number of file, in numeric format, from fixed file info}
property ProductVersionNumber: TPJVersionNumber
read GetProductVersionNumber;
{Version number of product, in numeric format, from fixed file info}
property FileOS: DWORD
read fFixedFileInfo.dwFileOS;
{Code describing operating system to be used by file}
property FileType: DWORD
read fFixedFileInfo.dwFileType;
{Code descibing type of file}
property FileSubType: DWORD
read fFixedFileInfo.dwFileSubType;
{Code describing sub-type of file - only used for certain values of
FileType property}
property FileFlagsMask: DWORD
read fFixedFileInfo.dwFileFlagsMask;
{Code describing which FileFlags are valid}
property FileFlags: DWORD
read fFixedFileInfo.dwFileFlags;
{Flags describing file state}
property Comments: string index 0
read GetStringFileInfoByIdx;
{String file info property giving user defined comments for current
translation}
property CompanyName: string index 1
read GetStringFileInfoByIdx;
{String file info property giving name of company for current translation}
property FileDescription: string index 2
read GetStringFileInfoByIdx;
{String file info property giving description of file for current
translation}
property FileVersion: string index 3
read GetStringFileInfoByIdx;
{String file info property giving version number of file in string format
for current translation}
property InternalName: string index 4
read GetStringFileInfoByIdx;
{String file info property giving internal name of file for current
translation}
property LegalCopyright: string index 5
read GetStringFileInfoByIdx;
{String file info property giving copyright message for current
translation}
property LegalTrademarks: string index 6
read GetStringFileInfoByIdx;
{String file info property giving trademark info for current translation}
property OriginalFileName: string index 7
read GetStringFileInfoByIdx;
{String file info property giving original name of file for current
translation}
property PrivateBuild: string index 8
read GetStringFileInfoByIdx;
{String file info property giving information about a private build of
file for current translation}
property ProductName: string index 9
read GetStringFileInfoByIdx;
{String file info property giving name of product for current translation}
property ProductVersion: string index 10
read GetStringFileInfoByIdx;
{String file info property giving version number of product in string
format for current translation}
property SpecialBuild: string index 11
read GetStringFileInfoByIdx;
{String file info property giving information about a special build of
file for current translation}
property StringFileInfo[const Name: string]: string
read GetStringFileInfo;
{Returns the value for string file info with given name for current
translation. This property can return both standard and custom string
info}
property Language: string
read GetLanguage;
{Name of language in use in current translation}
property CharSet: string
read GetCharSet;
{Name of character set in use in current translation}
property LanguageCode: WORD
read GetLanguageCode;
{Code of laguage in use in current translation}
property CharSetCode: WORD
read GetCharSetCode;
{Character set code in use in current translation}
property NumTranslations: Integer
read fNumTranslations;
{The number of difference translations (ie languages and char sets) in
the version information}
property CurrentTranslation: Integer
read GetCurrentTranslation write SetCurrentTranslation;
{Zero-based index of the current translation: this is 0 when a file is
first accessed. Set to a value in range 0..NumTranslations-1 to access
other translations. All string info, language and char set properties
return information for the current translation}
published
property FileName: string read fFileName write SetFileName;
{Name of file to which version information relates}
end;
 
procedure Register;
{Register this component}
 
implementation
 
uses
// Delphi
SysUtils;
 
{ Component registration routine }
 
procedure Register;
{Register this component}
begin
RegisterComponents('PJSoft', [TPJVersionInfo]);
end;
 
{ TPJVersionInfo }
 
type
{
TTransRec:
Record of language code and char set codes that are returned from version
information.
}
TTransRec = packed record // record to hold translation information
Lang, CharSet: Word;
end;
{
TTransRecs:
Type used to type cast translation data into an array of translation
records.
}
TTransRecs = array[0..1000] of TTransRec;
{
PTransRecs:
Pointer to an array of translation records.
}
PTransRecs = ^TTransRecs;
 
procedure TPJVersionInfo.ClearProperties;
{Forces properties to return cleared values}
begin
// Record that we haven't read ver info: this effectively clears properties
// since each property read access method checks this flag before returning
// result
fHaveInfo := False;
end;
 
constructor TPJVersionInfo.Create(AOwner: TComponent);
{Class constructor: sets default values}
begin
inherited Create(AOwner);
// Default is no file name - refers to executable file for application
FileName := '';
end;
 
destructor TPJVersionInfo.Destroy;
{Class destructor: frees allocated memory}
begin
// Ensure that info buffer is freed if allocated
if fPInfoBuffer <> nil then
StrDispose(fPInfoBuffer);
// Ensure that translation buffer is free if allocated
if fPTransBuffer <> nil then
FreeMem(fPTransBuffer);
inherited Destroy;
end;
 
function TPJVersionInfo.GetCharSet: string;
{Read access method for CharSet property: return string describing character
set if we have some version info and empty string if we haven't}
const
// Map code numbers to char-set names
cCharSets: array[0..11] of record
Code: Word; // char set code
Str: string; // associated name of char set
end = (
( Code: 0; Str: '7-bit ASCII' ),
( Code: 932; Str: 'Windows, Japan (Shift - JIS X-0208)'),
( Code: 949; Str: 'Windows, Korea (Shift - KSC 5601)' ),
( Code: 950; Str: 'Windows, Taiwan (GB5)' ),
( Code: 1200; Str: 'Unicode' ),
( Code: 1250; Str: 'Windows, Latin-2 (Eastern European)'),
( Code: 1251; Str: 'Windows, Cyrillic' ),
( Code: 1252; Str: 'Windows, Multilingual' ),
( Code: 1253; Str: 'Windows, Greek' ),
( Code: 1254; Str: 'Windows, Turkish' ),
( Code: 1255; Str: 'Windows, Hebrew' ),
( Code: 1256; Str: 'Windows, Arabic' )
);
var
I: Integer; // loop control
begin
Result := '';
if fHaveInfo then
begin
// We've have ver info: scan table of codes looking for required entry
for I := Low(cCharSets) to High(cCharSets) do
if GetCharSetCode = cCharSets[I].Code then
begin
// found one - record its name
Result := cCharSets[I].Str;
Exit;
end;
end;
end;
 
function TPJVersionInfo.GetCharSetCode: WORD;
{Read access for CharSetCode property: returns char set code for current
translation or 0 if there is no translation or we have no version info}
begin
if fHaveInfo and (GetCurrentTranslation >= 0) then
Result := PTransRecs(fPTransBuffer)^[GetCurrentTranslation].CharSet
else
Result := 0;
end;
 
function TPJVersionInfo.GetCurrentTranslation: Integer;
{Read access method for CurrentTranslation property: returns index to current
translation if we have version info or -1 if no version info}
begin
if fHaveInfo then
Result := fCurrentTranslation
else
Result := -1;
end;
 
function TPJVersionInfo.GetFileVersionNumber: TPJVersionNumber;
{Read access method for FileVersionNumber property: fill version info
structure and return it - if there's no version info all values will be zero}
begin
Result.V1 := HiWord(fFixedFileInfo.dwFileVersionMS);
Result.V2 := LoWord(fFixedFileInfo.dwFileVersionMS);
Result.V3 := HiWord(fFixedFileInfo.dwFileVersionLS);
Result.V4 := LoWord(fFixedFileInfo.dwFileVersionLS);
end;
 
procedure TPJVersionInfo.GetInfoBuffer(Len: DWORD);
{Creates an info buffer of required size}
begin
// Clear any existing buffer
if fPInfoBuffer <> nil then
StrDispose(fPInfoBuffer);
// Create the new one
fPInfoBuffer := StrAlloc(Len);
end;
 
function TPJVersionInfo.GetLanguage: string;
{Read access method for Language property: return string describing language
if we have some version info and empty string if we haven't}
var
Buf: array[0..255] of char; // stores langauge string from API call
begin
// Assume failure
Result := '';
// Try to get language name from Win API if we have ver info
if fHaveInfo and (VerLanguageName(GetLanguageCode, Buf, 255) > 0) then
Result := Buf;
end;
 
function TPJVersionInfo.GetLanguageCode: WORD;
{Read access for LanguageCode property: returns language code for current
translation or 0 if there is no translation or we have no version info}
begin
if fHaveInfo and (GetCurrentTranslation >= 0) then
Result := PTransRecs(fPTransBuffer)^[GetCurrentTranslation].Lang
else
Result := 0;
end;
 
function TPJVersionInfo.GetProductVersionNumber: TPJVersionNumber;
{Read access method for ProductVersionNumber property: fill version info
structure and return it - if there's no version info all values will be zero}
begin
Result.V1 := HiWord(fFixedFileInfo.dwProductVersionMS);
Result.V2 := LoWord(fFixedFileInfo.dwProductVersionMS);
Result.V3 := HiWord(fFixedFileInfo.dwProductVersionLS);
Result.V4 := LoWord(fFixedFileInfo.dwProductVersionLS);
end;
 
function TPJVersionInfo.GetStringFileInfo(const Name: string): string;
{Read access method for StringFileInfo array property: returns string
associated with given name or empty string if we have no version info}
var
CommandBuf: array[0..255] of char; // buffer to build API call command str
Ptr: Pointer; // pointer to result of API call
Len: UINT; // length of structure returned from API
begin
// Set default failure result to empty string
Result := '';
// Check if we have valid information recorded in info buffer - exit if not
if fHaveInfo then
begin
// Build API call command string for reading string file info:
// this uses info string + language and character set
StrPCopy(CommandBuf, '\StringFileInfo\' + GetTransStr + '\' + Name);
// Call API to get required string and return it if successful
if VerQueryValue(fPInfoBuffer, CommandBuf, Ptr, Len) then
Result := PChar(Ptr);
end;
end;
 
function TPJVersionInfo.GetStringFileInfoByIdx(Index: Integer): string;
{Read access method for all string file info properties: returns appropriate
string for the given property or empty string if we have no version info}
const
cNames: array[0..11] of string =
('Comments', 'CompanyName', 'FileDescription', 'FileVersion',
'InternalName', 'LegalCopyright', 'LegalTrademarks', 'OriginalFileName',
'PrivateBuild', 'ProductName', 'ProductVersion', 'SpecialBuild');
{names of predefined string file info strings}
begin
Result := GetStringFileInfo(cNames[Index]);
end;
 
procedure TPJVersionInfo.GetTransBuffer(Len: UINT);
{Creates a translation table buffer of required size}
begin
// Clear any existing buffer
if fPTransBuffer <> nil then
FreeMem(fPTransBuffer);
// Create the new one
GetMem(fPTransBuffer, Len);
end;
 
function TPJVersionInfo.GetTransStr: string;
{Translation info encoded in string: takes into account current translation}
var
TransRec: TTransRec; // translation record in array of translations
begin
if GetCurrentTranslation >= 0 then
begin
// There is a valid current translation: return hex string related to it
TransRec := PTransRecs(fPTransBuffer)^[GetCurrentTranslation];
Result := Format('%4.4x%4.4x', [TransRec.Lang, TransRec.CharSet]);
end
else
// No valid translation string: return empty string
Result := '';
end;
 
procedure TPJVersionInfo.ReadVersionInfo;
{Reads version info from file}
var
Len: UINT; // length of structs returned from API calls
Ptr: Pointer; // points to version info structures
InfoSize: DWORD; // size of info buffer
Dummy: DWORD; // stores 0 in call to GetFileVersionInfoSize
begin
// Record default value of HaveInfo property - no info read
fHaveInfo := False;
// Store zeros in fixed file info structure: this is used when no info
FillChar(fFixedFileInfo, SizeOf(fFixedFileInfo), 0);
// Set NumTranslations property to 0: this is value if no info
fNumTranslations := 0;
// Record required size of version info buffer
InfoSize := GetFileVersionInfoSize(PChar(fFileName), Dummy);
// Check that there was no error
if InfoSize > 0 then
begin
// Found info size OK
// Ensure we have a sufficiently large buffer allocated
GetInfoBuffer(InfoSize);
// Read file version info into storage and check success
if GetFileVersionInfo(PChar(fFileName), Dummy, InfoSize, fPInfoBuffer) then
begin
// Success: we've read file version info to storage OK
fHaveInfo := True;
// Get fixed file info & copy to own storage
VerQueryValue(fPInfoBuffer, '\', Ptr, Len);
fFixedFileInfo := PVSFixedFileInfo(Ptr)^;
// Get first translation table info from API
VerQueryValue(fPInfoBuffer, '\VarFileInfo\Translation', Ptr, Len);
// Ptr is to block of translation records each of size Len:
// work out number of translations
fNumTranslations := Len div SizeOf(TTransRec);
// store translation array in a buffer
GetTransBuffer(Len);
Move(Ptr^, fPTransBuffer^, Len);
// make first translation in block current one (-1 if no translations)
SetCurrentTranslation(0); // adjusts value to -1 if no translations
end;
end;
end;
 
procedure TPJVersionInfo.SetCurrentTranslation(const Value: Integer);
{Write accees method for CurrentTranslation property: if value is out of
translation range then it is set to -1 to indicate no translation}
begin
if (Value >= 0) and (Value < NumTranslations) then
fCurrentTranslation := Value
else
fCurrentTranslation := -1
end;
 
procedure TPJVersionInfo.SetFileName(AName: string);
{Write access method for FileName property: action at design time is different
to run time. At design time we simply record value while at run time we store
value - using actual name of program for '' string - and read the version
information}
begin
if csDesigning in ComponentState then
// We are designing, simply record the required name
fFileName := AName
else
begin
// It's run-time
// use Application exec file name if name is ''
if AName = '' then
fFileName := ParamStr(0)
else
fFileName := AName;
// clear all properties and read file version info for new file
ClearProperties;
ReadVersionInfo;
end;
end;
 
end.
/LevMain.dfm
23,7 → 23,7
OnDestroy = FormDestroy
OnMouseMove = DXDrawMouseMove
OnShow = FormShow
PixelsPerInch = 106
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 648
/SplCheat.dfm
9,7 → 9,7
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
16,7 → 16,7
Position = poMainFormCenter
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 106
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
30,7 → 30,6
Top = 8
Width = 106
Height = 13
Cursor = crHandPoint
Caption = 'Herausgeber anfragen'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
82,7 → 81,6
Top = 104
Width = 83
Height = 13
Cursor = crHandPoint
Caption = 'Cheat deaktiviren'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
/LevSplash.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/LevOptions.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/LevInfo.dcu
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/LevSource.dfm
9,7 → 9,7
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
16,7 → 16,7
Position = poMainFormCenter
OnHide = FormHide
OnShow = FormShow
PixelsPerInch = 106
PixelsPerInch = 96
TextHeight = 13
object ElLabel1: TLabel
Left = 8
/SplSpeicherung.pas
47,10 → 47,13
var
SpeicherungForm: TSpeicherungForm;
 
const
FCompVersion = '1.0';
 
implementation
 
uses
Global, SplMain;
SplMain;
 
{$R *.DFM}
 
76,7 → 79,7
li4b.caption := 'n/a';
LadenBtn.enabled := false;
LoeschenBtn.enabled := false;
res := FindFirst(fdirectory+'Spielstände\*.sav', 0, sr);
res := FindFirst(mainform.fdirectory+'Spielstände\*.sav', 0, sr);
try
while (res = 0) do
begin
118,7 → 121,7
li4b.caption := 'n/a';
LadenBtn.enabled := false;
LoeschenBtn.enabled := false;
deletefile(FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
deletefile(mainform.FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
searchsaves;
end;
end;
155,7 → 158,7
end;
{if liu.visible or (LevelListBox.items.count=0) then
exit;}
AssignFile(SavGame, FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
AssignFile(SavGame, mainform.FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
Reset(SavGame);
ReadLN(SavGame);
ReadLN(SavGame);
203,7 → 206,7
if MessageDlg('Spielstand ist bereits vorhanden. Ersetzen?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
exit;
end;
AssignFile(SavGame, FDirectory+'Spielstände\'+LevelName.text+'.sav');
AssignFile(SavGame, mainform.FDirectory+'Spielstände\'+LevelName.text+'.sav');
Rewrite(SavGame);
WriteLN(SavGame, '; SpaceMission '+FCompVersion);
WriteLN(SavGame, '; SAV-File');
244,7 → 247,7
exit;
end;
LevelName.Text := LevelListBox.Items.strings[LevelListBox.itemindex];
AssignFile(SavGame, FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
AssignFile(SavGame, mainform.FDirectory+'Spielstände\'+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
Reset(SavGame);
ReadLN(SavGame, Ergebniss);
if Ergebniss <> '; SpaceMission '+FCompVersion then
/_Projektgruppe.bdsgroup.local
0,0 → 1,7
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions/>
<Default.Personality>
<Projects ActiveProject="SpaceMission.exe"/>
</Default.Personality>
</BorlandProject>