WebSVN – spacemission – Diff – /LevMain.pas


unit LevMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem,
  Dialogs, StdCtrls, ExtCtrls, Menus, DIB, DXClass, DXSprite, DXDraws,
  DXSounds, Spin, ComCtrls;
 
type
  TMainForm = class(TDXForm)
    MainMenu: TMainMenu;
    Spiel: TMenuItem;
    Beenden: TMenuItem;
    Hilfe: TMenuItem;
    Mitarbeiter: TMenuItem;
    Leer1: TMenuItem;
    Level: TMenuItem;
    Informationen: TMenuItem;
    Leer2: TMenuItem;
    Enemy1: TRadioButton;
    Enemy2: TRadioButton;
    Enemy3: TRadioButton;
    Enemy4: TRadioButton;
    Enemy5: TRadioButton;
    Enemy6: TRadioButton;
    Enemy7: TRadioButton;
    ScrollBar: TScrollBar;
    Bevel1: TBevel;
    Bevel2: TBevel;
    SelLabel: TLabel;
    SelPanel: TPanel;
    Bevel3: TBevel;
    SLabel1a: TLabel;
    SLabel2a: TLabel;
    SLabel1b: TLabel;
    SLabel2b: TLabel;
    SLabel0: TLabel;
    Neu: TMenuItem;
    Image1: TImage;
    SLabel3a: TLabel;
    SLabel3b: TLabel;
    SLabel4a: TLabel;
    SLabel4b: TLabel;
    LivesLabel: TLabel;
    Quelltext1: TMenuItem;
    StatusBar: TStatusBar;
    N1: TMenuItem;
    Spielfelderweitern1: TMenuItem;
    LivesEdt: TEdit;
    Lives: TUpDown;
    procedure DXDrawFinalize(Sender: TObject);
    procedure DXDrawInitialize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure BeendenClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MitarbeiterClick(Sender: TObject);
    procedure LevelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure InformationenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EnemyClick(Sender: TObject);
    procedure EnemyAdd(x, y, art, lives: integer);
    procedure NeuClick(Sender: TObject);
    procedure DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Quelltext1Click(Sender: TObject);
    procedure Spielfelderweitern1Click(Sender: TObject);
    procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure LivesClick(Sender: TObject; Button: TUDBtnType);
    procedure LivesEdtKeyPress(Sender: TObject; var Key: Char);
    procedure LivesEdtChange(Sender: TObject);
  public
    { VCL-Ersatz }
    spriteengine: tdxspriteengine;
 
    dxtimer: tdxtimer;
    imagelist: tdximagelist;
    dxdraw: tdxdraw;
    { Variablen }
 
 
    FMenuItem: integer;
    Enemys: TStrings;
    ArtChecked: integer;
    LiveEdit: integer;
    ScrollP: integer;
    AltScrollPos: integer;
    Boss: boolean;
    LevChanged: boolean;
    NumEnemys: integer;
    { Level-Routinen }
    procedure EnemyCreate(x, y: integer);
    procedure DestroyLevel;
    procedure AnzeigeAct;
    { Initialisiations-Routinen }
    procedure DXInit;
    procedure ProgramInit;
    { Farb-Routinen }
    function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
    procedure PalleteAnim(Col: TRGBQuad; Time: Integer);
    { Sonstiges }
    procedure LivesChange(newval: integer);
  end;
 
var
  MainForm: TMainForm;
 
 
 
 
implementation
 
uses
  Global, LevSplash, LevSpeicherung, LevText, SplInfo, LevSource, LevOptions;
 
const
  FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';
  status_info = ' Zeigen Sie mit dem Mauszeiger auf eine Einheit, um deren Eigenschaften anzuzeigen...';
  status_lives = ' Leben: ';
  status_nolives = ' Einheit hat keine Lebensangabe';
  RasterW = 48;
  RasterH = 32;
 
{$R *.DFM}
 
{$R WindowsXP.res}
 
type
  TBackground = class(TBackgroundSprite)
  protected
    procedure DoMove(MoveCount: Integer); override;
  end;
 
  TEnemy = class(TImageSprite)
  private
    Lives: integer;
    Art: integer;
    XCor: integer;
    CorInit: boolean;
  protected
    procedure DoMove(MoveCount: Integer); override;
  public
    constructor Create(AParent: TSprite); override;
  end;
 
procedure TMainForm.DXInit;
begin
  Imagelist.Items.LoadFromFile(FDirectory+'DirectX\Graphic.dxg');
  ImageList.Items.MakeColorTable;
  DXDraw.ColorTable := ImageList.Items.ColorTable;
  DXDraw.DefColorTable := ImageList.Items.ColorTable;
  DXDraw.UpdatePalette;
  DXDraw.Initialize;
end;
 
procedure TEnemy.DoMove(MoveCount: Integer);
begin
  if not CorInit then
  begin
    XCor := trunc(x) + (MainForm.ScrollP * RasterW);
    CorInit := true;
  end;
  if MainForm.Enemys.IndexOf(floattostr(XCor)+'-'+floattostr(y)+':'+
    inttostr(Art)+'('+inttostr(Lives)+')') = -1 then dead;
  X := XCor - (MainForm.ScrollP * RasterW);
end;
 
procedure TBackground.DoMove(MoveCount: Integer);
begin
  X := -(MainForm.ScrollP * RasterW);
end;
 
constructor TEnemy.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  if MainForm.ArtChecked = 1 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker');
  if MainForm.ArtChecked = 2 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker2');
  if MainForm.ArtChecked = 3 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker3');
  if MainForm.ArtChecked = 4 then Image := MainForm.ImageList.Items.Find('Enemy-Meteor');
  if MainForm.ArtChecked = 5 then Image := MainForm.ImageList.Items.Find('Enemy-Disk');
  if MainForm.ArtChecked = 6 then Image := MainForm.ImageList.Items.Find('Enemy-Disk2');
  if MainForm.ArtChecked = 7 then Image := MainForm.ImageList.Items.Find('Enemy-Boss');
  if MainForm.ArtChecked = 4 then Lives := 0 else Lives := MainForm.LiveEdit;
  Art := MainForm.ArtChecked;
  Width := Image.Width;
  Height := Image.Height;
  PixelCheck := True;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
var
  Ergebnis: string;
  daten: textfile;
 
 
  ok: boolean;
