start.pas

类似文明的游戏源代码。

f: TSearchRec;
begin
FormerGames.Clear;
if FindFirst(HomeDir+'Saved\*.cevo',$21,f)=0 then
  repeat
    i:=FormerGames.Count;
    while (i>0) and (f.Time<integer(FormerGames.Objects[i-1])) do
      dec(i);
    FormerGames.InsertObject(i,Copy(f.Name,1,Length(f.Name)-5),
      TObject(f.Time));
  until FindNext(f)<>0;
ListIndex[2]:=FormerGames.Count-1;
if (ShowTab=1) and (FormerGames.Count>0) then ShowTab:=2;
TurnValid:=false;
end;

procedure TStartDlg.UpdateMaps;
var
f: TSearchRec;
begin
Maps.Clear;
if FindFirst(HomeDir+'Maps\*.cevo map',$21,f)=0 then
  repeat
    Maps.Add(Copy(f.Name,1,Length(f.Name)-9));
  until FindNext(f)<>0;
Maps.Sort;
Maps.Insert(0,Phrases.Lookup('RANMAP'));
ListIndex[0]:=Maps.IndexOf(Copy(MapFileName,1,Length(MapFileName)-9));
if ListIndex[0]<0 then ListIndex[0]:=0;
end;

procedure TStartDlg.ChangePage(NewPage: integer);
var
i,j,p1: integer;
s: string;
Reg: TRegistry;
begin
Page:=NewPage;
if Page=pgLoad then begin Up2Btn.left:=502; Down2Btn.left:=502; end
else begin Up2Btn.left:=522; Down2Btn.left:=522; end;

case Page of
  pgStartRandom, pgStartMap:
    begin
    StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',1);
    if Page=pgStartRandom then i:=nPlOffered
    else
      begin
      i:=nMapStartPositions;
      if i=0 then begin bixView[0]:=bixSuper_Virtual; Difficulty[0]:=0 end;
      if bixView[0]<bixTerm then inc(i);
      if i>nPlOffered then i:=nPlOffered;
      end;
    if InitAlive[i]<>SlotAvailable then
      if Page=pgStartRandom then
        begin // restore AI assignment of last start
        Reg:=TRegistry.Create;
        Reg.OpenKey('SOFTWARE\cevo\RegVer5\Start',false);
        for p1:=0 to nPl-1 do
          begin
          bixView[p1]:=-1;
          s:=Reg.ReadString('Control'+IntToStr(p1));
          Difficulty[p1]:=Reg.ReadInteger('Diff'+IntToStr(p1));
          if s<>'' then
            for j:=0 to nBrain-1 do
              if AnsiCompareFileName(s,Brain[j].FileName)=0 then bixView[p1]:=j;
          end;
        Reg.closekey;
        Reg.Free;
        end
      else
        for p1:=1 to nPl-1 do
          if 1 shl p1 and InitAlive[i]<>0 then
            begin bixView[p1]:=nBrain-1; Difficulty[p1]:=2; end
          else bixView[p1]:=-1;
    SlotAvailable:=InitAlive[i];
    for i:=0 to nPlOffered-1 do
      if bixView[i]>=bixTerm then
        begin DiffUpBtn[i].Tag:=768; DiffDownBtn[i].Tag:=768; end
      else begin DiffUpBtn[i].Tag:=0; DiffDownBtn[i].Tag:=0; end
    end;

  pgNoLoad,pgLoad:
    begin
    StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',2);
    RenameBtn.Hint:=Phrases.Lookup('BTN_RENGAME');
    DeleteBtn.Hint:=Phrases.Lookup('BTN_DELGAME');
    end;

  pgEditRandom,pgEditMap:
    begin
    StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',12);
    RenameBtn.Hint:=Phrases.Lookup('BTN_RENMAP');
    DeleteBtn.Hint:=Phrases.Lookup('BTN_DELMAP');
    end;
  end;

PaintInfo;
for i:=0 to ControlCount-1 do
  Controls[i].Visible:= Controls[i].Tag and (256 shl Page)<>0;
List.Invalidate;
Invalidate;
end;

procedure TStartDlg.ChangeTab(NewTab: integer);
begin
Tab:=NewTab;
case Tab of
  0: List.Items.Assign(Maps);
  2: List.Items.Assign(FormerGames);
  end;
if Tab<>1 then
  if ListIndex[Tab]>=0 then List.ItemIndex:=ListIndex[Tab]
  else List.ItemIndex:=0;
case Tab of
  0:
    if List.ItemIndex=0 then ChangePage(pgEditRandom)
    else ChangePage(pgEditMap);
  1:
    if MapFileName='' then ChangePage(pgStartRandom)
    else ChangePage(pgStartMap);
  2:
    if FormerGames.Count=0 then ChangePage(pgNoLoad)
    else ChangePage(pgLoad);
  end;
