⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 start.pas

📁 类似文明的游戏源代码。
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{$INCLUDE switches}

unit Start;

interface

uses
  OuterCore,ButtonBase,

  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,StdCtrls,
  Menus,Registry,ButtonA,ButtonC, ButtonB;

type
  TStartDlg = class(TForm)
    PopupMenu1: TPopupMenu;
    ETurn: TEdit;
    StartBtn: TButtonA;
    Down1Btn: TButtonC;
    Up1Btn: TButtonC;
    List: TListBox;
    RenameBtn: TButtonB;
    DeleteBtn: TButtonB;
    Down2Btn: TButtonC;
    Up2Btn: TButtonC;
    QuitBtn: TButtonB;
    HelpBtn: TButtonB;
    procedure StartBtnClick(Sender:TObject);
    procedure FormPaint(Sender:TObject);
    procedure FormShow(Sender:TObject);
    procedure FormDestroy(Sender:TObject);
    procedure FormCreate(Sender:TObject);
    procedure BrainClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure Up1BtnClick(Sender: TObject);
    procedure Down1BtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListClick(Sender: TObject);
    procedure RenameBtnClick(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure ETurnKeyPress(Sender: TObject; var Key: char);
    procedure DiffBtnClick(Sender: TObject);
    procedure Up2BtnClick(Sender: TObject);
    procedure Down2BtnClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure QuitBtnClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  public
    BrainPicture: array[0..maxBrain-1] of TBitmap;
    EmptyPicture: TBitmap;
    procedure UpdateFormerGames;
    procedure UpdateMaps;
  private
    WorldSize, StartLandMass, MaxTurn,
    MiniWidth, MiniHeight,
    Page, ShowTab, Tab, Diff0,
    nMapStartPositions,
    LastTurn, {last turn of selected former game}
    SlotAvailable,
    bixPopup: integer; {brain concerned by brain context menu}
    ListIndex: array[0..2] of integer;
    MapFileName: string;
    FormerGames, Maps: TStringList;
    Mini:TBitmap; {game world sample preview}
    MiniColors: array[0..11,0..1] of TColor;
//    BookDate: string;
    DiffUpBtn: array[0..8] of TButtonC;
    DiffDownBtn: array[0..8] of TButtonC;
    MiniMode: (mmNone,mmPicture,mmMultiPlayer);
    Welcomed, TurnValid: boolean;
    procedure InitPopup(PopupIndex: integer);
    procedure PaintInfo;
    procedure ChangePage(NewPage: integer);
    procedure ChangeTab(NewTab: integer);
    procedure UnlistBackupFile(FileName: string);
    procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
  end;

var
  StartDlg:TStartDlg;

implementation

uses Protocol,Direct,ScreenTools, Inp, Messg;

{$R *.DFM}

const
// predefined world size
// attention: lx*ly+1 must be prime!
nWorldSize=6;
lxpre: array[0..nWorldSize-1] of integer =(30,40,50,60,75,100);
lypre: array[0..nWorldSize-1] of integer =(46,52,60,70,82,96);
DefaultWorldSize=3;
DefaultWorldTiles=4150;
DefaultLandMass=30;

nPlOffered=9;
x0Mini=437; y0Mini=164;
x0Brain=146; y0Brain=134;
dxBrain=104; dyBrain=80;
xBrain: array[0..nPlOffered-1] of integer =
  (x0Brain,x0Brain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain,
  x0Brain-dxBrain,x0Brain-dxBrain,x0Brain-dxBrain);
yBrain: array[0..nPlOffered-1] of integer =
  (y0Brain,y0Brain-dyBrain,y0Brain-dyBrain,y0Brain,y0Brain+dyBrain,
  y0Brain+dyBrain,y0Brain+dyBrain,y0Brain,y0Brain-dyBrain);
TabSize=136; TabHeight=28; QuitTabSize=0{104};

MaxWidthMapLogo=96; MaxHeightMapLogo=96;

InitAlive: array[1..nPlOffered] of integer=
  (1,1+32,1+8+128,1+8+32+128,1+2+8+32+128,1+2+8+16+64+128,1+2+4+16+32+64+256,1+4+8+16+32+64+128+256,511);

pgStartRandom=0; pgStartMap=1; pgNoLoad=2; pgLoad=3; pgEditRandom=4;
pgEditMap=5;


procedure TStartDlg.FormCreate(Sender:TObject);
var
x,y,i: integer;
s: string;
r0,r1: HRgn;
Reg: TRegistry;
FirstStart: boolean;
begin
Left:=(Screen.Width-ClientWidth) div 2;
Top:=Screen.Height-ClientHeight-8;

Reg:=TRegistry.Create;
FirstStart:=not Reg.KeyExists('SOFTWARE\cevo\RegVer5\Start');
Welcomed:=not FirstStart;

if FirstStart then
  begin
  // initialize AI assignment
  Reg.OpenKey('SOFTWARE\cevo\RegVer5\Start',true);
  for i:=0 to nPl-1 do
    begin
    if i=0 then s:=':StdIntf'
    else if (i<nPlOffered) {and (i and 1<>0)} then s:='StdAI'
    else s:='';
    Reg.WriteString('Control'+IntToStr(i),s);
    Reg.WriteInteger('Diff'+IntToStr(i),2);
    end;
  Reg.closekey;

  // register file type: "cevo Book"
  Reg.RootKey:=HKEY_CLASSES_ROOT;
  Reg.OpenKey ('.cevo',true);
  Reg.WriteString ('','cevoBook');
  Reg.closekey;
  Reg.OpenKey ('cevoBook',true);
  Reg.WriteString ('','cevo Book');
  Reg.closekey;
  Reg.OpenKey ('cevoBook\DefaultIcon',true);
  Reg.WriteString ('',ParamStr(0)+',0');
  Reg.closekey;
  Reg.OpenKey ('cevoBook\shell\open\command',true);
  Reg.WriteString ('',ParamStr(0)+' "%1"');
  Reg.closekey;
  end
else
  begin
  Reg.OpenKey('SOFTWARE\cevo\RegVer5\Start',false);
  try
    WorldSize:=Reg.ReadInteger('WorldSize');
    StartLandMass:=Reg.ReadInteger('LandMass');
    MaxTurn:=Reg.ReadInteger('MaxTurn');
  except
    FirstStart:=true;
    end;
  Reg.closekey;
  end;
if FirstStart then
  begin
  WorldSize:=DefaultWorldSize;
  StartLandMass:=DefaultLandMass;
  MaxTurn:=800;
  end;
Reg.Free;

r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight);
r1:=CreateRectRgn(3*TabSize+2,0,ClientWidth-QuitTabSize,TabHeight);
CombineRgn(r0,r0,r1,RGN_DIFF);
//DeleteObject(r1);
r1:=CreateRectRgn(QuitBtn.left,QuitBtn.Top,QuitBtn.left+QuitBtn.Width,
  QuitBtn.Top+QuitBtn.Height);
