unitstat.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit UnitStat;

interface

uses
  Protocol,ClientTools,Term,ScreenTools,BaseWin,

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

type
  TUnitStatDlg = class(TBaseDlg)
    SwitchBtn: TButtonB;
    OKBtn: TButtonA;
    CloseBtn: TButtonB;
    ConscriptsBtn: TButtonB;
    procedure FormShow(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ModelBoxChange(Sender: TObject);
    procedure SwitchBtnClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word;
      Shift: TShiftState);
    procedure ConscriptsBtnClick(Sender: TObject);
  public
    mix: integer; // for own models
    Kind:(dkOK,dkInfo,dkEnemy);
    mox: ^TModelInfo; // for enemy models
    procedure ShowNow;
  protected
    procedure OffscreenPaint; override;
  end;

var
  UnitStatDlg: TUnitStatDlg;

implementation

uses Inp, Select, Tribes;

{$R *.DFM}

const
xView=13; yView=31;
xStat=99; yStat=118;
xTotal=99; yTotal=6;

procedure TUnitStatDlg.FormShow(Sender: TObject);
begin
WideBottom:= Kind=dkOK;
case Kind of
  dkOK: InnerHeight:=120;
  dkInfo: InnerHeight:=200;
  dkEnemy: InnerHeight:=139;
  end;
if WideBottom then ClientHeight:=InnerHeight+2*WideFrame
else ClientHeight:=InnerHeight+(WideFrame+NarrowFrame);
if Kind=dkOK then
  begin Left:=(Screen.Width-Width) div 2; Top:=(Screen.Height-Height) div 2; end
else begin Left:=Screen.Width-Width-8; Top:=8; end;
OKBtn.Visible:= Kind=dkOK;
CloseBtn.Visible:= Kind<>dkOK;
SwitchBtn.Visible:= Kind=dkInfo;
ConscriptsBtn.Visible:= (Kind=dkInfo) and (MyRO.Tech[adConscription]>=tsApplicable)
  and (MyModel[mix].Domain=dGround) and (MyModel[mix].Kind<mkScout);
OKBtn.Top:=ClientHeight-31;
if Kind=dkEnemy then
  if MainScreen.mNames.Checked then Caption:=Tribe[mox.Owner].ModelName[mox.mix]
  else Caption:=Format(Tribe[mox.Owner].TPhrase('GENMODEL'),[mox.mix])
else Caption:=Tribe[me].ModelName[mix];
OffscreenPaint;
end;

procedure TUnitStatDlg.ShowNow;
begin
if Visible then begin FormShow(nil); Invalidate end else Show
end;

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

procedure TUnitStatDlg.FormCreate(Sender: TObject);
begin
inherited;
WideBottom:=true;
CaptionRight:=CloseBtn.Left;
InnerHeight:=ClientHeight-2*WideFrame;
InitButtons(self);
end;

procedure TUnitStatDlg.FormPaint(Sender: TObject);
begin
inherited;
if CloseBtn.Visible then BtnFrame(Canvas,CloseBtn.BoundsRect,OuterTex);
if OKBtn.Visible then BtnFrame(Canvas,OKBtn.BoundsRect,OuterTex);
if SwitchBtn.Visible then BtnFrame(Canvas,SwitchBtn.BoundsRect,InnerTex);
if ConscriptsBtn.Visible then BtnFrame(Canvas,ConscriptsBtn.BoundsRect,InnerTex);
end;

