natstat.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit NatStat;

interface

uses
  Protocol,ClientTools,Term,ScreenTools,BaseWin,PVSB,

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

type
  TNatStatDlg = class(TBaseDlg)
    DialogBtn: TButtonB;
    ToggleBtn: TButtonB;
    StatBtn: TButtonB;
    AttUpBtn: TButtonC;
    AttDownBtn: TButtonC;
    MilitaryBtn: TButtonB;
    CloseBtn: TButtonB;
    OfferBtn: TButtonB;
    DipCancelTreatyBtn: TButtonB;
    BreakBtn: TButtonB;
    AckBtn: TButtonB;
    RevoBtn: TButtonB;
    TaxDownBtn: TButtonC;
    TaxUpBtn: TButtonC;
    ScienceUpBtn: TButtonC;
    ScienceDownBtn: TButtonC;
    Popup: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure StatBtnClick(Sender: TObject);
    procedure DialogBtnClick(Sender: TObject);
    procedure ToggleBtnClick(Sender: TObject);
    procedure PlayerClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure DecisionBtnClick(Sender: TObject);
    procedure OfferBtnClick(Sender: TObject);
    procedure MilitaryBtnClick(Sender: TObject);
    procedure AttUpBtnClick(Sender: TObject);
    procedure AttDownBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RevoBtnClick(Sender: TObject);
    procedure TaxLuxBtnClick(Sender: TObject);
  public
    Mode, pView: integer;
    DialogText: array[0..nPl-1] of string;
    procedure ShowNow;
    procedure CloseNow;
  protected  
    procedure OffscreenPaint; override;
  private
    Lines: integer;
    sb: TPVScrollbar;
    SelfReport: ^TEnemyReport;
    Closable, AltGovs: boolean;
    procedure SplitText(preview: boolean);
    procedure OnScroll(var m:TMessage); message WM_VSCROLL;
  end;

var
  NatStatDlg: TNatStatDlg;

const
{modes}
mSelf=0; mStat=1; mDialog=2;


implementation

{$R *.DFM}

uses
  Diagram,Select,Messg,MessgEx,Diplomacy, CityScreen;

const
MaxLines=10;

xRates=151; yRates=58;

procedure TNatStatDlg.FormCreate(Sender: TObject);
begin
inherited;
CaptionRight:=CloseBtn.Left;
CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width;
CreatePVSB(sb,Handle,WideFrame+64+37,SideFrame+InnerWidth,
  WideFrame+InnerHeight);
GetMem(SelfReport,SizeOf(TEnemyReport)-2*(INFIN+1));
InitButtons(self);
end;

procedure TNatStatDlg.FormDestroy(Sender: TObject);
begin
FreeMem(SelfReport);
end;

procedure TNatStatDlg.OnScroll(var m:TMessage);
begin
if ProcessPVSB(sb,m) then
  begin OffscreenPaint; SmartInvalidate; Update end
end;

procedure TNatStatDlg.SplitText(preview: boolean);
var
x,x0,Start,Stop,MaxLineWidth: integer;
s,s0:string;
begin
offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
Start:=1;
Lines:=0;