CombineRgn(r0,r0,r1,RGN_OR);
//DeleteObject(r1);
r1:=CreateRectRgn(HelpBtn.left,HelpBtn.Top,HelpBtn.left+HelpBtn.Width,
  HelpBtn.Top+HelpBtn.Height);
CombineRgn(r0,r0,r1,RGN_OR);
//DeleteObject(r1);
SetWindowRgn(Handle,r0,false);
//DeleteObject(r0); // causes crash with Windows 95

QuitBtn.Hint:=Phrases.Lookup('STARTCONTROLS',0);
HelpBtn.Hint:=Phrases.Lookup('STARTCONTROLS',13);
for i:=0 to nPlOffered-1 do
  begin
  DiffUpBtn[i]:=TButtonC.Create(self);
  DiffUpBtn[i].Graphic:=GrExt[HGrSystem].Data;
  DiffUpBtn[i].Left:=xBrain[i]-18;
  DiffUpBtn[i].Top:=yBrain[i]+39;
  DiffUpBtn[i].ButtonIndex:=1;
  DiffUpBtn[i].Parent:=self;
  DiffUpBtn[i].OnClick:=DiffBtnClick;
  DiffDownBtn[i]:=TButtonC.Create(self);
  DiffDownBtn[i].Graphic:=GrExt[HGrSystem].Data;
  DiffDownBtn[i].Left:=xBrain[i]-18;
  DiffDownBtn[i].Top:=yBrain[i]+51;
  DiffDownBtn[i].ButtonIndex:=0;
  DiffDownBtn[i].Parent:=self;
  DiffDownBtn[i].OnClick:=DiffBtnClick;
  end;