begin
  { VCL-Ersatz start }
 
 
 
  dxtimer := tdxtimer.create(self);
  dxtimer.Interval := 100;
  dxtimer.ActiveOnly := false;
  dxtimer.Enabled := false;
  dxtimer.OnTimer := DxTimerTimer;
 
  dxdraw := tdxdraw.Create(self);
  dxdraw.Parent := self;
  dxdraw.Left := 0;
  dxdraw.Top := 0;
  dxdraw.Width := 640;
  dxdraw.Height := 480;
  dxdraw.AutoInitialize := False;
  dxdraw.AutoSize := False;
  dxdraw.Color := clBlack;
  dxdraw.Display.BitCount := 24;
  dxdraw.Display.FixedBitCount := False;
  dxdraw.Display.FixedRatio := False;
  dxdraw.Display.FixedSize := False;
  dxdraw.Display.Height := 600;
  dxdraw.Display.Width := 800;
  dxdraw.Options := [doAllowReboot, doWaitVBlank, doAllowPalette256, doCenter, doRetainedMode, doHardware, doSelectDriver];
  dxdraw.OnFinalize := DXDrawFinalize;
  dxdraw.OnInitialize := DXDrawInitialize;
  dxdraw.ParentShowHint := False;
  dxdraw.ShowHint := False;
  dxdraw.TabOrder := 0;
  dxdraw.OnMouseDown := DXDrawMouseDown;
  dxdraw.OnMouseMove := DXDrawMouseMove;
 
  spriteengine := tdxspriteengine.create(self);
  spriteengine.DXDraw := dxdraw;
 
  imagelist := tdximagelist.create(self);
  imagelist.DXDraw := dxdraw;
 
  { VCL-Ersatz ende }
 
  ArtChecked := 1;
  LiveEdit := 1;
  // Leeres Level am Anfang braucht keine Beenden-Bestätigung.
  // LevChanged := true;
 
 
 
 
 
 
 
 
 
  //Application.Title := 'SpaceMission '+ProgramVersion+' - Leveleditor';
  Caption := 'SpaceMission '+ProgramVersion+' - Leveleditor';
  DXInit;
  if (paramcount > 0) and (fileexists(paramstr(1))) then
  begin
    AssignFile(daten, paramstr(1));
    Reset(daten);
    ok := true;
    ReadLN(daten, Ergebnis);
    if Ergebnis <> '; SpaceMission '+FCompVersion then ok := false;
    ReadLN(daten, Ergebnis);
    if ergebnis <> '; LEV-File' then ok := false;
    if not ok then
    begin
      showmessage(FileError);
      CloseFile(daten);
      ProgramInit;
      exit;
    end;
    { Laden }
    CloseFile(daten);
    exit;
  end;
  if fileexists(fdirectory+'Bilder\Auswahl.bmp') then
    Image1.Picture.LoadFromFile(fdirectory+'Bilder\Auswahl.bmp');
  {else
    SelPanel.visible := false;}
  ProgramInit;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Enemys.Free;
  //spriteengine.Free;
 
  dxtimer.Free;
  imagelist.Free;
  dxdraw.free;
end;
 
procedure TMainForm.BeendenClick(Sender: TObject);
begin
  close;
end;
 
procedure TMainForm.DXDrawInitialize(Sender: TObject);
begin
  DXTimer.Enabled := True;
end;
 
procedure TMainForm.DXDrawFinalize(Sender: TObject);
begin
  DXTimer.Enabled := False;
end;
 
procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
begin
  if not DXDraw.CanDraw then exit;
  LagCount := 1000 div 60;
  SpriteEngine.Move(LagCount);
  SpriteEngine.Dead;
  DxDraw.Surface.Fill(0);
  SpriteEngine.Draw;
  DXDraw.Flip;
end;
 
function TMainForm.ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
begin
  with Result do
  begin
    rgbRed := Src.rgbRed+((Dest.rgbRed-Src.rgbRed)*Percent div 256);
    rgbGreen := Src.rgbGreen+((Dest.rgbGreen-Src.rgbGreen)*Percent div 256);
    rgbBlue := Src.rgbBlue+((Dest.rgbBlue-Src.rgbBlue)*Percent div 256);
    rgbReserved := 0;
  end;
end;
 
procedure TMainForm.PalleteAnim(Col: TRGBQuad; Time: Integer);
var
  i: Integer;
  t, t2: DWORD;
  ChangePalette: Boolean;
  c: Integer;
begin
  if DXDraw.Initialized then
  begin
    c := DXDraw.Surface.ColorMatch(RGB(Col.rgbRed, Col.rgbGreen, Col.rgbBlue));
    ChangePalette := False;
    if DXDraw.CanPaletteAnimation then
    begin
      t := GetTickCount;
      while Abs(GetTickCount-t)<Time do
      begin
        t2 := Trunc(Abs(GetTickCount-t)/Time*255);
        for i := 0 to 255 do
          DXDraw.ColorTable[i] := ComposeColor(Col, DXDraw.DefColorTable[i], t2);
        DXDraw.UpdatePalette;
        ChangePalette := True;
      end;
    end else
      Sleep(Time);
    for i := 0 to 4 do
    begin
      DXDraw.Surface.Fill(c);
      DXDraw.Flip;
    end;
    if ChangePalette then
    begin
      DXDraw.ColorTable := DXDraw.DefColorTable;
      DXDraw.UpdatePalette;
    end;
    DXDraw.Surface.Fill(c);
    DXDraw.Flip;
  end;
end;
 
procedure TMainForm.ProgramInit;
{var
  i, j: Integer;}
begin
  Enemys := TStringList.create;
  sleep(500);
  //PlayerSprite
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(1, 1);
    Image := mainform.ImageList.Items.Find('Star3');
    Z := -13;
    Y := 40;
    Tile := True;
  end;
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(1, 1);
    Image := mainform.ImageList.Items.Find('Star2');
    Z := -12;
    Y := 30;
    Tile := True;
  end;
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(1, 1);
    Image := mainform.ImageList.Items.Find('Star1');
    Z := -11;
    Y := 10;
    Tile := True;
  end;
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(1, 1);
    Image := mainform.ImageList.Items.Find('Matrix');
    Z := -10;
    Tile := True;
  end;
  {with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(200, 10);
    Y := 10;
    Z := -13;
    FSpeed := 1 / 2;
    Tile := True;
    for i := 0 to MapHeight-1 do
    begin
      for j := 0 to MapWidth-1 do
      begin
        Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 8);
        if Random(100)<95 then Chips[j, i] := -1;
      end;
    end;
  end;
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(200, 10);
    Y := 30;
    Z := -12;
    FSpeed := 1;
    Tile := True;
    for i := 0 to MapHeight-1 do
    begin
      for j := 0 to MapWidth-1 do
      begin
        Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 4);
        if Random(100)<95 then Chips[j, i] := -1;
      end;
    end;
  end;
  with TBackground.Create(SpriteEngine.Engine) do
  begin
    SetMapSize(200, 10);
    Y := 40;
    Z := -11;
    FSpeed := 2;
    Tile := True;
    for i := 0 to MapHeight-1 do
    begin
      for j := 0 to MapWidth-1 do
      begin
        Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 2);
        if Random(100)<95 then Chips[j, i] := -1;
      end;
    end;
  end;}
  PalleteAnim(RGBQuad(0, 0, 0), 300);
  mainform.Visible := true;
end;
 
procedure TMainForm.MitarbeiterClick(Sender: TObject);
begin
  if not fileexists(fdirectory+'Texte\Mitwirkende.txt') then
  begin
    MessageDLG('Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',
      mtWarning, [mbOK], 0);
  end
  else
  begin
    TextForm.memo1.lines.loadfromfile(FDirectory+'Texte\Mitwirkende.txt');
    TextForm.showmodal;
  end;
end;
 
procedure TMainForm.LevelClick(Sender: TObject);
begin
  speicherungform.showmodal;
end;
 
procedure TMainForm.FormShow(Sender: TObject);
begin
  SplashForm.Hide;
  SplashForm.Free;
 
  dxtimer.Enabled := true;
  dxtimer.ActiveOnly := true;
end;
 
procedure TMainForm.InformationenClick(Sender: TObject);
begin
  InfoForm.showmodal;