procedure TUnitStatDlg.OffscreenPaint;
var
PPicture: ^TModelPicture;

  function IsToCount(emix: integer): boolean;
  var
  PTestPicture: ^TModelPicture;
  begin
  if MainScreen.mNames.Checked then
    begin
    PTestPicture:=@Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture[MyRO.EnemyModel[emix].mix];
    result:= (PPicture.HGr=PTestPicture.HGr) and (PPicture.pix=PTestPicture.pix)
      and (ModelHash(mox^)=ModelHash(MyRO.EnemyModel[emix]))
    end
  else result:= (MyRO.EnemyModel[emix].Owner=mox.Owner)
    and (MyRO.EnemyModel[emix].mix=mox.mix)
  end;

  procedure FeatureBar(dst: TBitmap; x,y: integer; const mi: TModelInfo;
    const T: TTexture);
  var
  i,w,dx,num: integer;
  s: string;
  begin
  DarkGradient(dst.Canvas,x-6,y+1,179,1);
  with dst.Canvas do
    if mi.Kind>=$10 then
      begin
      s:=Phrases.Lookup('UNITSPECIAL');
      Font.Color:=$000000;
      Textout(x-1,y+1,s);
      Font.Color:=$B0B0B0;
      Textout(x-2,y,s);
      end
    else
      begin
      Font.Color:=$000000;
      dx:=2;
      for i:=3 to nFeature-1 do
        begin
        num:=0;
        case i of
          mcSeaTrans: if mi.Domain=dSea then num:=mi.TTrans;
          mcCarrier: if mi.Domain=dSea then num:=mi.ATrans_Fuel;
          mcBombs: num:=mi.Bombs;
          mcFuel: if mi.Domain=dAir then num:=mi.ATrans_Fuel;
          mcAirTrans: if mi.Domain=dAir then num:=mi.TTrans;
          mcFirstNonCap..nFeature-1:
            if mi.Cap and (1 shl (i-mcFirstNonCap))<>0 then num:=1
          end;
        if (num>0) and ((i<>mcSE) or (mi.Cap and (1 shl (mcNP-mcFirstNonCap))=0)) then
          begin
          if num>1 then
            begin
            s:=IntToStr(num);
            w:=TextWidth(s);
            Brush.Color:=$FFFFFF;
            FillRect(Rect(x-3+dx,y+2,x+w-1+dx,y+16));
            Brush.Style:=bsClear;
            Textout(x-3+dx+1,y,s);
            inc(dx,w+1)
            end;
          Brush.Color:=$C0C0C0;
          FrameRect(Rect(x-3+dx,y+2,x+11+dx,y+16));
          Brush.Style:=bsClear;
          Sprite(dst,HGrSystem,x-1+dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11);
          inc(dx,15)
          end;
        end
      end
  end;{featurebar}

var
cix,uix,emix,InProd,Available,Destroyed,Loc,Cnt: integer;
s: string;
mi: TModelInfo;
begin
inherited;

if Kind=dkEnemy then
  begin
  PPicture:=@Tribe[mox.Owner].ModelPicture[mox.mix];
  Available:=0;
  if G.Difficulty[me]=0 then // supervisor -- count stacked units too
    for Loc:=0 to G.lx*G.ly-1 do
      begin
      if MyMap[Loc] and fUnit<>0 then
        begin
        Server(sGetUnits,me,Loc,Cnt);
        for uix:=0 to Cnt-1 do
          if IsToCount(MyRO.EnemyUn[MyRO.nEnemyUn+uix].emix) then
            inc(Available);
        end
      end
  else // no supervisor -- can only count stack top units
    for uix:=0 to MyRO.nEnemyUn-1 do
      if (MyRO.EnemyUn[uix].Loc>=0) and IsToCount(MyRO.EnemyUn[uix].emix) then
        inc(Available);
  Destroyed:=0;
  for emix:=0 to MyRO.nEnemyModel-1 do if IsToCount(emix) then
    inc(Destroyed,MyRO.EnemyModel[emix].Lost);
  end
else
  begin
  Available:=0;
  for uix:=0 to MyRO.nUn-1 do
    if (MyUn[uix].Loc>=0) and (MyUn[uix].mix=mix) then inc(Available);
  InProd:=0;
  for cix:=0 to MyRO.nCity-1 do
    if (MyCity[cix].Loc>=0) and (MyCity[cix].Project and (cpImp+cpIndex)=mix) then
      inc(InProd);
  end;

