direct.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit Direct;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

const
WM_GO = WM_USER;
WM_CHANGECLIENT = WM_USER+1; // hand over control to other client
WM_NEXTPLAYER = WM_USER+2; // active player's turn ended, next player

type
  TDirectDlg = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
    procedure DlgNotify(ID: integer);
  private
    Info: string;
    State: integer;
    Gone, Quick: boolean;
    procedure SetInfo(x: string);
    procedure SetState(x: integer);
    procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
    procedure OnGo(var m:TMessage); message WM_GO;
    procedure OnChangeClient(var m:TMessage); message WM_CHANGECLIENT;
    procedure OnNextPlayer(var m:TMessage); message WM_NEXTPLAYER;
  end;

var
  DirectDlg: TDirectDlg;

implementation

uses
ScreenTools, Protocol, OuterCore, Start, Back, Messg;

{$R *.DFM}

procedure Notify(ID: integer);
begin
DirectDlg.DlgNotify(ID);
end;

procedure TDirectDlg.DlgNotify(ID: integer);
var
s: string;
begin
case ID of
  ntInitLocalHuman:
    begin
    State:=-1;
    Info:=Phrases.Lookup('BUSY_MODLH');
    Show; Update;
    end;
  ntInitModule..ntInitModule+maxBrain-1:
    if visible then
      begin
      s:=Format(Phrases.Lookup('BUSY_MOD'),[Brain[ID-ntInitModule].Name]);
      while Canvas.TextWidth(s)+64>ClientWidth do Delete(s,Length(s),1);
      SetInfo(s);
      end;
  ntCreateWorld:
    if visible then SetInfo(Phrases.Lookup('BUSY_START'));
  ntInitPlayers:
    if visible then SetInfo(Phrases.Lookup('BUSY_INIT'));
  ntDeactivationMissing..ntDeactivationMissing+nPl-1:
    SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),[ID-ntDeactivationMissing]),
      'INVALID');
  ntLoadBegin:
    begin Info:=Phrases.Lookup('BUSY_LOAD'); SetState(0); end;
  ntLoadState..ntLoadState+128:
    SetState(ID-ntLoadState);
  ntDLLError..ntDLLError+128:
    SimpleMessage(Format(Phrases.Lookup('DLLERROR'),[Brain[ID-ntDLLError].FileName]),
      'INVALID');
  ntAIError:
    SimpleMessage(Format(Phrases.Lookup('AIERROR'),[MissingBrain]),'INVALID');
  ntClientError..ntClientError+128:
    SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),[Brain[ID-ntClientError].FileName]),
      'INVALID');
  ntEndInfo:
    begin Hide; background.update end;
  ntLoadError:
    SimpleMessage(Phrases.Lookup('LOADERROR'),'INVALID');
  ntStartDone:
    if not Quick then
      begin StartDlg.Hide; background.Update end;
  ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
    if Quick then Close
    else
      begin
      if ID=ntStartGoRefresh then
        StartDlg.UpdateFormerGames
      else if ID=ntStartGoRefreshMaps then
        StartDlg.UpdateMaps;
      StartDlg.Show;
      end;
  ntChangeClient:
    PostMessage(Handle,WM_CHANGECLIENT,0,0);
  ntNextPlayer:
    PostMessage(Handle,WM_NEXTPLAYER,0,0);
  ntBackOn:
    begin background.Show; background.update end;
  ntBackOff:
    background.Close;
  end;
end;

procedure TDirectDlg.FormCreate(Sender: TObject);
begin
Gone:=false;
State:=-1;
Info:='';
OuterCore.Init(Notify);
Brain[bixNoTerm].Name:=Phrases.Lookup('AIT');
Brain[bixSuper_Virtual].Name:=Phrases.Lookup('SUPER');
Brain[bixTerm].Name:=Phrases.Lookup('HUMAN');
Canvas.Font.Assign(UniFont[ftNormal]);
Canvas.Brush.Style:=bsClear;
left:=(screen.width-width) div 2;
top:=(screen.height-height)*2 div 3;
end;

procedure TDirectDlg.FormDestroy(Sender: TObject);
begin
OuterCore.Done;
end;

procedure TDirectDlg.FormShow(Sender: TObject);
begin
if not Gone then
  begin PostMessage(Handle,WM_GO,0,0); Gone:=true end
end;

procedure TDirectDlg.OnGo(var m:TMessage);
var
i: integer;
s: string;
begin
Hide;
Quick:=false;
if ParamCount>0 then
  begin
  s:=ParamStr(1);
  if (s[1]='-') or (s[1]='/') then
    begin // special mode
    Delete(s,1,1);
    for i:=1 to Length(s) do if s[i] in ['a'..'z'] then dec(s[i],32);
    if s='MAN' then
      begin Quick:=true; DirectHelp(false); Close end;
    end
  else if (FileExists(ParamStr(1))) then
    begin
    Quick:=true;
    if not LoadGame(ExtractFilePath(ParamStr(1)),ExtractFileName(ParamStr(1)),-1) then
      begin
      MessgDlg.Tex:=StartTex;
      SimpleMessage(Phrases.Lookup('LOADERR'),'INVALID');
      Close
      end
    end
  end;
if not Quick then
  begin background.Show; StartDlg.Show end
end;

procedure TDirectDlg.OnChangeClient(var m:TMessage);
begin
ChangeClient;
end;

procedure TDirectDlg.OnNextPlayer(var m:TMessage);
begin
NextPlayer;
end;

procedure TDirectDlg.OnEraseBkgnd(var m:TMessage);
begin
end;

procedure TDirectDlg.FormPaint(Sender: TObject);
begin
Fill(Canvas,3,3,ClientWidth-6,ClientHeight-6,0,0,StartTex);
Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0);
Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2,StartTex.clBevelLight,
  StartTex.clBevelShade);
Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3,StartTex.clBevelLight,
  StartTex.clBevelShade);
if State>=0 then
  RisedTextOut(Canvas,(ClientWidth-Canvas.TextWidth(Info)) div 2,16,Info)
else RisedTextOut(Canvas,(ClientWidth-Canvas.TextWidth(Info)) div 2,
  (ClientHeight-Canvas.TextHeight(Info)) div 2,Info);
if State>=0 then
  PaintProgressBar(Canvas,0,ClientWidth div 2 -64,40,State,0,128,StartTex);
end;

procedure TDirectDlg.SetInfo(x: string);
begin
Info:=x;
Invalidate;
Update;
end;

procedure TDirectDlg.SetState(x: integer);
begin
if (x<0)<>(State<0) then
  begin State:=x; Invalidate; Update end
else if x<>State then
  begin
  State:=x;
  PaintProgressBar(Canvas,0,ClientWidth div 2 -64,40,State,0,128,StartTex);
  end
end;

procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
background.Close;
end;

end.