end;
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SpriteEngine.Engine.Clear;
  DXTimer.Enabled := False;
end;
 
procedure TMainForm.DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i, j, k, l, ex, ey: integer;
  ok, breaked: boolean;
begin
  ex := trunc(x/RasterW) * RasterW;
  ey := trunc(y/RasterH) * RasterH;
  EnemyCreate(ex, ey);
  breaked := false;
  { Setzen }
  if Button = mbLeft then
  begin
    ok := true;
    if (ArtChecked = 7) and boss then ok := false
    else
    begin
      for i := 1 to 7 do
      begin
        for j := 0 to 999 do
        begin
          if boss then
          begin
            for k := 0 to 3 do
            begin
              for l := 0 to 1 do
              begin
                if Enemys.IndexOf(floattostr(ex + ((ScrollP - k) * RasterW))+'-'+floattostr(ey - (RasterH * l))+':7('+inttostr(j)+')') <> -1 then
                begin
                  ok := false;
                  break;
                end;
              end;
              if not ok then break;
            end;
            if not ok then break;
          end;
          if Enemys.IndexOf(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+':'+
            inttostr(i)+'('+inttostr(j)+')') <> -1 then
          begin
            ok := false;
            break;
          end;
        end;
        if not ok then break;
      end;
    end;
    if ok then
    begin
      if ArtChecked <> 4 then
        Enemys.Add(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+':'+
          inttostr(ArtChecked)+'('+inttostr(LiveEdit)+')')
      else
        Enemys.Add(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+':'+
          inttostr(ArtChecked)+'(0)');
      inc(NumEnemys);
      if ArtChecked = 7 then boss := true;
    end
    else beep;
  end
  { Löschen }
  else if Button = mbRight then
  begin
    for i := 1 to 7 do
    begin
      for j := 0 to 999 do
      begin
        if boss and (i = 7) then
        begin
          for k := 0 to 3 do
          begin
            for l := 0 to 1 do
            begin
              if Enemys.IndexOf(floattostr(ex + ((ScrollP - k) * RasterW))+'-'+floattostr(ey - (RasterH * l))+':'+inttostr(i)+'('+inttostr(j)+')') <> -1 then
              begin
                Enemys.Delete(Enemys.IndexOf(floattostr(ex + ((ScrollP - k) * RasterW))+'-'+floattostr(ey - (RasterH * l))+':'+inttostr(i)+'('+inttostr(j)+')'));
                Boss := false;
                dec(NumEnemys);
                breaked := true;
                break;
              end;
            end;
            if breaked then break;
          end;
        end;
        if Enemys.IndexOf(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+':'+
          inttostr(i)+'('+inttostr(j)+')') <> -1 then
        begin
          Enemys.Delete(Enemys.IndexOf(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+
            ':'+inttostr(i)+'('+inttostr(j)+')'));
          if i = 7 then Boss := false;
          dec(NumEnemys);
          breaked := true;
          break;
        end;
      end;
      if breaked then break;
    end;
  end;
  LevChanged := true;
  AnzeigeAct;
end;
 
procedure TMainForm.EnemyClick(Sender: TObject);
begin
  if sender = Enemy1 then ArtChecked := 1;
  if sender = Enemy2 then ArtChecked := 2;
  if sender = Enemy3 then ArtChecked := 3;
  if sender = Enemy4 then ArtChecked := 4;
  if sender = Enemy5 then ArtChecked := 5;
  if sender = Enemy6 then ArtChecked := 6;
  if sender = Enemy7 then ArtChecked := 7;
  Image1.Left := -(87 * (ArtChecked - 1)) + 1;
  Lives.Enabled := sender <> Enemy4;
  LivesLabel.Enabled := sender <> Enemy4;
  if sender = Enemy4 then LivesEdt.Font.Color := clBtnShadow // andere farbe?
    else LivesEdt.Font.Color := clWindowText;
end;
 
procedure TMainForm.EnemyCreate(x, y: integer);
var
  Enemy: TSprite;
begin
  Enemy := TEnemy.Create(SpriteEngine.Engine);
  Enemy.x := x;
  Enemy.y := y;
end;
 
procedure TMainForm.DestroyLevel;
begin
  ScrollBar.Position := 0;
  Enemys.Clear;
  NumEnemys := 0;
  Boss := false;
  LevChanged := true;
  Lives.Position := 1;
  LivesChange(Lives.Position);
  Enemy1.Checked := true;
  EnemyClick(Enemy1);
  AnzeigeAct;
end;
 
procedure TMainForm.AnzeigeAct;
begin
  SLabel1b.Caption := inttostr(NumEnemys);
  if Boss then SLabel2b.Caption := 'Ja' else SLabel2b.Caption := 'Nein';
  SLabel3b.Caption := inttostr(ScrollBar.Max);
  if LevChanged then
  begin
    SLabel4a.Font.Color := $00000096;
    SLabel4b.Font.Color := $00000096;
    SLabel4b.Caption := 'Nein';
  end
  else
  begin
    SLabel4a.Font.Color := $00009600;
    SLabel4b.Font.Color := $00009600;
    SLabel4b.Caption := 'Ja';
  end;
end;
 
procedure TMainForm.EnemyAdd(x, y, art, lives: integer);
begin
  Enemys.Add(inttostr(x)+'-'+inttostr(y)+':'+inttostr(art)+'('+inttostr(lives)+')');
end;
 
