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

📄 citytype.pas

📁 类似文明的游戏源代码。
💻 PAS
字号:
{$INCLUDE switches}

unit CityType;

interface

uses
  Protocol,ClientTools,Term,ScreenTools,BaseWin,

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ButtonB, ExtCtrls, ButtonA, ButtonBase;

type
  TCityTypeDlg = class(TBaseDlg)
    CloseBtn: TButtonB;
    DeleteBtn: TButtonB;
    procedure CloseBtnClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DeleteBtnClick(Sender: TObject);
  protected  
    procedure OffscreenPaint; override;
  private
    nPool,dragiix,ctype: integer;
    Pooliix: array[0..nImp-1] of integer;
    listed: Set of 0..nImp;
    Changed: boolean;
    procedure LoadType(NewType: integer);
    procedure SaveType;
  end;

var
  CityTypeDlg: TCityTypeDlg;

implementation

uses Help;

{$R *.DFM}

const
xList=7; yList=0;
nListRow=4; nListCol=10;
xPool=7; yPool=220;
nPoolRow=4; nPoolCol=10;
xSwitch=7; ySwitch=150;
xView=226; yView=130;

procedure TCityTypeDlg.FormCreate(Sender:TObject);
begin
inherited;
CaptionRight:=CloseBtn.Left;
InitButtons(self);
end;

procedure TCityTypeDlg.CloseBtnClick(Sender:TObject);
begin
Close
end;

procedure TCityTypeDlg.FormPaint(Sender:TObject);
begin
inherited;
BtnFrame(Canvas,CloseBtn.BoundsRect,OuterTex);
BtnFrame(Canvas,DeleteBtn.BoundsRect,OuterTex);
end;

procedure TCityTypeDlg.OffscreenPaint;
var
i,iix: integer;
s: string;
begin
inherited;
offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
Fill(offscreen.Canvas,xList-7,yList,42*nListCol+14,32*nListRow,0,0,InnerTex);
Fill(offscreen.Canvas,xPool-7,yPool,42*nPoolCol+14,32*nPoolRow,0,0,InnerTex);
Fill(offscreen.Canvas,0,yList+32*nListRow,42*nPoolCol+14,
  yPool-yList-32*nListRow,0,0,OuterTex);

Frame(offscreen.Canvas,0,yList+32*nListRow,InnerWidth-255,yPool-23,
  OuterTex.clBevelLight,OuterTex.clBevelShade);
Frame(offscreen.Canvas,InnerWidth-254,yList+32*nListRow,InnerWidth-89,yPool-23,
  OuterTex.clBevelLight,OuterTex.clBevelShade);
Frame(offscreen.Canvas,InnerWidth-88,yList+32*nListRow,InnerWidth-1,yPool-23,
  OuterTex.clBevelLight,OuterTex.clBevelShade);
Frame(offscreen.Canvas,0,yPool-22,InnerWidth-1,yPool-1,
  OuterTex.clBevelLight,OuterTex.clBevelShade);
for i:=0 to nCityType-1 do
  begin
  RFrame(offscreen.Canvas,xSwitch+i*42,ySwitch,xSwitch+39+i*42,ySwitch+23,
    OuterTex.clBevelShade,OuterTex.clBevelLight);
  if i=ctype then
    Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22,
      OuterTex.clBevelShade,OuterTex.clBevelLight)
  else Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22,
    OuterTex.clBevelLight,OuterTex.clBevelShade);
  Dump(offscreen,HGrSystem,xSwitch+2+i*42,ySwitch+2,36,20,1+37*i,316)
  end;
RisedTextOut(offscreen.Canvas,8,yList+32*nListRow+2,Phrases.Lookup('BUILDORDER'));
RisedTextOut(offscreen.Canvas,8,ySwitch+26,Phrases.Lookup('CITYTYPE',ctype));
s:=Phrases.Lookup('BUILDREST');
RisedTextOut(offscreen.Canvas,(InnerWidth-offscreen.Canvas.TextWidth(s)) div 2,
  yList+72+32*nListRow,s);