BrainPicture[0]:=TBitmap.Create;
BrainPicture[0].Width:=64; BrainPicture[0].Height:=64;
BitBlt(BrainPicture[0].Canvas.Handle,0,0,64,64,
  GrExt[HGrSystem2].Data.Canvas.Handle,1,111,SRCCOPY);
BrainPicture[1]:=TBitmap.Create;
BrainPicture[1].Width:=64; BrainPicture[1].Height:=64;
BitBlt(BrainPicture[1].Canvas.Handle,0,0,64,64,
  GrExt[HGrSystem2].Data.Canvas.Handle,66,111,SRCCOPY);
BrainPicture[2]:=TBitmap.Create;
BrainPicture[2].Width:=64; BrainPicture[2].Height:=64;
BitBlt(BrainPicture[2].Canvas.Handle,0,0,64,64,
  GrExt[HGrSystem2].Data.Canvas.Handle,131,111,SRCCOPY);
for i:=3 to nBrain-1 do
  begin
  BrainPicture[i]:=TBitmap.Create;
  try
    BrainPicture[i].LoadFromFile(HomeDir+Brain[i].FileName+'.bmp');
  except
    BrainPicture[i].Width:=64; BrainPicture[i].Height:=64;
    with BrainPicture[i].Canvas do
      begin
      Brush.Color:=$904830;
      FillRect(Rect(0,0,64,64));
      Font.Assign(UniFont[ftTiny]);
      Font.Style:=[];
      Font.Color:=$5FDBFF;
      Textout(32-TextWidth(Brain[i].FileName) div 2,
        32-TextHeight(Brain[i].FileName) div 2,Brain[i].FileName);
      end
    end
  end;

EmptyPicture:=TBitmap.Create;
EmptyPicture.PixelFormat:=pf24bit;
EmptyPicture.Width:=64; EmptyPicture.Height:=64;

Mini:=TBitmap.Create;
for x:=0 to 11 do for y:=0 to 1 do
  MiniColors[x,y]:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,67+y];
Canvas.Font.Assign(UniFont[ftNormal]);
Canvas.Brush.Style:=bsClear;
InitButtons(self);

bixView[0]:=bixTerm;
SlotAvailable:=-1;
Tab:=1;
ShowTab:=1;
Diff0:=2;
TurnValid:=false;
FormerGames:=TStringList.Create;
UpdateFormerGames;
MapFileName:='';
Maps:=TStringList.Create;
UpdateMaps;
end;

procedure TStartDlg.FormDestroy(Sender:TObject);
var
i: integer;
begin
FormerGames.Free;
Maps.Free;
Mini.Free;
EmptyPicture.Free;
for i:=0 to nBrain-1 do
  BrainPicture[i].Free;
end;

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