Fill(offscreen.Canvas,0,0,InnerWidth,InnerHeight,0,0,InnerTex);
if Kind=dkEnemy then mi:=mox^
else MakeModelInfo(me,mix,MyModel[mix],mi);
with Tribe[mi.Owner].ModelPicture[mi.mix] do
  begin
  if Kind=dkOK then
    begin
    offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
    s:=Phrases.Lookup('MODELAVAILABLE');
    RisedTextout(offscreen.canvas,
      (InnerWidth-offscreen.canvas.TextWidth(s)) div 2,92,s);
    end;
  offscreen.Canvas.Font.Assign(UniFont[ftSmall]);

  FrameImage(offscreen.canvas,BigImp,xView+4,yView+4,56,40,0,0);
  Sprite(offscreen,HGr,xView,yView,64,44,pix mod 10 *65+1,pix div 10*49+1);

  DarkGradient(offscreen.Canvas,xTotal-6,yTotal+1,179,2);
  RisedTextOut(offscreen.Canvas,xTotal-2,yTotal,Phrases.Lookup('UNITSTRENGTH'));
  s:=IntToStr(mi.Attack)+'/'+IntToStr(mi.Defense);
  RisedTextOut(offscreen.Canvas,xTotal+170-offscreen.Canvas.TextWidth(s),yTotal,s);
  FeatureBar(offscreen,xTotal,yTotal+19,mi,InnerTex);
  NumberBar(offscreen,xTotal,yTotal+38,Phrases.Lookup('UNITSPEED'),mi.Speed,InnerTex);
  LoweredTextOut(offscreen.Canvas,-1,InnerTex,xTotal-2,yTotal+57,Phrases.Lookup('UNITCOST'));
  DLine(offscreen.Canvas,xTotal-2,xTotal+169,yTotal+57+16,
    InnerTex.clBevelShade,InnerTex.clBevelLight);
  s:=IntToStr(mi.cost);
  RisedTextout(offscreen.Canvas,xTotal+158-offscreen.Canvas.TextWidth(s),yTotal+57,s);
  Sprite(offscreen,HGrSystem,xTotal+160,yTotal+57+4,10,10,88,115);

  if Kind=dkInfo then
    begin
    if MyModel[mix].IntroTurn>0 then
      begin
      if MyModel[mix].Kind=mkEnemyDeveloped then
        LoweredTextOut(offscreen.Canvas,-1,InnerTex,xStat-2,(yStat-19),Phrases.Lookup('UNITADOPT'))
      else LoweredTextOut(offscreen.Canvas,-1,InnerTex,xStat-2,(yStat-19),Phrases.Lookup('UNITINTRO'));
      DLine(offscreen.Canvas,xStat-2,xStat+169,(yStat-19)+16,
        InnerTex.clTextShade,InnerTex.clTextLight);
      s:=TurnToString(MyModel[mix].IntroTurn);
      RisedTextOut(offscreen.Canvas,xStat+170-offscreen.Canvas.TextWidth(s),(yStat-19),s);
      end;

    NumberBar(offscreen,xStat,yStat,Phrases.Lookup('UNITBUILT'),MyModel[mix].Built,InnerTex);
    if MyModel[mix].Lost>0 then
      NumberBar(offscreen,xStat,yStat+19,Phrases.Lookup('UNITLOST'),MyModel[mix].Lost,InnerTex);
    if InProd>0 then
      NumberBar(offscreen,xStat,yStat+57,Phrases.Lookup('UNITINPROD'),InProd,InnerTex);
    if Available>0 then
      NumberBar(offscreen,xStat,yStat+38,Phrases.Lookup('UNITAVAILABLE'),Available,InnerTex);

    if MyModel[mix].Status and msObsolete<>0 then
      begin
      SwitchBtn.ButtonIndex:=12;
      SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE');
      end
    else
      begin
      SwitchBtn.ButtonIndex:=11;
      SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE');
      end;
    if MyModel[mix].Status and msAllowConscripts=0 then
      begin
      ConscriptsBtn.ButtonIndex:=30;
      ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS');
      end
    else
      begin
      ConscriptsBtn.ButtonIndex:=29;
      ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS');
      end
    end
  else if Kind=dkEnemy then
    begin
    if Destroyed>0 then
      NumberBar(offscreen,xStat,yTotal+88,Phrases.Lookup('UNITDESTROYED'),Destroyed,InnerTex);
    if Available>0 then
      NumberBar(offscreen,xStat,yTotal+107,Phrases.Lookup('UNITKNOWN'),Available,InnerTex);
    end
  end;

MarkUsedOffscreen(InnerWidth,InnerHeight);
end; {OffscreenPaint}

procedure TUnitStatDlg.ModelBoxChange(Sender: TObject);
begin
OffscreenPaint;
SmartInvalidate;
end;

procedure TUnitStatDlg.SwitchBtnClick(Sender: TObject);
begin
MyModel[mix].Status:=MyModel[mix].Status xor msObsolete;
if MyModel[mix].Status and msObsolete<>0 then
  begin
  SwitchBtn.ButtonIndex:=12;
  SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE');
  end
else
  begin
  SwitchBtn.ButtonIndex:=11;
  SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE');
  end
end;

procedure TUnitStatDlg.ConscriptsBtnClick(Sender: TObject);
begin
MyModel[mix].Status:=MyModel[mix].Status xor msAllowConscripts;
if MyModel[mix].Status and msAllowConscripts=0 then
  begin
  ConscriptsBtn.ButtonIndex:=30;
  ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS');
  end
else
  begin
  ConscriptsBtn.ButtonIndex:=29;
  ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS');
  end
end;

procedure TUnitStatDlg.FormDeactivate(Sender: TObject);
begin
if Kind<>dkOK then Close
end;

procedure TUnitStatDlg.FormKeyDown(Sender: TObject; var Key: word;
  Shift: TShiftState);
begin
if (Key=13) and (Kind=dkOK) then Close;
end;

end.