procedure TMainForm.NeuClick(Sender: TObject);
begin
  if MessageDlg('Level wirklich löschen?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    DestroyLevel;
end;
 
procedure TMainForm.DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  ex, ey, i, j, k, l, wert: integer;
  breaked: boolean;
begin
  if sender <> DxDraw then
  begin
    StatusBar.SimpleText := status_info;
    exit;
  end;
  ex := trunc(x/RasterW) * RasterW;
  ey := trunc(y/RasterH) * RasterH;
  wert := -1;
  breaked := false;
  for i := 1 to 7 do
  begin
    for j := 0 to 999 do
    begin
      if boss and (i = 7) then
      begin
        for k := 0 to 3 do
        begin
          for l := 0 to 1 do
          begin
            if Enemys.IndexOf(floattostr(ex + ((ScrollP - k) * RasterW))+'-'+floattostr(ey - (RasterH * l))+':'+inttostr(i)+'('+inttostr(j)+')') <> -1 then
            begin
              wert := j;
              breaked := true;
              break;
            end;
          end;
          if breaked then break;
        end;
      end;
      if (breaked = false) and (Enemys.IndexOf(floattostr(ex + (ScrollP * RasterW))+'-'+floattostr(ey)+':'+
        inttostr(i)+'('+inttostr(j)+')') <> -1) then
      begin
        wert := j;
        breaked := true;
        break;
      end;
    end;
    if breaked then break;
  end;
  if wert <> -1 then
  begin
    if wert > 0 then
      StatusBar.SimpleText := status_lives + inttostr(wert)
    else
      StatusBar.SimpleText := status_nolives;
  end
  else
    StatusBar.SimpleText := status_info;
end;
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if LevChanged then
    CanClose := MessageDlg('Beenden ohne abspeichern?', mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;
 
procedure TMainForm.Quelltext1Click(Sender: TObject);
begin
  SourceForm.Aktualisieren;
  SourceForm.showmodal;
end;
 
procedure TMainForm.Spielfelderweitern1Click(Sender: TObject);
begin
  LevelForm.Aktualisieren;
  LevelForm.showmodal;
end;
 
procedure TMainForm.ScrollBarScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  ScrollP := ScrollPos;
end;
 
procedure TMainForm.LivesChange(newval: integer);
begin
  LiveEdit := newval;
  livesedt.Text := inttostr(LiveEdit);
  lives.Position := newval;
end;
 
procedure TMainForm.LivesClick(Sender: TObject; Button: TUDBtnType);
begin
  LivesChange(lives.Position);
end;
 
procedure TMainForm.LivesEdtKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#13, #08, '0'..'9']) then
    Key := #0;
end;
 
procedure TMainForm.LivesEdtChange(Sender: TObject);
begin
  LivesChange(strtoint(livesedt.text));
end;
 
end.
 
 

Rev 1	Rev 2
1	unit LevMain;	1	unit LevMain;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem,	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem,
7	Dialogs, StdCtrls, ExtCtrls, Menus, DIB, DXClass, DXSprite, DXDraws,	7	Dialogs, StdCtrls, ExtCtrls, Menus, DIB, DXClass, DXSprite, DXDraws,
8	DXSounds, Spin, ComCtrls, PjVersionInfo;	8	DXSounds, Spin, ComCtrls;
9		9
10	type	10	type
11	TMainForm = class(TDXForm)	11	TMainForm = class(TDXForm)
12	MainMenu: TMainMenu;	12	MainMenu: TMainMenu;
13	Spiel: TMenuItem;	13	Spiel: TMenuItem;
14	Beenden: TMenuItem;	14	Beenden: TMenuItem;
15	Hilfe: TMenuItem;	15	Hilfe: TMenuItem;
16	Mitarbeiter: TMenuItem;	16	Mitarbeiter: TMenuItem;
17	Leer1: TMenuItem;	17	Leer1: TMenuItem;
18	Level: TMenuItem;	18	Level: TMenuItem;
19	Informationen: TMenuItem;	19	Informationen: TMenuItem;
20	Leer2: TMenuItem;	20	Leer2: TMenuItem;
21	Enemy1: TRadioButton;	21	Enemy1: TRadioButton;
22	Enemy2: TRadioButton;	22	Enemy2: TRadioButton;
23	Enemy3: TRadioButton;	23	Enemy3: TRadioButton;
24	Enemy4: TRadioButton;	24	Enemy4: TRadioButton;
25	Enemy5: TRadioButton;	25	Enemy5: TRadioButton;
26	Enemy6: TRadioButton;	26	Enemy6: TRadioButton;
27	Enemy7: TRadioButton;	27	Enemy7: TRadioButton;
28	ScrollBar: TScrollBar;	28	ScrollBar: TScrollBar;
29	Bevel1: TBevel;	29	Bevel1: TBevel;
30	Bevel2: TBevel;	30	Bevel2: TBevel;
31	SelLabel: TLabel;	31	SelLabel: TLabel;
32	SelPanel: TPanel;	32	SelPanel: TPanel;
33	Bevel3: TBevel;	33	Bevel3: TBevel;
34	SLabel1a: TLabel;	34	SLabel1a: TLabel;
35	SLabel2a: TLabel;	35	SLabel2a: TLabel;
36	SLabel1b: TLabel;	36	SLabel1b: TLabel;
37	SLabel2b: TLabel;	37	SLabel2b: TLabel;
38	SLabel0: TLabel;	38	SLabel0: TLabel;
39	Neu: TMenuItem;	39	Neu: TMenuItem;
40	Image1: TImage;	40	Image1: TImage;
41	SLabel3a: TLabel;	41	SLabel3a: TLabel;
42	SLabel3b: TLabel;	42	SLabel3b: TLabel;
43	SLabel4a: TLabel;	43	SLabel4a: TLabel;
44	SLabel4b: TLabel;	44	SLabel4b: TLabel;
45	LivesLabel: TLabel;	45	LivesLabel: TLabel;
46	Quelltext1: TMenuItem;	46	Quelltext1: TMenuItem;
47	StatusBar: TStatusBar;	47	StatusBar: TStatusBar;
48	N1: TMenuItem;	48	N1: TMenuItem;
49	Spielfelderweitern1: TMenuItem;	49	Spielfelderweitern1: TMenuItem;
50	LivesEdt: TEdit;	50	LivesEdt: TEdit;
51	Lives: TUpDown;	51	Lives: TUpDown;
52	procedure DXDrawFinalize(Sender: TObject);	52	procedure DXDrawFinalize(Sender: TObject);
53	procedure DXDrawInitialize(Sender: TObject);	53	procedure DXDrawInitialize(Sender: TObject);
54	procedure FormCreate(Sender: TObject);	54	procedure FormCreate(Sender: TObject);
55	procedure DXTimerTimer(Sender: TObject; LagCount: Integer);	55	procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
56	procedure BeendenClick(Sender: TObject);	56	procedure BeendenClick(Sender: TObject);
57	procedure FormDestroy(Sender: TObject);	57	procedure FormDestroy(Sender: TObject);
58	procedure MitarbeiterClick(Sender: TObject);	58	procedure MitarbeiterClick(Sender: TObject);
59	procedure LevelClick(Sender: TObject);	59	procedure LevelClick(Sender: TObject);
60	procedure FormShow(Sender: TObject);	60	procedure FormShow(Sender: TObject);
61	procedure InformationenClick(Sender: TObject);	61	procedure InformationenClick(Sender: TObject);
62	procedure FormClose(Sender: TObject; var Action: TCloseAction);	62	procedure FormClose(Sender: TObject; var Action: TCloseAction);
63	procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;	63	procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
64	Shift: TShiftState; X, Y: Integer);	64	Shift: TShiftState; X, Y: Integer);
65	procedure EnemyClick(Sender: TObject);	65	procedure EnemyClick(Sender: TObject);
66	procedure EnemyAdd(x, y, art, lives: integer);	66	procedure EnemyAdd(x, y, art, lives: integer);
67	procedure NeuClick(Sender: TObject);	67	procedure NeuClick(Sender: TObject);
68	procedure DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,	68	procedure DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
69	Y: Integer);	69	Y: Integer);
70	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	70	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
71	procedure Quelltext1Click(Sender: TObject);	71	procedure Quelltext1Click(Sender: TObject);
72	procedure Spielfelderweitern1Click(Sender: TObject);	72	procedure Spielfelderweitern1Click(Sender: TObject);
73	procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;	73	procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
74	var ScrollPos: Integer);	74	var ScrollPos: Integer);
75	procedure LivesClick(Sender: TObject; Button: TUDBtnType);	75	procedure LivesClick(Sender: TObject; Button: TUDBtnType);
76	procedure LivesEdtKeyPress(Sender: TObject; var Key: Char);	76	procedure LivesEdtKeyPress(Sender: TObject; var Key: Char);
77	procedure LivesEdtChange(Sender: TObject);	77	procedure LivesEdtChange(Sender: TObject);
78	public	78	public
79	{ VCL-Ersatz }	79	{ VCL-Ersatz }
80	spriteengine: tdxspriteengine;	80	spriteengine: tdxspriteengine;
81	versioninfo: tpjversioninfo;	-
82	dxtimer: tdxtimer;	81	dxtimer: tdxtimer;
83	imagelist: tdximagelist;	82	imagelist: tdximagelist;
84	dxdraw: tdxdraw;	83	dxdraw: tdxdraw;
85	{ Variablen }	84	{ Variablen }
86	FDirectory: string;	-
87	FEngineVersion: string;	-
88	FMenuItem: integer;	85	FMenuItem: integer;
89	Enemys: TStrings;	86	Enemys: TStrings;
90	ArtChecked: integer;	87	ArtChecked: integer;
91	LiveEdit: integer;	88	LiveEdit: integer;
92	ScrollP: integer;	89	ScrollP: integer;
93	AltScrollPos: integer;	90	AltScrollPos: integer;
94	Boss: boolean;	91	Boss: boolean;
95	LevChanged: boolean;	92	LevChanged: boolean;
96	NumEnemys: integer;	93	NumEnemys: integer;
97	{ Level-Routinen }	94	{ Level-Routinen }
98	procedure EnemyCreate(x, y: integer);	95	procedure EnemyCreate(x, y: integer);
99	procedure DestroyLevel;	96	procedure DestroyLevel;
100	procedure AnzeigeAct;	97	procedure AnzeigeAct;
101	{ Initialisiations-Routinen }	98	{ Initialisiations-Routinen }
102	procedure DXInit;	99	procedure DXInit;
103	procedure ProgramInit;	100	procedure ProgramInit;
104	{ Farb-Routinen }	101	{ Farb-Routinen }
105	function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;	102	function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
106	procedure PalleteAnim(Col: TRGBQuad; Time: Integer);	103	procedure PalleteAnim(Col: TRGBQuad; Time: Integer);
107	{ Sonstiges }	104	{ Sonstiges }
108	procedure LivesChange(newval: integer);	105	procedure LivesChange(newval: integer);
109	end;	106	end;
110		107
111	var	108	var
112	MainForm: TMainForm;	109	MainForm: TMainForm;
113		110
114	const	-
115	FCompVersion = '1.0';	-
116		-
117	implementation	111	implementation
118		112
119	uses	113	uses
120	LevSplash, LevSpeicherung, LevText, LevInfo, LevSource, LevOptions;	114	Global, LevSplash, LevSpeicherung, LevText, SplInfo, LevSource, LevOptions;
121		115
122	const	116	const
123	FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';	117	FileError = 'Die Datei kann von SpaceMission nicht geöffnet werden!';
124	status_info = ' Zeigen Sie mit dem Mauszeiger auf eine Einheit, um deren Eigenschaften anzuzeigen...';	118	status_info = ' Zeigen Sie mit dem Mauszeiger auf eine Einheit, um deren Eigenschaften anzuzeigen...';
125	status_lives = ' Leben: ';	119	status_lives = ' Leben: ';
126	status_nolives = ' Einheit hat keine Lebensangabe';	120	status_nolives = ' Einheit hat keine Lebensangabe';
127	RasterW = 48;	121	RasterW = 48;
128	RasterH = 32;	122	RasterH = 32;
129		123
130	{$R *.DFM}	124	{$R *.DFM}
131		125
132	{$R WindowsXP.res}	126	{$R WindowsXP.res}
133		127
134	type	128	type
135	TBackground = class(TBackgroundSprite)	129	TBackground = class(TBackgroundSprite)
136	protected	130	protected
137	procedure DoMove(MoveCount: Integer); override;	131	procedure DoMove(MoveCount: Integer); override;
138	end;	132	end;
139		133
140	TEnemy = class(TImageSprite)	134	TEnemy = class(TImageSprite)
141	private	135	private
142	Lives: integer;	136	Lives: integer;
143	Art: integer;	137	Art: integer;
144	XCor: integer;	138	XCor: integer;
145	CorInit: boolean;	139	CorInit: boolean;
146	protected	140	protected
147	procedure DoMove(MoveCount: Integer); override;	141	procedure DoMove(MoveCount: Integer); override;
148	public	142	public
149	constructor Create(AParent: TSprite); override;	143	constructor Create(AParent: TSprite); override;
150	end;	144	end;
151		145
152	procedure TMainForm.DXInit;	146	procedure TMainForm.DXInit;
153	begin	147	begin
154	Imagelist.Items.LoadFromFile(FDirectory+'DirectX\Graphic.dxg');	148	Imagelist.Items.LoadFromFile(FDirectory+'DirectX\Graphic.dxg');
155	ImageList.Items.MakeColorTable;	149	ImageList.Items.MakeColorTable;
156	DXDraw.ColorTable := ImageList.Items.ColorTable;	150	DXDraw.ColorTable := ImageList.Items.ColorTable;
157	DXDraw.DefColorTable := ImageList.Items.ColorTable;	151	DXDraw.DefColorTable := ImageList.Items.ColorTable;
158	DXDraw.UpdatePalette;	152	DXDraw.UpdatePalette;
159	DXDraw.Initialize;	153	DXDraw.Initialize;
160	end;	154	end;
161		155
162	procedure TEnemy.DoMove(MoveCount: Integer);	156	procedure TEnemy.DoMove(MoveCount: Integer);
163	begin	157	begin
164	if not CorInit then	158	if not CorInit then
165	begin	159	begin
166	XCor := trunc(x) + (MainForm.ScrollP * RasterW);	160	XCor := trunc(x) + (MainForm.ScrollP * RasterW);
167	CorInit := true;	161	CorInit := true;
168	end;	162	end;
169	if MainForm.Enemys.IndexOf(floattostr(XCor)+'-'+floattostr(y)+':'+	163	if MainForm.Enemys.IndexOf(floattostr(XCor)+'-'+floattostr(y)+':'+
170	inttostr(Art)+'('+inttostr(Lives)+')') = -1 then dead;	164	inttostr(Art)+'('+inttostr(Lives)+')') = -1 then dead;
171	X := XCor - (MainForm.ScrollP * RasterW);	165	X := XCor - (MainForm.ScrollP * RasterW);
172	end;	166	end;
173		167
174	procedure TBackground.DoMove(MoveCount: Integer);	168	procedure TBackground.DoMove(MoveCount: Integer);
175	begin	169	begin
176	X := -(MainForm.ScrollP * RasterW);	170	X := -(MainForm.ScrollP * RasterW);
177	end;	171	end;
178		172
179	constructor TEnemy.Create(AParent: TSprite);	173	constructor TEnemy.Create(AParent: TSprite);
180	begin	174	begin
181	inherited Create(AParent);	175	inherited Create(AParent);
182	if MainForm.ArtChecked = 1 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker');	176	if MainForm.ArtChecked = 1 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker');
183	if MainForm.ArtChecked = 2 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker2');	177	if MainForm.ArtChecked = 2 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker2');
184	if MainForm.ArtChecked = 3 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker3');	178	if MainForm.ArtChecked = 3 then Image := MainForm.ImageList.Items.Find('Enemy-Attacker3');
185	if MainForm.ArtChecked = 4 then Image := MainForm.ImageList.Items.Find('Enemy-Meteor');	179	if MainForm.ArtChecked = 4 then Image := MainForm.ImageList.Items.Find('Enemy-Meteor');
186	if MainForm.ArtChecked = 5 then Image := MainForm.ImageList.Items.Find('Enemy-Disk');	180	if MainForm.ArtChecked = 5 then Image := MainForm.ImageList.Items.Find('Enemy-Disk');
187	if MainForm.ArtChecked = 6 then Image := MainForm.ImageList.Items.Find('Enemy-Disk2');	181	if MainForm.ArtChecked = 6 then Image := MainForm.ImageList.Items.Find('Enemy-Disk2');
188	if MainForm.ArtChecked = 7 then Image := MainForm.ImageList.Items.Find('Enemy-Boss');	182	if MainForm.ArtChecked = 7 then Image := MainForm.ImageList.Items.Find('Enemy-Boss');
189	if MainForm.ArtChecked = 4 then Lives := 0 else Lives := MainForm.LiveEdit;	183	if MainForm.ArtChecked = 4 then Lives := 0 else Lives := MainForm.LiveEdit;
190	Art := MainForm.ArtChecked;	184	Art := MainForm.ArtChecked;
191	Width := Image.Width;	185	Width := Image.Width;
192	Height := Image.Height;	186	Height := Image.Height;
193	PixelCheck := True;	187	PixelCheck := True;
194	end;	188	end;
195		189
196	procedure TMainForm.FormCreate(Sender: TObject);	190	procedure TMainForm.FormCreate(Sender: TObject);
197	var	191	var
198	Ergebnis: string;	192	Ergebnis: string;
199	daten: textfile;	193	daten: textfile;
200	i: integer;	-
201	punkt: integer;	-
202	ok: boolean;	194	ok: boolean;
203	begin	195	begin
204	{ VCL-Ersatz start }	196	{ VCL-Ersatz start }
205		-
206	versioninfo := tpjversioninfo.create(self);	-
207		-
208	dxtimer := tdxtimer.create(self);	197	dxtimer := tdxtimer.create(self);
209	dxtimer.Interval := 100;	198	dxtimer.Interval := 100;
210	dxtimer.ActiveOnly := false;	199	dxtimer.ActiveOnly := false;
211	dxtimer.Enabled := false;	200	dxtimer.Enabled := false;
212	dxtimer.OnTimer := DxTimerTimer;	201	dxtimer.OnTimer := DxTimerTimer;
213		202
214	dxdraw := tdxdraw.Create(self);	203	dxdraw := tdxdraw.Create(self);
215	dxdraw.Parent := self;	204	dxdraw.Parent := self;
216	dxdraw.Left := 0;	205	dxdraw.Left := 0;
217	dxdraw.Top := 0;	206	dxdraw.Top := 0;
218	dxdraw.Width := 640;	207	dxdraw.Width := 640;
219	dxdraw.Height := 480;	208	dxdraw.Height := 480;
220	dxdraw.AutoInitialize := False;	209	dxdraw.AutoInitialize := False;
221	dxdraw.AutoSize := False;	210	dxdraw.AutoSize := False;
222	dxdraw.Color := clBlack;	211	dxdraw.Color := clBlack;
223	dxdraw.Display.BitCount := 24;	212	dxdraw.Display.BitCount := 24;
224	dxdraw.Display.FixedBitCount := False;	213	dxdraw.Display.FixedBitCount := False;
225	dxdraw.Display.FixedRatio := False;	214	dxdraw.Display.FixedRatio := False;
226	dxdraw.Display.FixedSize := False;	215	dxdraw.Display.FixedSize := False;
227	dxdraw.Display.Height := 600;	216	dxdraw.Display.Height := 600;
228	dxdraw.Display.Width := 800;	217	dxdraw.Display.Width := 800;
229	dxdraw.Options := [doAllowReboot, doWaitVBlank, doAllowPalette256, doCenter, doRetainedMode, doHardware, doSelectDriver];	218	dxdraw.Options := [doAllowReboot, doWaitVBlank, doAllowPalette256, doCenter, doRetainedMode, doHardware, doSelectDriver];
230	dxdraw.OnFinalize := DXDrawFinalize;	219	dxdraw.OnFinalize := DXDrawFinalize;
231	dxdraw.OnInitialize := DXDrawInitialize;	220	dxdraw.OnInitialize := DXDrawInitialize;
232	dxdraw.ParentShowHint := False;	221	dxdraw.ParentShowHint := False;
233	dxdraw.ShowHint := False;	222	dxdraw.ShowHint := False;
234	dxdraw.TabOrder := 0;	223	dxdraw.TabOrder := 0;
235	dxdraw.OnMouseDown := DXDrawMouseDown;	224	dxdraw.OnMouseDown := DXDrawMouseDown;
236	dxdraw.OnMouseMove := DXDrawMouseMove;	225	dxdraw.OnMouseMove := DXDrawMouseMove;
237		226
238	spriteengine := tdxspriteengine.create(self);	227	spriteengine := tdxspriteengine.create(self);
239	spriteengine.DXDraw := dxdraw;	228	spriteengine.DXDraw := dxdraw;
240		229
241	imagelist := tdximagelist.create(self);	230	imagelist := tdximagelist.create(self);
242	imagelist.DXDraw := dxdraw;	231	imagelist.DXDraw := dxdraw;
243		232
244	{ VCL-Ersatz ende }	233	{ VCL-Ersatz ende }
245		234
246	ArtChecked := 1;	235	ArtChecked := 1;
247	LiveEdit := 1;	236	LiveEdit := 1;
248	// Leeres Level am Anfang braucht keine Beenden-Bestätigung.	237	// Leeres Level am Anfang braucht keine Beenden-Bestätigung.
249	// LevChanged := true;	238	// LevChanged := true;
250	punkt := 0;	-
251	FDirectory := extractfilepath(paramstr(0));	-
252	versioninfo.filename := paramstr(0);	-
253	for i := 1 to length(versioninfo.ProductVersion) do	-
254	begin	-
255	if copy(versioninfo.ProductVersion, i, 1) = '.' then inc(punkt);	-
256	if punkt < 2 then fengineversion :=	-
257	fengineversion+copy(versioninfo.ProductVersion, i, 1);	-
258	end;	239
259	//Application.Title := 'SpaceMission '+FEngineVersion+' - Leveleditor';	240	//Application.Title := 'SpaceMission '+ProgramVersion+' - Leveleditor';
260	Caption := 'SpaceMission '+FEngineVersion+' - Leveleditor';	241	Caption := 'SpaceMission '+ProgramVersion+' - Leveleditor';
261	DXInit;	242	DXInit;
262	if (paramcount > 0) and (fileexists(paramstr(1))) then	243	if (paramcount > 0) and (fileexists(paramstr(1))) then
263	begin	244	begin
264	AssignFile(daten, paramstr(1));	245	AssignFile(daten, paramstr(1));
265	Reset(daten);	246	Reset(daten);
266	ok := true;	247	ok := true;
267	ReadLN(daten, Ergebnis);	248	ReadLN(daten, Ergebnis);
268	if Ergebnis <> '; SpaceMission '+FCompVersion then ok := false;	249	if Ergebnis <> '; SpaceMission '+FCompVersion then ok := false;
269	ReadLN(daten, Ergebnis);	250	ReadLN(daten, Ergebnis);
270	if ergebnis <> '; LEV-File' then ok := false;	251	if ergebnis <> '; LEV-File' then ok := false;
271	if not ok then	252	if not ok then
272	begin	253	begin
273	showmessage(FileError);	254	showmessage(FileError);
274	CloseFile(daten);	255	CloseFile(daten);
275	ProgramInit;	256	ProgramInit;
276	exit;	257	exit;
277	end;	258	end;
278	{ Laden }	259	{ Laden }
279	CloseFile(daten);	260	CloseFile(daten);
280	exit;	261	exit;
281	end;	262	end;
282	if fileexists(fdirectory+'Bilder\Auswahl.bmp') then	263	if fileexists(fdirectory+'Bilder\Auswahl.bmp') then
283	Image1.Picture.LoadFromFile(fdirectory+'Bilder\Auswahl.bmp');	264	Image1.Picture.LoadFromFile(fdirectory+'Bilder\Auswahl.bmp');
284	{else	265	{else
285	SelPanel.visible := false;}	266	SelPanel.visible := false;}
286	ProgramInit;	267	ProgramInit;
287	end;	268	end;
288		269
289	procedure TMainForm.FormDestroy(Sender: TObject);	270	procedure TMainForm.FormDestroy(Sender: TObject);
290	begin	271	begin
291	Enemys.Free;	272	Enemys.Free;
292	//spriteengine.Free;	273	//spriteengine.Free;
293	versioninfo.free;	-
294	dxtimer.Free;	274	dxtimer.Free;
295	imagelist.Free;	275	imagelist.Free;
296	dxdraw.free;	276	dxdraw.free;
297	end;	277	end;
298		278
299	procedure TMainForm.BeendenClick(Sender: TObject);	279	procedure TMainForm.BeendenClick(Sender: TObject);
300	begin	280	begin
301	close;	281	close;
302	end;	282	end;
303		283
304	procedure TMainForm.DXDrawInitialize(Sender: TObject);	284	procedure TMainForm.DXDrawInitialize(Sender: TObject);
305	begin	285	begin
306	DXTimer.Enabled := True;	286	DXTimer.Enabled := True;
307	end;	287	end;
308		288
309	procedure TMainForm.DXDrawFinalize(Sender: TObject);	289	procedure TMainForm.DXDrawFinalize(Sender: TObject);
310	begin	290	begin
311	DXTimer.Enabled := False;	291	DXTimer.Enabled := False;
312	end;	292	end;
313		293
314	procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);	294	procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
315	begin	295	begin
316	if not DXDraw.CanDraw then exit;	296	if not DXDraw.CanDraw then exit;
317	LagCount := 1000 div 60;	297	LagCount := 1000 div 60;
318	SpriteEngine.Move(LagCount);	298	SpriteEngine.Move(LagCount);
319	SpriteEngine.Dead;	299	SpriteEngine.Dead;
320	DxDraw.Surface.Fill(0);	300	DxDraw.Surface.Fill(0);
321	SpriteEngine.Draw;	301	SpriteEngine.Draw;
322	DXDraw.Flip;	302	DXDraw.Flip;
323	end;	303	end;
324		304
325	function TMainForm.ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;	305	function TMainForm.ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
326	begin	306	begin
327	with Result do	307	with Result do
328	begin	308	begin
329	rgbRed := Src.rgbRed+((Dest.rgbRed-Src.rgbRed)*Percent div 256);	309	rgbRed := Src.rgbRed+((Dest.rgbRed-Src.rgbRed)*Percent div 256);
330	rgbGreen := Src.rgbGreen+((Dest.rgbGreen-Src.rgbGreen)*Percent div 256);	310	rgbGreen := Src.rgbGreen+((Dest.rgbGreen-Src.rgbGreen)*Percent div 256);
331	rgbBlue := Src.rgbBlue+((Dest.rgbBlue-Src.rgbBlue)*Percent div 256);	311	rgbBlue := Src.rgbBlue+((Dest.rgbBlue-Src.rgbBlue)*Percent div 256);
332	rgbReserved := 0;	312	rgbReserved := 0;
333	end;	313	end;
334	end;	314	end;
335		315
336	procedure TMainForm.PalleteAnim(Col: TRGBQuad; Time: Integer);	316	procedure TMainForm.PalleteAnim(Col: TRGBQuad; Time: Integer);
337	var	317	var
338	i: Integer;	318	i: Integer;
339	t, t2: DWORD;	319	t, t2: DWORD;
340	ChangePalette: Boolean;	320	ChangePalette: Boolean;
341	c: Integer;	321	c: Integer;
342	begin	322	begin
343	if DXDraw.Initialized then	323	if DXDraw.Initialized then
344	begin	324	begin
345	c := DXDraw.Surface.ColorMatch(RGB(Col.rgbRed, Col.rgbGreen, Col.rgbBlue));	325	c := DXDraw.Surface.ColorMatch(RGB(Col.rgbRed, Col.rgbGreen, Col.rgbBlue));
346	ChangePalette := False;	326	ChangePalette := False;
347	if DXDraw.CanPaletteAnimation then	327	if DXDraw.CanPaletteAnimation then
348	begin	328	begin
349	t := GetTickCount;	329	t := GetTickCount;
350	while Abs(GetTickCount-t)<Time do	330	while Abs(GetTickCount-t)<Time do
351	begin	331	begin
352	t2 := Trunc(Abs(GetTickCount-t)/Time*255);	332	t2 := Trunc(Abs(GetTickCount-t)/Time*255);
353	for i := 0 to 255 do	333	for i := 0 to 255 do
354	DXDraw.ColorTable[i] := ComposeColor(Col, DXDraw.DefColorTable[i], t2);	334	DXDraw.ColorTable[i] := ComposeColor(Col, DXDraw.DefColorTable[i], t2);
355	DXDraw.UpdatePalette;	335	DXDraw.UpdatePalette;
356	ChangePalette := True;	336	ChangePalette := True;
357	end;	337	end;
358	end else	338	end else
359	Sleep(Time);	339	Sleep(Time);
360	for i := 0 to 4 do	340	for i := 0 to 4 do
361	begin	341	begin
362	DXDraw.Surface.Fill(c);	342	DXDraw.Surface.Fill(c);
363	DXDraw.Flip;	343	DXDraw.Flip;
364	end;	344	end;
365	if ChangePalette then	345	if ChangePalette then
366	begin	346	begin
367	DXDraw.ColorTable := DXDraw.DefColorTable;	347	DXDraw.ColorTable := DXDraw.DefColorTable;
368	DXDraw.UpdatePalette;	348	DXDraw.UpdatePalette;
369	end;	349	end;
370	DXDraw.Surface.Fill(c);	350	DXDraw.Surface.Fill(c);
371	DXDraw.Flip;	351	DXDraw.Flip;
372	end;	352	end;
373	end;	353	end;
374		354
375	procedure TMainForm.ProgramInit;	355	procedure TMainForm.ProgramInit;
376	{var	356	{var
377	i, j: Integer;}	357	i, j: Integer;}
378	begin	358	begin
379	Enemys := TStringList.create;	359	Enemys := TStringList.create;
380	sleep(500);	360	sleep(500);
381	//PlayerSprite	361	//PlayerSprite
382	with TBackground.Create(SpriteEngine.Engine) do	362	with TBackground.Create(SpriteEngine.Engine) do
383	begin	363	begin
384	SetMapSize(1, 1);	364	SetMapSize(1, 1);
385	Image := mainform.ImageList.Items.Find('Star3');	365	Image := mainform.ImageList.Items.Find('Star3');
386	Z := -13;	366	Z := -13;
387	Y := 40;	367	Y := 40;
388	Tile := True;	368	Tile := True;
389	end;	369	end;
390	with TBackground.Create(SpriteEngine.Engine) do	370	with TBackground.Create(SpriteEngine.Engine) do
391	begin	371	begin
392	SetMapSize(1, 1);	372	SetMapSize(1, 1);
393	Image := mainform.ImageList.Items.Find('Star2');	373	Image := mainform.ImageList.Items.Find('Star2');
394	Z := -12;	374	Z := -12;
395	Y := 30;	375	Y := 30;
396	Tile := True;	376	Tile := True;
397	end;	377	end;
398	with TBackground.Create(SpriteEngine.Engine) do	378	with TBackground.Create(SpriteEngine.Engine) do
399	begin	379	begin
400	SetMapSize(1, 1);	380	SetMapSize(1, 1);
401	Image := mainform.ImageList.Items.Find('Star1');	381	Image := mainform.ImageList.Items.Find('Star1');
402	Z := -11;	382	Z := -11;
403	Y := 10;	383	Y := 10;
404	Tile := True;	384	Tile := True;
405	end;	385	end;
406	with TBackground.Create(SpriteEngine.Engine) do	386	with TBackground.Create(SpriteEngine.Engine) do
407	begin	387	begin
408	SetMapSize(1, 1);	388	SetMapSize(1, 1);
409	Image := mainform.ImageList.Items.Find('Matrix');	389	Image := mainform.ImageList.Items.Find('Matrix');
410	Z := -10;	390	Z := -10;
411	Tile := True;	391	Tile := True;
412	end;	392	end;
413	{with TBackground.Create(SpriteEngine.Engine) do	393	{with TBackground.Create(SpriteEngine.Engine) do
414	begin	394	begin
415	SetMapSize(200, 10);	395	SetMapSize(200, 10);
416	Y := 10;	396	Y := 10;
417	Z := -13;	397	Z := -13;
418	FSpeed := 1 / 2;	398	FSpeed := 1 / 2;
419	Tile := True;	399	Tile := True;
420	for i := 0 to MapHeight-1 do	400	for i := 0 to MapHeight-1 do
421	begin	401	begin
422	for j := 0 to MapWidth-1 do	402	for j := 0 to MapWidth-1 do
423	begin	403	begin
424	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 8);	404	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 8);
425	if Random(100)<95 then Chips[j, i] := -1;	405	if Random(100)<95 then Chips[j, i] := -1;
426	end;	406	end;
427	end;	407	end;
428	end;	408	end;
429	with TBackground.Create(SpriteEngine.Engine) do	409	with TBackground.Create(SpriteEngine.Engine) do
430	begin	410	begin
431	SetMapSize(200, 10);	411	SetMapSize(200, 10);
432	Y := 30;	412	Y := 30;
433	Z := -12;	413	Z := -12;
434	FSpeed := 1;	414	FSpeed := 1;
435	Tile := True;	415	Tile := True;
436	for i := 0 to MapHeight-1 do	416	for i := 0 to MapHeight-1 do
437	begin	417	begin
438	for j := 0 to MapWidth-1 do	418	for j := 0 to MapWidth-1 do
439	begin	419	begin
440	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 4);	420	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 4);
441	if Random(100)<95 then Chips[j, i] := -1;	421	if Random(100)<95 then Chips[j, i] := -1;
442	end;	422	end;
443	end;	423	end;
444	end;	424	end;
445	with TBackground.Create(SpriteEngine.Engine) do	425	with TBackground.Create(SpriteEngine.Engine) do
446	begin	426	begin
447	SetMapSize(200, 10);	427	SetMapSize(200, 10);
448	Y := 40;	428	Y := 40;
449	Z := -11;	429	Z := -11;
450	FSpeed := 2;	430	FSpeed := 2;
451	Tile := True;	431	Tile := True;
452	for i := 0 to MapHeight-1 do	432	for i := 0 to MapHeight-1 do
453	begin	433	begin
454	for j := 0 to MapWidth-1 do	434	for j := 0 to MapWidth-1 do
455	begin	435	begin
456	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 2);	436	Chips[j, i] := Image.PatternCount-Random(Image.PatternCount div 2);
457	if Random(100)<95 then Chips[j, i] := -1;	437	if Random(100)<95 then Chips[j, i] := -1;
458	end;	438	end;
459	end;	439	end;
460	end;}	440	end;}
461	PalleteAnim(RGBQuad(0, 0, 0), 300);	441	PalleteAnim(RGBQuad(0, 0, 0), 300);
462	mainform.Visible := true;	442	mainform.Visible := true;
463	end;	443	end;
464		444
465	procedure TMainForm.MitarbeiterClick(Sender: TObject);	445	procedure TMainForm.MitarbeiterClick(Sender: TObject);
466	begin	446	begin
467	if not fileexists(mainform.fdirectory+'Texte\Mitwirkende.txt') then	447	if not fileexists(fdirectory+'Texte\Mitwirkende.txt') then
468	begin	448	begin
469	MessageDLG('Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',	449	MessageDLG('Die Datei "Texte\Mitwirkende.txt" ist nicht mehr vorhanden. Die Aktion wird abgebrochen!',
470	mtWarning, [mbOK], 0);	450	mtWarning, [mbOK], 0);
471	end	451	end
472	else	452	else
473	begin	453	begin
474	TextForm.memo1.lines.loadfromfile(mainform.FDirectory+'Texte\Mitwirkende.txt');	454	TextForm.memo1.lines.loadfromfile(FDirectory+'Texte\Mitwirkende.txt');
475	TextForm.showmodal;	455	TextForm.showmodal;
476	end;	456	end;
477	end;	457	end;
478		458
479	procedure TMainForm.LevelClick(Sender: TObject);	459	procedure TMainForm.LevelClick(Sender: TObject);
480	begin	460	begin
481	speicherungform.showmodal;	461	speicherungform.showmodal;
482	end;	462	end;
483		463
484	procedure TMainForm.FormShow(Sender: TObject);	464	procedure TMainForm.FormShow(Sender: TObject);
485	begin	465	begin
486	SplashForm.Hide;	466	SplashForm.Hide;
487	SplashForm.Free;	467	SplashForm.Free;
488		468
489	dxtimer.Enabled := true;	469	dxtimer.Enabled := true;
490	dxtimer.ActiveOnly := true;	470	dxtimer.ActiveOnly := true;
491	end;	471	end;
492		472
493	procedure TMainForm.InformationenClick(Sender: TObject);	473	procedure TMainForm.InformationenClick(Sender: TObject);
494	begin	474	begin
495	InfoForm.showmodal;	475	InfoForm.showmodal;
496	end;	476	end;
497		477
498	procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);	478	procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
499	begin	479	begin
500	SpriteEngine.Engine.Clear;	480	SpriteEngine.Engine.Clear;

Subversion Repositories spacemission

spacemission/LevMain.pas – Rev 1 → 2