with offscreen.Canvas do
  begin
  for i:=1 to nListRow-1 do
    DLine(offscreen.Canvas,xList-5,xList+4+42*nListCol,yList-1+32*i,
      InnerTex.clBevelLight,InnerTex.clBevelShade);
  for i:=0 to nListCol*nListRow-1 do
    begin
    s:=IntToStr(i+1);
    Font.Color:=InnerTex.clTextLight;
    Textout(xList+20+i mod nListCol *42-TextWidth(s) div 2,
      yList+15+i div nListCol *32-TextHeight(s) div 2,s);
    end
  end;

i:=0;
while MyData.ImpOrder[ctype,i]>=0 do
  begin
  RFrame(offscreen.Canvas,
    xList+20-xSizeSmall div 2 + i mod nListCol *42,
    yList+15-ySizeSmall div 2 + i div nListCol *32,
    xList+21+xSizeSmall div 2 + i mod nListCol *42,
    yList+16+ySizeSmall div 2 + i div nListCol *32,
    InnerTex.clBevelLight,InnerTex.clBevelShade);
  BitBlt(offscreen.Canvas.Handle,
    xList+21-xSizeSmall div 2 + i mod nListCol *42,
    yList+16-ySizeSmall div 2 + i div nListCol *32,
    xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,
    MyData.ImpOrder[ctype,i] mod 7*xSizeSmall,
    (MyData.ImpOrder[ctype,i]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY);
  inc(i);
  end;

nPool:=0;
for iix:=28 to nImp-1 do
  if not (iix in listed) and (Imp[iix].Kind=ikCommon) and (iix<>imTrGoods)
    and (Imp[iix].Preq<>preNA)
    and ((Imp[iix].Preq=preNone) or (MyRO.Tech[Imp[iix].Preq]>=tsApplicable)) then
    begin
    Pooliix[nPool]:=iix;
    RFrame(offscreen.Canvas,
      xPool+20-xSizeSmall div 2 + nPool mod nPoolCol *42,
      yPool+15-ySizeSmall div 2 + nPool div nPoolCol *32,
      xPool+21+xSizeSmall div 2 + nPool mod nPoolCol *42,
      yPool+16+ySizeSmall div 2 + nPool div nPoolCol *32,
      InnerTex.clBevelLight, InnerTex.clBevelShade);
    BitBlt(offscreen.Canvas.Handle,
      xPool+21-xSizeSmall div 2 + nPool mod nPoolCol *42,
      yPool+16-ySizeSmall div 2 + nPool div nPoolCol *32,
      xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,
      iix mod 7*xSizeSmall,(iix+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY);
    inc(nPool)
    end;
DeleteBtn.Visible:= MyData.ImpOrder[ctype,0]>=0;

if dragiix>=0 then
  begin
  FrameImage(offscreen.Canvas,BigImp,xView+9,yView+5,56,40,
    dragiix mod 7 *xSizeBig,(dragiix+SystemIconLines*7) div 7 *ySizeBig);
  s:=Phrases.Lookup('IMPROVEMENTS',dragiix);
  RisedTextOut(offscreen.Canvas,xView+36-offscreen.Canvas.TextWidth(s) div 2,
    ySwitch+26,s);
  end;
MarkUsedOffscreen(InnerWidth,InnerHeight);
end; {MainPaint}

procedure TCityTypeDlg.LoadType(NewType: integer);
var
i: integer;
begin
ctype:=NewType;
listed:=[];
i:=0;
while MyData.ImpOrder[ctype,i]>=0 do
  begin include(listed,MyData.ImpOrder[ctype,i]); inc(i) end;
Changed:=false
end;

procedure TCityTypeDlg.SaveType;
var
cix: integer;
begin
if Changed then
  begin
  for cix:=0 to MyRO.nCity-1 do
    if (MyCity[cix].Loc>=0) and (MyCity[cix].Status and 7=ctype+1) then
      AutoBuild(cix, MyData.ImpOrder[ctype]);
  Changed:=false
  end;
end;

procedure TCityTypeDlg.FormShow(Sender: TObject);
begin
LoadType(0);
dragiix:=-1;
OffscreenPaint;
end;

procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; x, y: integer);
var
i: integer;
begin
x:=x-SideFrame; y:=y-WideFrame;
i:=(x-xList) div 42+(y-yList) div 32 *nListCol;
if (i<nImp) and (MyData.ImpOrder[ctype,i]>=0)
  and (x>xList+2+ i mod nListCol *42) and (y>yList+5+ i div nListCol *32)
  and (x<xList+3+36+ i mod nListCol *42) and (y<yList+6+20+ i div nListCol *32) then
  begin
  if ssShift in Shift then
    HelpDlg.ShowPage(hkImp,MyData.ImpOrder[ctype,i])
  else
    begin
    dragiix:=MyData.ImpOrder[ctype,i];
    Screen.Cursor:=crImpDrag;
    OffscreenPaint;
    SmartInvalidate;
    end;
  exit;
  end;
i:=(x-xPool) div 42+(y-yPool) div 32 *nPoolCol;
if (i<nPool) and (x>xPool+2+ i mod nPoolCol *42)
  and (y>yPool+5+ i div nPoolCol *32) and (x<xPool+3+36+ i mod nPoolCol *42)
  and (y<yPool+6+20+ i div nPoolCol *32) then
  begin
  if ssShift in Shift then
    HelpDlg.ShowPage(hkImp,Pooliix[i])
  else
    begin
    dragiix:=Pooliix[i];
    Screen.Cursor:=crImpDrag;
    OffscreenPaint;
    SmartInvalidate;
    end;
  exit;
  end;
i:=(x-xSwitch) div 42;
if (i<nCityType) and (x>xSwitch+2+ i*42) and (x<xSwitch+3+36+i*42)
  and (y>=ySwitch+2) and (y<ySwitch+22) then
  begin
  SaveType;
  LoadType(i);
  OffscreenPaint;
  SmartInvalidate
  end
end;

procedure TCityTypeDlg.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; x, y: integer);

  procedure UnList(iix: integer);
  var
  i: integer;
  begin
  i:=0;
  while (MyData.ImpOrder[ctype,i]>=0) and (MyData.ImpOrder[ctype,i]<>iix) do
    inc(i);
  assert(MyData.ImpOrder[ctype,i]=iix);
  move(MyData.ImpOrder[ctype,i+1],MyData.ImpOrder[ctype,i],nImp-i);
  Exclude(listed,iix);
  end;