while Start<Length(DialogText[me]) do
  begin
  x0:=43+8;
  MaxLineWidth:=InnerWidth-(43+24)-GetSystemMetrics(SM_CXVSCROLL);
  if (Start>1) and (DialogText[me][Start-1]='\') then
    begin
    if not preview and (Lines>=sb.si.npos) and (Lines<sb.si.npos+MaxLines) then
      with offscreen.Canvas do
        begin
        Pen.Color:=$000000;
        Brush.Color:=Tribe[ord(DialogText[me][Start])-64].Color;
        Rectangle(43+8+2,64+37+9+(Lines-sb.si.npos)*20,
          43+8+8,64+37+15+(Lines-sb.si.npos)*20);
        Brush.Style:=bsClear;
        end;
    inc(Start);
    x0:=x0+10;
    MaxLineWidth:=MaxLineWidth-10;
    end;

  Stop:=Start;
  while(Stop<Length(DialogText[me])) and (DialogText[me][Stop]<>'\')
    and (offscreen.Canvas.TextWidth(Copy(DialogText[me],Start,Stop-Start+1))
    <MaxLineWidth) do
    inc(Stop);
  if Stop<>Length(DialogText[me]) then
    while(DialogText[me][Stop+1]<>' ') and (DialogText[me][Stop+1]<>'\') do
      dec(Stop);
  if not preview and (Lines>=sb.si.npos) and (Lines<sb.si.npos+MaxLines) then
    begin
    s:=Copy(DialogText[me],Start,Stop-Start+1);
    s0:=s;
    while pos('%c',s)>0 do
      begin x:=pos('%c',s); s[x]:=' '; s[x+1]:=' '; Insert('  ',s,x); end;
    while pos('%c',s0)>0 do
      begin
      x:=pos('%c',s0);
      s0[x]:=' '; s0[x+1]:=' ';
      Insert('  ',s0,x);
      x:=x0+2+offscreen.Canvas.TextWidth(Copy(s0,1,x-1));
      BitBlt(offscreen.Canvas.Handle,x,64+37+8+(Lines-sb.si.npos)*20,10,10,
        GrExt[HGrSystem].Mask.Canvas.Handle,132,115,SRCAND);
      BitBlt(offscreen.Canvas.Handle,x,64+37+8+(Lines-sb.si.npos)*20,10,10,
        GrExt[HGrSystem].Data.Canvas.Handle,132,115,SRCPAINT);
      end;
    LoweredTextOut(offscreen.Canvas,-1,InnerTex,x0,
      64+37+3+(Lines-sb.si.npos)*20,s);
    end;
  Start:=Stop+2;
  inc(Lines)
  end;
end;

procedure TNatStatDlg.FormPaint(Sender: TObject);
begin
inherited;
if CloseBtn.Visible then BtnFrame(Canvas,CloseBtn.BoundsRect,OuterTex);
if ToggleBtn.Visible then BtnFrame(Canvas,ToggleBtn.BoundsRect,OuterTex);
if RevoBtn.Visible then BtnFrame(Canvas,RevoBtn.BoundsRect,OuterTex);
if StatBtn.Visible then BtnFrame(Canvas,StatBtn.BoundsRect,OuterTex);
if DialogBtn.Visible then BtnFrame(Canvas,DialogBtn.BoundsRect,OuterTex);
if MilitaryBtn.Visible then BtnFrame(Canvas,MilitaryBtn.BoundsRect,InnerTex);
if BreakBtn.Visible then BtnFrame(Canvas,BreakBtn.BoundsRect,OuterTex);
if OfferBtn.Visible then BtnFrame(Canvas,OfferBtn.BoundsRect,OuterTex);
if DipCancelTreatyBtn.Visible then BtnFrame(Canvas,DipCancelTreatyBtn.BoundsRect,
  OuterTex);
if AckBtn.Visible then BtnFrame(Canvas,AckBtn.BoundsRect,OuterTex);
if AttUpBtn.Visible then
  RFrame(Canvas,AttUpBtn.Left-1,AttUpBtn.Top-1,AttUpBtn.Left+12,
    AttUpBtn.Top+24,OuterTex.clBevelShade,OuterTex.clBevelLight);
if TaxUpBtn.Visible then
  RFrame(Canvas,TaxDownBtn.Left-1,TaxUpBtn.Top-1,TaxUpBtn.Left+12,
    TaxUpBtn.Top+12,InnerTex.clBevelShade,InnerTex.clBevelLight);
if ScienceUpBtn.Visible then
  RFrame(Canvas,ScienceUpBtn.Left-1,ScienceUpBtn.Top-1,ScienceDownBtn.Left+12,
    ScienceUpBtn.Top+12,InnerTex.clBevelShade,InnerTex.clBevelLight);
end;

procedure TNatStatDlg.FormShow(Sender: TObject);
var
i: integer;
begin
if Mode=mSelf then
  begin
  ShowPVSB(sb,false);
  SelfReport.TurnOfCivilReport:=MyRO.Turn;
  SelfReport.TurnOfMilReport:=MyRO.Turn;
  move(MyRO.Treaty, SelfReport.Treaty, sizeof(SelfReport.Treaty));
  SelfReport.Government:=MyRO.Government;
  SelfReport.Money:=MyRO.Money;
  pView:=me;
  end
else if DipMem[me].pContact>=0 then
  begin
  Mode:=mDialog;
  pView:=DipMem[me].pContact;
  SplitText(true);
  InitPVSB(sb,Lines,MaxLines);
  EndPVSB(sb);
  end
else
  begin
  Mode:=mStat;
  ShowPVSB(sb,false);
  while MyRO.Treaty[pView]<trNone do inc(pView);
  end;
ToggleBtn.Visible:= Mode<>mSelf;
RevoBtn.Visible:= (Mode=mSelf) and (MyRO.Government<>gAnarchy);
if RevoBtn.Visible then
  if MyRO.Happened and phChangeGov<>0 then
    begin AltGovs:=true; RevoBtn.Hint:=Phrases.Lookup('TITLE_GOV'); end
  else
    begin
    RevoBtn.Hint:=Phrases.Lookup('BTN_REVO');
    AltGovs:=false;
    for i:=2 to nGov-1 do
      if (GovPreq[i]<>preNA) and ((GovPreq[i]=preNone)
        or (MyRO.Tech[GovPreq[i]]>=tsApplicable)) then
        AltGovs:=true;
    end;

CloseBtn.Visible:= (Mode=mSelf) or (DipMem[me].pContact<0);
TaxUpBtn.Visible:= Mode=mSelf;
TaxDownBtn.Visible:= Mode=mSelf;
ScienceUpBtn.Visible:= Mode=mSelf;
ScienceDownBtn.Visible:= Mode=mSelf;
StatBtn.Down:= Mode=mStat;
DialogBtn.Down:= Mode=mDialog;
if Mode=mSelf then Caption:=Tribe[pView].TPhrase('TITLE_MYNATION')
else Caption:=Tribe[pView].TPhrase('TITLE_NATION');
Closable:=false;
end;

procedure TNatStatDlg.OffscreenPaint;
var
i, PanelWidth, p1, yout, Kind, ShowLuxRate: integer;
xout: array[0..2] of integer;
s: string;
Report: ^TEnemyReport;
List: ^TChart;
ContactEnabled: boolean;

  procedure WriteStat(no,x,y: integer);
  var
  Turn,i: integer;
  begin
  if no=stMil then Turn:=Report.TurnOfMilReport
  else Turn:=Report.TurnOfCivilReport;
  if (Turn>=0) and (Server(sGetChart+no shl 4,me,pView,List^)>=rExecuted) then
    begin
    if Turn>=0 then i:=List[Turn]
    else if no=stPop then i:=4
    else i:=0;
    case no of
      stPop: s:=Format(Phrases.Lookup('FRSTATPOP'),[i/5]);
      stTerritory: s:=Format(Phrases.Lookup('FRSTATTER'),[i/65]);
      stMil: s:=Format(Phrases.Lookup('FRSTATMIL'),[(i+5) div 10]);
      stScience: s:=Format(Phrases.Lookup('FRSTATTECH'),[i div nAdv]);
      stExplore: s:=Format(Phrases.Lookup('FRSTATEXP'),[i*100 div (G.lx*G.ly)]);
      end;
    Sprite(offscreen,HGrSystem,x,y+5,8,8,81,16);
    LoweredTextOut(OffScreen.Canvas,-1,InnerTex,x+12,y,s);
    end
  end;

begin
inherited;

if Mode=mSelf then Report:=pointer(SelfReport)
else Report:=pointer(MyRO.EnemyReport[pView]);
GetMem(List,4*(MyRO.Turn+1));

offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
with offscreen do
  begin
  if Mode=mSelf then PanelWidth:=100 else PanelWidth:=130;
  if Mode=mSelf then
    begin
    Fill(Canvas,1,1,PanelWidth-2,62+37,0,0,OuterTex);
    Fill(Canvas,PanelWidth,0,InnerWidth-PanelWidth,64+37,0,0,InnerTex);
    Frame(Canvas,0,0,PanelWidth-1,64+36,OuterTex.clBevelLight,
      OuterTex.clBevelShade);
    end
  else
    begin
    Fill(Canvas,1,1,PanelWidth-2,62,0,0,OuterTex);
    Frame(Canvas,0,0,PanelWidth-1,63,OuterTex.clBevelLight,OuterTex.clBevelShade);
    Fill(Canvas,PanelWidth,0,InnerWidth-PanelWidth,64,0,0,InnerTex);
    end;
  Canvas.Pen.Color:=$000000;
  Canvas.Brush.Color:=Tribe[pView].Color;
  Canvas.Rectangle(PanelWidth-(82+6),8-1,PanelWidth-(82-70),8+49);
  Canvas.Brush.Color:=$000000;

  // show leader picture
  Tribe[pView].InitAge(GetAge(pView));
  if Tribe[pView].faceHGr>=0 then
    Dump(offscreen,Tribe[pView].faceHGr,PanelWidth-82,8,64,48,
      1+Tribe[pView].facepix mod 10 *65,1+Tribe[pView].facepix div 10 *49)
  else Canvas.FillRect(Rect(PanelWidth-82,8,PanelWidth-(82-64),8+48));
  Canvas.Brush.Style:=bsClear;
  Frame(Canvas,PanelWidth-(82+1),8-1,PanelWidth-(82-64),8+48,$000000,$000000);
  if Mode<>mSelf then
    begin
    Fill(Canvas,1,65,InnerWidth-2,35,0,0,OuterTex);
    Frame(Canvas,0,64,InnerWidth-1,64+36,OuterTex.clBevelLight,
      OuterTex.clBevelShade);
    end;

  ContactEnabled:= (Mode<>mSelf) and (G.Difficulty[me]>0)
    and (1 shl pView and MyRO.Alive<>0);
  if Mode=mSelf then
    begin // paint rates section
    if MyRO.Wonder[woMich].EffectiveOwner=me then ShowLuxRate:=0
    else ShowLuxRate:=MyRO.LuxRate;
    s:=Phrases.Lookup('FRRATES');
    RisedTextOut(Canvas,InnerWidth-12-Canvas.TextWidth(s),5,s);
    Frame(Canvas,xRates-1,yRates-1,xRates+180,yRates+7,$000000,$000000);
    RFrame(Canvas,xRates-2,yRates-2,xRates+181,yRates+8,InnerTex.clBevelShade,
      InnerTex.clBevelLight);
    for i:=0 to 9 do
      begin
      if 10*i<MyRO.TaxRate then Kind:=0 // tax
      else if 10*i<MyRO.TaxRate+ShowLuxRate then Kind:=5 //luxury
      else Kind:=2; // science
      Dump(Offscreen,HGrSystem,xRates+18*i,yRates,8,7,104,9+8*Kind);
      Dump(Offscreen,HGrSystem,xRates+8+18*i,yRates,8,7,104,9+8*Kind);
      Dump(Offscreen,HGrSystem,xRates+16+18*i,yRates,2,7,104,9+8*Kind);
      end;
    Frame(Canvas,xRates-1+18*(MyRO.TaxRate div 10),yRates-1,
      xRates+18*((ShowLuxRate+MyRO.TaxRate) div 10),yRates+7,$000000,$000000);
    s:=Format('%d%%',[MyRO.TaxRate]);
    RisedTextOut(Canvas,xRates+4,yRates-12,s);
    s:=Format('%d%%',[ShowLuxRate]);
    RisedTextOut(Canvas,xRates+90-Canvas.TextWidth(s) div 2,yRates-12,s);
    s:=Format('%d%%',[100-MyRO.TaxRate-ShowLuxRate]);
    RisedTextOut(Canvas,xRates+180-4-Canvas.TextWidth(s),yRates-12,s);
    s:=Phrases.Lookup('TAX');
    LoweredTextOut(Canvas,-1,InnerTex,xRates-30,yRates-28,s);
    s:=Phrases.Lookup('LUX');
    LoweredTextOut(Canvas,-1,InnerTex,xRates+90-Canvas.TextWidth(s) div 2,yRates-28,s);
    s:=Phrases.Lookup('SCIENCE');
    LoweredTextOut(Canvas,-1,InnerTex,xRates+180+30-Canvas.TextWidth(s),yRates-28,s);
    s:=IntToStr(TaxSum);
    if TaxSum>=0 then s:='+'+s;
    LoweredTextOut(Canvas,-1,InnerTex,xRates-29,yRates+10,s);
    Sprite(Offscreen,HGrSystem,xRates-28+Canvas.TextWidth(s),yRates+10+5,10,10,132,115);
    Sprite(Offscreen,HGrSystem,xRates+86,yRates+10+5,10,10,154,115);
    s:='+'+IntToStr(ScienceSum);
    LoweredTextOut(Canvas,-1,InnerTex,xRates+180+21-Canvas.TextWidth(s),yRates+10,s);
    Sprite(Offscreen,HGrSystem,xRates+180+22,yRates+10+5,10,10,77,126);
    end
  else if (1 shl pView and MyRO.Alive=0) then
    RisedTextOut(Canvas,130+8,4,Phrases.Lookup('FREXTINCT'))
  else if ContactEnabled then
    begin
    Dump(offscreen,HGrSystem,130+12,26,14,14,67+15*MyRO.Treaty[pView],100);
    LoweredTextOut(Canvas,-1,InnerTex,130+30,24,
      Phrases.Lookup('ATTITUDE',Report.Attitude));
    if Report.TurnOfContact>=0 then
      begin
      RisedTextOut(Canvas,130+8,4,Phrases.Lookup('FRLASTCONTACT')+' '
        +TurnToString(Report.TurnOfContact));
      if MyRO.Tribute[pView]<>0 then
        begin
        CountBar(offscreen,130+11,43,6,Phrases.Lookup('FRPAYTRIBUTE'),
          abs(MyRO.Tribute[pView]),InnerTex);
        Fill(Canvas,130+142+32,43,39,16,0,0,InnerTex);
        if MyRO.TributePaid[pView]<>MyRO.Tribute[pView] then
          s:=Format(Phrases.Lookup('FRREALTRIBUTE'),[MyRO.TributePaid[pView],
            MyRO.Tribute[pView]])