procedure TStartDlg.FormPaint(Sender:TObject);
var
i,w,xMini,yMini:integer;
s: string;
begin
Fill(Canvas,3,0,ClientWidth-3,ClientHeight-3,0,0,StartTex);
Frame(Canvas,328,Up1Btn.Top-12,ClientWidth,Up2Btn.Top+35,
  StartTex.clBevelShade,StartTex.clBevelLight);
Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0);
for i:=0 to 2 do
  begin
  Frame(Canvas,i*TabSize+2,2,(i+1)*TabSize-1,TabHeight,StartTex.clBevelLight,StartTex.clBevelShade);
  Frame(Canvas,i*TabSize+1,1,(i+1)*TabSize,TabHeight,StartTex.clBevelLight,StartTex.clBevelShade);
  Canvas.Pixels[i*TabSize+1,1]:=StartTex.clBevelShade;
  end;
//Frame(Canvas,ClientWidth-QuitTabSize+1,1,ClientWidth-2,TabHeight,StartTex.clBevelLight,StartTex.clBevelShade);
//Frame(Canvas,ClientWidth-QuitTabSize+2,2,ClientWidth-3,TabHeight-1,StartTex.clBevelLight,StartTex.clBevelShade);
//Canvas.Pixels[ClientWidth-QuitTabSize+1,1]:=StartTex.clBevelShade;
Frame(Canvas,3*TabSize+1,1,ClientWidth-QuitTabSize,TabHeight,$000000,$000000);
Frame(Canvas,1,TabHeight+1,ClientWidth-2,ClientHeight-2,StartTex.clBevelLight,
  StartTex.clBevelShade);
Frame(Canvas,2,TabHeight+2,ClientWidth-3,ClientHeight-3,StartTex.clBevelLight,
  StartTex.clBevelShade);
Fill(Canvas,3+Tab*TabSize,TabHeight-1,TabSize-4,4,0,0,StartTex);
Canvas.Pixels[Tab*TabSize+2,TabHeight]:=StartTex.clBevelLight;
Canvas.Pixels[(Tab+1)*TabSize-1,TabHeight+1]:=StartTex.clBevelShade;
if Tab<2 then
  Frame(Canvas,(Tab+1)*TabSize+1,3,(Tab+1)*TabSize+2,TabHeight,
    StartTex.clBevelShade,StartTex.clBevelShade); // tab shadow
RisedTextOut(Canvas,13,5,Phrases.Lookup('STARTCONTROLS',11));
RisedTextOut(Canvas,13+TabSize,5,Phrases.Lookup('STARTCONTROLS',3));
RisedTextOut(Canvas,12+TabSize*2,5,Phrases.Lookup('STARTCONTROLS',4));
//RisedTextOut(Canvas,ClientWidth-QuitTabSize+12,5,Phrases.Lookup('STARTCONTROLS',0));

if Page in [pgStartRandom,pgStartMap] then
  begin
  RisedTextOut(Canvas,344,y0Mini+61,Phrases.Lookup('STARTCONTROLS',10));
  s:=TurnToString(MaxTurn);
  RisedTextOut(Canvas,514-Canvas.TextWidth(s),y0Mini+61,s);

  w:=Canvas.TextWidth(Phrases.Lookup('STARTCONTROLS',7)) div 2;
  RisedTextOut(Canvas,x0Brain+32-w,y0Brain+dyBrain+69,Phrases.Lookup('STARTCONTROLS',7));
  DLine(Canvas,x0Brain-dxBrain,x0Brain+27-w,y0Brain+dyBrain+78,
    StartTex.clBevelLight,StartTex.clBevelShade);
  DLine(Canvas,x0Brain+36+w,x0Brain+dxBrain+63,y0Brain+dyBrain+78,
    StartTex.clBevelLight,StartTex.clBevelShade);

  for i:=0 to nPlOffered-1 do if 1 shl i and SlotAvailable<>0 then
    begin
    if bixView[i]>=0 then
      FrameImage(Canvas,BrainPicture[bixView[i]],xBrain[i],yBrain[i],64,64,0,0,true)
    else FrameImage(Canvas,EmptyPicture,xBrain[i],yBrain[i],64,64,0,0,true);
    if bixView[i]>=bixTerm then
      begin
      BitBlt(Canvas.Handle,xBrain[i]-18,yBrain[i]+19,12,14,
        GrExt[HGrSystem].Data.Canvas.Handle,134+(Difficulty[i]-1)*13,28,SRCCOPY);
      Frame(Canvas,xBrain[i]-19,yBrain[i]+18,xBrain[i]-18+12,yBrain[i]+(19+14),
        $000000,$000000);
      RFrame(Canvas,DiffUpBtn[i].Left-1,DiffUpBtn[i].Top-1,DiffUpBtn[i].Left+12,
        DiffUpBtn[i].Top+24,StartTex.clBevelShade,StartTex.clBevelLight);
      with Canvas do
        begin
        Brush.Color:=$000000;
        FillRect(Rect(xBrain[i]-5,yBrain[i]+25,xBrain[i]-2,yBrain[i]+27));
        Brush.Style:=bsClear;
        end;
      end;
    if bixView[i]>=0 then
      begin
      DiffUpBtn[i].Hint:=Format(Phrases.Lookup('STARTCONTROLS',9),
        [Brain[bixView[i]].Name]);
      DiffDownBtn[i].Hint:=DiffUpBtn[i].Hint;
      end
    end;
  end