var
i: integer;
begin
x:=x-SideFrame; y:=y-WideFrame;
if dragiix>=0 then
  begin
  if (x>=xList) and (x<xList+nListCol*42)
    and (y>=yList) and (y<yList+nListRow*32) then
    begin
    if dragiix in listed then UnList(dragiix);
    i:=(x-xList) div 42+(y-yList) div 32 *nListCol;
    while (i>0) and (MyData.ImpOrder[ctype,i-1]<0) do dec(i);
    move(MyData.ImpOrder[ctype,i],MyData.ImpOrder[ctype,i+1],nImp-i-1);
    MyData.ImpOrder[ctype,i]:=dragiix;
    include(listed,dragiix);
    Changed:=true
    end
  else if (dragiix in listed) and (x>=xPool) and (x<xPool+nPoolCol*42)
    and (y>=yPool) and (y<yPool+nPoolRow*32) then
    begin
    UnList(dragiix);
    Changed:=true
    end;
  dragiix:=-1;
  OffscreenPaint;
  SmartInvalidate
  end;
Screen.Cursor:=crDefault
end;

procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SaveType;
inherited;
end;

procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject);
begin
fillchar(MyData.ImpOrder[ctype],sizeof(MyData.ImpOrder[ctype]),-1);
listed:=[];
Changed:=true;
OffscreenPaint;
SmartInvalidate
end;

end.

⌨️ 快捷键说明

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