end;

procedure TStartDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
var
i: integer;
begin
if (y<TabHeight+1) and (x<TabSize*3) and (x div TabSize<>Tab) then
  begin
  Play('BUTTON_DOWN');
  ListIndex[Tab]:=List.ItemIndex;
  ChangeTab(x div TabSize);
  end
else if (page=pgStartRandom)
  or (page=pgStartMap) and (nMapStartPositions>0) then
  for i:=0 to nPlOffered-1 do
    if (1 shl i and SlotAvailable<>0) and (x>=xBrain[i]) and (y>=yBrain[i])
      and (x<xBrain[i]+64) and (y<yBrain[i]+64) then
      begin
      InitPopup(i);
      if yBrain[i]>y0Brain then
        PopupMenu1.Popup(Left+xBrain[i]+4,Top+yBrain[i]+60)
      else PopupMenu1.Popup(Left+xBrain[i]+4,Top+yBrain[i]+4);
      end
end;

procedure TStartDlg.Up2BtnClick(Sender: TObject);
var
i,LoadTurn: integer;
r: TRect;
begin
case Page of
  pgStartRandom,pgStartMap:
    if MaxTurn<1400 then
      begin
      inc(MaxTurn,200);
      r:=Rect(416,y0Mini+61,510,y0Mini+82);
      InvalidateRect(Handle,@r,false);
      end;
  pgLoad:
    begin
    val(ETurn.Text,LoadTurn,i);
    if (i=0) and (LoadTurn>=-4000) then
      begin
      LoadTurn:=YearToTurn(LoadTurn);
      if LoadTurn>LastTurn then LoadTurn:=LastTurn;
      end
    else LoadTurn:=LastTurn;
    if LoadTurn<LastTurn then inc(LoadTurn);
    ETurn.Text:=IntToStr(turntoyear(LoadTurn));
    end;
  pgEditRandom:
    if StartLandMass<96 then
      begin
      inc(StartLandMass,5);
      PaintInfo;
      r:=Rect(450,y0Mini+61,510,y0Mini+61+21);
      InvalidateRect(Handle,@r,false);
      end;
  end
end;

procedure TStartDlg.Down2BtnClick(Sender: TObject);
var
i,LoadTurn: integer;
r: TRect;
begin
case Page of
  pgStartRandom,pgStartMap:
    if MaxTurn>400 then
      begin
      dec(MaxTurn,200);
      r:=Rect(416,y0Mini+61,510,y0Mini+82);
      InvalidateRect(Handle,@r,false);
      end;
  pgLoad:
    begin
    val(ETurn.Text,LoadTurn,i);
    if (i=0) and (LoadTurn>=-4000) then
      begin
      LoadTurn:=YearToTurn(LoadTurn);
      if LoadTurn>LastTurn then LoadTurn:=LastTurn;
      end
    else LoadTurn:=LastTurn;
    if LoadTurn>0 then dec(LoadTurn);
    ETurn.Text:=IntToStr(turntoyear(LoadTurn));
    end;
  pgEditRandom:
    if StartLandMass>10 then
      begin
      dec(StartLandMass,5);
      PaintInfo;
      r:=Rect(450,y0Mini+61,510,y0Mini+61+21);
      InvalidateRect(Handle,@r,false);
      end
  end
end;

procedure TStartDlg.Up1BtnClick(Sender: TObject);
var
r: TRect;
begin
if WorldSize<nWorldSize-1 then
  begin
  inc(WorldSize);
  PaintInfo;
  r:=Rect(450,y0Mini-77,510,y0Mini-77+21);
  InvalidateRect(Handle,@r,false);
  end
end;

procedure TStartDlg.Down1BtnClick(Sender: TObject);
var
r: TRect;
begin
if WorldSize>0 then
  begin
  dec(WorldSize);
  PaintInfo;
  r:=Rect(450,y0Mini-77,510,y0Mini-77+21);
  InvalidateRect(Handle,@r,false);
  end
end;

procedure TStartDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DirectDlg.Close
end;

procedure TStartDlg.ListClick(Sender: TObject);
var
i: integer;
r: TRect;
begin
if (Tab=0) and ((List.ItemIndex=0)<>(Page=pgEditRandom)) then
  begin
  if List.ItemIndex=0 then Page:=pgEditRandom
  else Page:=pgEditMap;
  for i:=0 to ControlCount-1 do
    Controls[i].Visible:= Controls[i].Tag and (256 shl Page)<>0;
  r:=Rect(328,Up1Btn.Top-12,ClientWidth,Up2Btn.Top+35);
  InvalidateRect(Handle,@r,false);
  end;
if Page=pgLoad then TurnValid:=false;
PaintInfo;
end;

procedure TStartDlg.RenameBtnClick(Sender: TObject);
var
i: integer;
NewName: string;
f: file;
ok: boolean;
begin
if List.ItemIndex>=0 then
  begin
  if Page=pgLoad then InputDlg.Caption:=Phrases.Lookup('TITLE_BOOKNAME')
  else InputDlg.Caption:=Phrases.Lookup('TITLE_MAPNAME');
  InputDlg.EInput.Text:=List.Items[List.ItemIndex];
  InputDlg.ShowModal;
  NewName:=InputDlg.EInput.Text;
  while (NewName<>'') and (NewName[1]='~') do delete(NewName,1,1);
  if (InputDlg.ModalResult=mrOK) and (NewName<>'')
    and (NewName<>List.Items[List.ItemIndex]) then
    begin
    for i:=1 to Length(NewName) do
      if NewName[i] in ['\','/',':','*','?','"','<','>','|'] then
        begin
        SimpleMessage(Format(Phrases.Lookup('NOFILENAME'),[NewName[i]]),
          'INVALID');
        exit
        end;
    if Page=pgLoad then
      AssignFile(f,HomeDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo')
    else AssignFile(f,HomeDir+'Maps\'+List.Items[List.ItemIndex]+'.cevo map');
    ok:=true;
    try
      if Page=pgLoad then
        Rename(f,HomeDir+'Saved\'+NewName+'.cevo')
      else Rename(f,HomeDir+'Maps\'+NewName+'.cevo map');
    except
      Play('INVALID');
      ok:=false
      end;
    if ok then
      begin
      if Page=pgLoad then
        FormerGames[List.ItemIndex]:=NewName
      else Maps[List.ItemIndex]:=NewName;
      List.Items[List.ItemIndex]:=NewName;
      if Page=pgEditMap then PaintInfo;
      List.Invalidate;
      end
    end
  end
end;

procedure TStartDlg.DeleteBtnClick(Sender: TObject);
var
iDel: integer;
f: file;
begin
if List.ItemIndex>=0 then
  begin
  if Page=pgLoad then MessgDlg.MessgText:=Phrases.Lookup('DELETEQUERY')
  else MessgDlg.MessgText:=Phrases.Lookup('MAPDELETEQUERY');
  MessgDlg.Kind:=mkOKCancel;
  MessgDlg.ShowModal;
  if MessgDlg.ModalResult=mrOK then
    begin
    if Page=pgLoad then
      AssignFile(f,HomeDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo')
    else AssignFile(f,HomeDir+'Maps\'+List.Items[List.ItemIndex]+'.cevo map');
    Erase(f);
    iDel:=List.ItemIndex;
    if Page=pgLoad then FormerGames.Delete(iDel)
    else Maps.Delete(iDel);
    List.Items.Delete(iDel);
    if List.Items.Count=0 then ChangePage(pgNoLoad)
    else
      begin
      if iDel=0 then List.ItemIndex:=0
      else List.ItemIndex:=iDel-1;
      if (Page=pgEditMap) and (List.ItemIndex=0) then ChangePage(pgEditRandom)
      else
        begin List.Invalidate;
        if Page=pgLoad then TurnValid:=false;
        PaintInfo;
        end;
      end
    end
  end
end;

procedure TStartDlg.ETurnKeyPress(Sender: TObject; var Key: char);
begin
if Key=#13 then
  begin Key:=#0 ; StartBtnClick(Sender) end
end;

procedure TStartDlg.DiffBtnClick(Sender: TObject);
var
i: integer;
r: TRect;
begin
for i:=0 to nPlOffered-1 do
  if (Sender=DiffUpBtn[i]) and (Difficulty[i]<MaxDiff)
    or (Sender=DiffDownBtn[i]) and (Difficulty[i]>1) then
    begin
    if Sender=DiffUpBtn[i] then inc(Difficulty[i])
    else dec(Difficulty[i]);
    r:=Rect(xBrain[i]-18,yBrain[i]+19,xBrain[i]-18+12,yBrain[i]+(19+14));
    InvalidateRect(Handle,@r,false);
    end
end;

procedure TStartDlg.FormHide(Sender: TObject);
begin
Diff0:=Difficulty[0];
ListIndex[Tab]:=List.ItemIndex;
ShowTab:=Tab;
end;

procedure TStartDlg.QuitBtnClick(Sender: TObject);
begin
Close
end;

procedure TStartDlg.HelpBtnClick(Sender: TObject);
begin
DirectHelp(true);
end;

procedure TStartDlg.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (Shift=[]) and (Key=VK_F1) then DirectHelp(true);
end;

end.