else if Page=pgLoad then
  begin
//  RisedTextOut(Canvas,x0Mini+2-Canvas.TextWidth(BookDate) div 2,y0Mini-73,BookDate);
  RisedTextOut(Canvas,364,y0Mini+61,Phrases.Lookup('STARTCONTROLS',8));
  end
else if Page=pgEditRandom then
  begin
  RisedTextOut(Canvas,344,y0Mini-77,Phrases.Lookup('STARTCONTROLS',5));
  s:=IntToStr((lxpre[WorldSize]*lypre[WorldSize]*20 + DefaultWorldTiles div 2)
    div DefaultWorldTiles *5)+'%';
  RisedTextOut(Canvas,514-Canvas.TextWidth(s),y0Mini-77,s);
  RisedTextOut(Canvas,344,y0Mini+61,Phrases.Lookup('STARTCONTROLS',6));
  s:=IntToStr(StartLandMass)+'%';
  RisedTextOut(Canvas,514-Canvas.TextWidth(s),y0Mini+61,s);
  end;

if StartBtn.Visible then
  BtnFrame(Canvas,StartBtn.BoundsRect,StartTex);
if Up2Btn.Visible then
  RFrame(Canvas,Up2Btn.Left-1,Up2Btn.Top-1,Up2Btn.Left+12,
    Up2Btn.Top+24,StartTex.clBevelShade,StartTex.clBevelLight);
if Up1Btn.Visible then
  RFrame(Canvas,Up1Btn.Left-1,Up1Btn.Top-1,Up1Btn.Left+12,
    Up1Btn.Top+24,StartTex.clBevelShade,StartTex.clBevelLight);
if List.Visible then
  EditFrame(Canvas,List.BoundsRect,StartTex);
if ETurn.Visible then
  EditFrame(Canvas,ETurn.BoundsRect,StartTex);
if RenameBtn.Visible then
  BtnFrame(Canvas,RenameBtn.BoundsRect,StartTex);
if DeleteBtn.Visible then
  BtnFrame(Canvas,DeleteBtn.BoundsRect,StartTex);

if Page<>pgNoLoad then
  begin
  xMini:=x0Mini-MiniWidth;
  yMini:=y0Mini-MiniHeight div 2;
  Frame(Canvas,xMini,yMini,xMini+3+MiniWidth*2,yMini+3+MiniHeight,StartTex.clBevelLight,
    StartTex.clBevelShade);
  Frame(Canvas,xMini+1,yMini+1,xMini+2+MiniWidth*2,yMini+2+MiniHeight,StartTex.clBevelShade,
    StartTex.clBevelLight);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -