Changeset 6 for trunk/LocalPlayer/Draft.pas
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/Draft.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Draft; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,PVSB,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,ButtonA, 7 Protocol, ClientTools, Term, ScreenTools, PVSB, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 11 ButtonB, ButtonBase, Area; 12 12 … … 28 28 procedure FormDestroy(Sender: TObject); 29 29 public 30 procedure ShowNewContent(NewMode: integer); 30 procedure ShowNewContent(NewMode: integer); 31 31 protected 32 32 procedure OffscreenPaint; override; 33 33 private 34 Domain, MaxLines,Lines,Cut,yDomain,yFeature,yWeight,yTotal,yView,IncCap,35 DecCap: integer;36 code: array [0..nFeature-1] of integer;37 Template, Back: TBitmap;38 function IsFeatureInList(d, i: integer): boolean;34 Domain, MaxLines, Lines, Cut, yDomain, yFeature, yWeight, yTotal, yView, 35 IncCap, DecCap: integer; 36 code: array [0 .. nFeature - 1] of integer; 37 Template, Back: TBitmap; 38 function IsFeatureInList(d, i: integer): boolean; 39 39 procedure SetDomain(d: integer); 40 40 end; … … 45 45 implementation 46 46 47 uses Help, Tribes,Directories;47 uses Help, Tribes, Directories; 48 48 49 49 {$R *.DFM} 50 50 51 51 const 52 MaxLines0=11; LinePitch=20; 53 xDomain=30; yDomain0=464; DomainPitch=40; 54 xFeature=38; yFeature0=42; 55 xWeight=100; yWeight0=271; 56 xTotal=20; xTotal2=34; yTotal0=354; 57 xView=17; yView0=283; 52 MaxLines0 = 11; 53 LinePitch = 20; 54 xDomain = 30; 55 yDomain0 = 464; 56 DomainPitch = 40; 57 xFeature = 38; 58 yFeature0 = 42; 59 xWeight = 100; 60 yWeight0 = 271; 61 xTotal = 20; 62 xTotal2 = 34; 63 yTotal0 = 354; 64 xView = 17; 65 yView0 = 283; 58 66 59 67 procedure TDraftDlg.FormCreate(Sender: TObject); 60 68 begin 61 inherited;62 InitButtons();63 HelpContext:='CLASSES';64 Caption:=Phrases.Lookup('TITLE_DRAFT');65 OKBtn.Caption:=Phrases.Lookup('BTN_OK');66 67 if not Phrases2FallenBackToEnglish then68 begin 69 GroundArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',0);70 SeaArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',1);71 AirArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',2);69 inherited; 70 InitButtons(); 71 HelpContext := 'CLASSES'; 72 Caption := Phrases.Lookup('TITLE_DRAFT'); 73 OKBtn.Caption := Phrases.Lookup('BTN_OK'); 74 75 if not Phrases2FallenBackToEnglish then 76 begin 77 GroundArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 0); 78 SeaArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 1); 79 AirArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 2); 72 80 end 73 else 74 begin 75 GroundArea.Hint:=Phrases.Lookup('DOMAIN',0); 76 SeaArea.Hint:=Phrases.Lookup('DOMAIN',1); 77 AirArea.Hint:=Phrases.Lookup('DOMAIN',2); 78 end; 79 80 Back:=TBitmap.Create; 81 Back.PixelFormat:=pf24bit; 82 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 83 Template:=TBitmap.Create; 84 LoadGraphicFile(Template, HomeDir+'Graphics\MiliRes', gfNoGamma); 85 Template.PixelFormat:=pf8bit; 81 else 82 begin 83 GroundArea.Hint := Phrases.Lookup('DOMAIN', 0); 84 SeaArea.Hint := Phrases.Lookup('DOMAIN', 1); 85 AirArea.Hint := Phrases.Lookup('DOMAIN', 2); 86 end; 87 88 Back := TBitmap.Create; 89 Back.PixelFormat := pf24bit; 90 Back.Width := ClientWidth; 91 Back.Height := ClientHeight; 92 Template := TBitmap.Create; 93 LoadGraphicFile(Template, HomeDir + 'Graphics\MiliRes', gfNoGamma); 94 Template.PixelFormat := pf8bit; 86 95 end; 87 96 88 97 procedure TDraftDlg.FormDestroy(Sender: TObject); 89 98 begin 90 Template.Free;99 Template.Free; 91 100 end; 92 101 93 102 procedure TDraftDlg.CloseBtnClick(Sender: TObject); 94 103 begin 95 ModalResult:=mrCancel;104 ModalResult := mrCancel; 96 105 end; 97 106 … … 100 109 function DomainAvailable(d: integer): boolean; 101 110 begin 102 result:=(upgrade[d,0].Preq=preNone)103 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable);111 result := (upgrade[d, 0].Preq = preNone) or 112 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable); 104 113 end; 105 114 106 115 procedure PaintTotalBars; 107 116 var 108 i,y,dx,num,w: integer; 109 s: string; 110 begin 111 with offscreen.Canvas do 112 begin 113 // strength bar 114 y:=yTotal; 115 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,2); 116 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,2); 117 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITSTRENGTH')); 118 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MStrength)); 119 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 120 s:=IntToStr(MyRO.DevModel.Attack)+'/'+IntToStr(MyRO.DevModel.Defense); 121 RisedTextOut(Offscreen.Canvas,xTotal2+170+64+30-BiColorTextWidth(Offscreen.Canvas,s),y,s); 122 123 // transport bar 124 if MyRO.DevModel.MTrans>0 then 117 i, y, dx, num, w: integer; 118 s: string; 119 begin 120 with offscreen.Canvas do 121 begin 122 // strength bar 123 y := yTotal; 124 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 2); 125 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 2); 126 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 127 Phrases.Lookup('UNITSTRENGTH')); 128 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 129 'x' + IntToStr(MyRO.DevModel.MStrength)); 130 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 131 s := IntToStr(MyRO.DevModel.Attack) + '/' + 132 IntToStr(MyRO.DevModel.Defense); 133 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 134 BiColorTextWidth(offscreen.Canvas, s), y, s); 135 136 // transport bar 137 if MyRO.DevModel.MTrans > 0 then 125 138 begin 126 y:=yTotal+19; 127 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,1); 128 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,1); 129 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITTRANSPORT')); 130 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MTrans)); 131 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 132 133 Font.Color:=$000000; 134 dx:=-237-30; 135 for i:=mcFirstNonCap-1 downto 3 do 136 if i in [mcSeaTrans,mcCarrier,mcAirTrans] then 139 y := yTotal + 19; 140 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 1); 141 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 1); 142 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 143 Phrases.Lookup('UNITTRANSPORT')); 144 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 145 'x' + IntToStr(MyRO.DevModel.MTrans)); 146 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 147 148 Font.Color := $000000; 149 dx := -237 - 30; 150 for i := mcFirstNonCap - 1 downto 3 do 151 if i in [mcSeaTrans, mcCarrier, mcAirTrans] then 137 152 begin 138 num:=MyRO.DevModel.Cap[i]*MyRO.DevModel.MTrans;139 if num>0 then153 num := MyRO.DevModel.Cap[i] * MyRO.DevModel.MTrans; 154 if num > 0 then 140 155 begin 141 inc(dx,15); 142 Brush.Color:=$C0C0C0; 143 FrameRect(Rect(xTotal2-3-dx,y+2,xTotal2+11-dx,y+16)); 144 Brush.Style:=bsClear; 145 Sprite(Offscreen,HGrSystem,xTotal2-1-dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11); 146 if num>1 then 156 inc(dx, 15); 157 Brush.Color := $C0C0C0; 158 FrameRect(Rect(xTotal2 - 3 - dx, y + 2, 159 xTotal2 + 11 - dx, y + 16)); 160 Brush.Style := bsClear; 161 Sprite(offscreen, HGrSystem, xTotal2 - 1 - dx, y + 4, 10, 10, 162 66 + i mod 11 * 11, 137 + i div 11 * 11); 163 if num > 1 then 147 164 begin 148 s:=IntToStr(num); 149 w:=TextWidth(s); 150 inc(dx,w+1); 151 Brush.Color:=$FFFFFF; 152 FillRect(Rect(xTotal2-3-dx,y+2,xTotal2+w-1-dx,y+16)); 153 Brush.Style:=bsClear; 154 Textout(xTotal2-3-dx+1,y,s); 165 s := IntToStr(num); 166 w := TextWidth(s); 167 inc(dx, w + 1); 168 Brush.Color := $FFFFFF; 169 FillRect(Rect(xTotal2 - 3 - dx, y + 2, 170 xTotal2 + w - 1 - dx, y + 16)); 171 Brush.Style := bsClear; 172 Textout(xTotal2 - 3 - dx + 1, y, s); 155 173 end; 156 174 end; … … 158 176 end; 159 177 160 // speed bar 161 y:=yTotal+38; 162 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITSPEED')); 163 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 164 MainTexture.clBevelLight); 165 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 166 MainTexture.clBevelLight); 167 s:=MovementToString(MyRO.DevModel.Speed); 168 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-TextWidth(s),y,s); 169 170 // cost bar 171 y:=yTotal+57; 172 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITCOST')); 173 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MCost)); 174 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 175 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 176 MainTexture.clBevelLight); 177 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 178 MainTexture.clBevelLight); 179 s:=IntToStr(MyRO.DevModel.Cost); 180 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 181 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 182 183 if G.Difficulty[me]<>2 then 178 // speed bar 179 y := yTotal + 38; 180 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 181 Phrases.Lookup('UNITSPEED')); 182 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 183 MainTexture.clBevelShade, MainTexture.clBevelLight); 184 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 185 MainTexture.clBevelShade, MainTexture.clBevelLight); 186 s := MovementToString(MyRO.DevModel.Speed); 187 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 188 TextWidth(s), y, s); 189 190 // cost bar 191 y := yTotal + 57; 192 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 193 Phrases.Lookup('UNITCOST')); 194 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, y, 195 'x' + IntToStr(MyRO.DevModel.MCost)); 196 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 197 xTotal2 + 148 + 30, y, '='); 198 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 199 MainTexture.clBevelShade, MainTexture.clBevelLight); 200 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 201 MainTexture.clBevelShade, MainTexture.clBevelLight); 202 s := IntToStr(MyRO.DevModel.Cost); 203 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 204 TextWidth(s), y, s); 205 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 206 10, 88, 115); 207 208 if G.Difficulty[me] <> 2 then 184 209 begin // corrected cost bar 185 y:=yTotal+76; 186 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y, 187 Phrases.Lookup('COSTDIFF'+char(48+G.Difficulty[me]))); 188 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 189 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 190 MainTexture.clBevelLight); 191 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 192 MainTexture.clBevelLight); 193 s:=IntToStr(MyRO.DevModel.Cost*BuildCostMod[G.Difficulty[me]] div 12); 194 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 195 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 210 y := yTotal + 76; 211 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 212 Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[me]))); 213 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 214 xTotal2 + 148 + 30, y, '='); 215 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 216 MainTexture.clBevelShade, MainTexture.clBevelLight); 217 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 218 MainTexture.clBevelShade, MainTexture.clBevelLight); 219 s := IntToStr(MyRO.DevModel.Cost * BuildCostMod 220 [G.Difficulty[me]] div 12); 221 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 222 TextWidth(s), y, s); 223 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 224 10, 88, 115); 196 225 end; 197 226 end; … … 199 228 200 229 var 201 i,j,x,d,n,TextColor,CapWeight,DomainCount: integer; 202 begin 203 inherited; 204 205 ClientHeight:=Template.Height-Cut; 206 if ClientHeight>hMainTexture then // assemble background from 2 texture tiles 207 begin 208 bitblt(Back.Canvas.Handle,0,0,ClientWidth,64,MainTexture.Image.Canvas.Handle, 209 (wMainTexture-ClientWidth) div 2,hMainTexture-64,SRCCOPY); 210 bitblt(Back.Canvas.Handle,0,64,ClientWidth,ClientHeight-64, 211 MainTexture.Image.Canvas.Handle,(wMainTexture-ClientWidth) div 2,0,SRCCOPY); 230 i, j, x, d, n, TextColor, CapWeight, DomainCount: integer; 231 begin 232 inherited; 233 234 ClientHeight := Template.Height - Cut; 235 if ClientHeight > hMainTexture then 236 // assemble background from 2 texture tiles 237 begin 238 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, 64, 239 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 240 hMainTexture - 64, SRCCOPY); 241 bitblt(Back.Canvas.Handle, 0, 64, ClientWidth, ClientHeight - 64, 242 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 243 0, SRCCOPY); 212 244 end 213 else bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,MainTexture.Image.Canvas.Handle, 214 (wMainTexture-ClientWidth) div 2,(hMainTexture-ClientHeight) div 2,SRCCOPY); 215 ImageOp_B(Back,Template,0,0,0,0,Template.Width,64); 216 ImageOp_B(Back,Template,0,64,0,64+Cut,Template.Width,Template.Height-64-Cut); 217 218 bitblt(offscreen.canvas.handle,0,0,ClientWidth,ClientHeight,Back.Canvas.handle,0,0,SRCCOPY); 219 220 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 221 RisedTextout(offscreen.Canvas,10,7,Caption); 222 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 223 224 with MyRO.DevModel do 225 begin 226 DomainCount:=0; 227 for d:=0 to nDomains-1 do 228 if DomainAvailable(d) then 229 inc(DomainCount); 230 if DomainCount>1 then 231 begin 232 for d:=0 to nDomains-1 do 245 else 246 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 247 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 248 (hMainTexture - ClientHeight) div 2, SRCCOPY); 249 ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64); 250 ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width, 251 Template.Height - 64 - Cut); 252 253 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 254 Back.Canvas.Handle, 0, 0, SRCCOPY); 255 256 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 257 RisedTextOut(offscreen.Canvas, 10, 7, Caption); 258 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 259 260 with MyRO.DevModel do 261 begin 262 DomainCount := 0; 263 for d := 0 to nDomains - 1 do 233 264 if DomainAvailable(d) then 265 inc(DomainCount); 266 if DomainCount > 1 then 267 begin 268 for d := 0 to nDomains - 1 do 269 if DomainAvailable(d) then 234 270 begin 235 x:=xDomain+d*DomainPitch; 236 if d=Domain then 237 ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$00C0FF) 238 else ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$606060); 271 x := xDomain + d * DomainPitch; 272 if d = Domain then 273 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 274 36, 0, $00C0FF) 275 else 276 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 277 36, 0, $606060); 239 278 end; 240 Frame(Offscreen.Canvas,xDomain-11,yDomain-3,xDomain+2*DomainPitch+46,241 yDomain+38,$B0B0B0,$FFFFFF);242 RFrame(Offscreen.Canvas,xDomain-12,yDomain-4,xDomain+2*DomainPitch+47,243 yDomain+39,$FFFFFF,$B0B0B0);244 end; 245 GroundArea.Top:=yDomain;246 GroundArea.Visible:=DomainAvailable(dGround);247 SeaArea.Top:=yDomain;248 SeaArea.Visible:=DomainAvailable(dSea);249 AirArea.Top:=yDomain;250 AirArea.Visible:=DomainAvailable(dAir);251 252 PaintTotalBars;253 254 // display weight255 with offscreen.Canvas do256 begin 257 for i:=0 to MaxWeight-1 do258 if i<Weight then259 ImageOp_BCC(Offscreen,Templates,xWeight+20*i,260 yWeight,123,400,18,20,0,$949494)261 else ImageOp_BCC(Offscreen,Templates,xWeight+20*i,262 yWeight,105,400,18,20,0,$949494);263 end;264 265 with offscreen.Canvas do for i:=0 to Lines-1 do 266 begin267 if not (code[i] in AutoFeature) then279 Frame(offscreen.Canvas, xDomain - 11, yDomain - 3, 280 xDomain + 2 * DomainPitch + 46, yDomain + 38, $B0B0B0, $FFFFFF); 281 RFrame(offscreen.Canvas, xDomain - 12, yDomain - 4, 282 xDomain + 2 * DomainPitch + 47, yDomain + 39, $FFFFFF, $B0B0B0); 283 end; 284 GroundArea.Top := yDomain; 285 GroundArea.Visible := DomainAvailable(dGround); 286 SeaArea.Top := yDomain; 287 SeaArea.Visible := DomainAvailable(dSea); 288 AirArea.Top := yDomain; 289 AirArea.Visible := DomainAvailable(dAir); 290 291 PaintTotalBars; 292 293 // display weight 294 with offscreen.Canvas do 295 begin 296 for i := 0 to MaxWeight - 1 do 297 if i < Weight then 298 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 123, 400, 299 18, 20, 0, $949494) 300 else 301 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 105, 400, 302 18, 20, 0, $949494); 303 end; 304 305 with offscreen.Canvas do 306 for i := 0 to Lines - 1 do 268 307 begin 269 // paint +/- butttons 270 if code[i]<mcFirstNonCap then 308 if not(code[i] in AutoFeature) then 271 309 begin 272 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i, 273 12,12,169,172); 274 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 275 12,12,169,159); 276 RFrame(offscreen.Canvas,xFeature-(21+1),yFeature+2+LinePitch*i-1, 277 xFeature-(21-24),yFeature+2+LinePitch*i+12, 278 MainTexture.clBevelShade,MainTexture.clBevelLight); 279 end 280 else 281 begin 282 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 283 12,12,169,185+13*MyRO.DevModel.Cap[code[i]]); 284 RFrame(offscreen.Canvas,xFeature-(9+1),yFeature+2+LinePitch*i-1, 285 xFeature-(21-24),yFeature+2+LinePitch*i+12, 286 MainTexture.clBevelShade,MainTexture.clBevelLight); 287 end; 288 289 // paint cost 290 LightGradient(offscreen.Canvas,xFeature+34,yFeature+LinePitch*i,50, 291 GrExt[HGrSystem].Data.Canvas.Pixels[187,137]); 292 if (Domain=dGround) and (code[i]=mcDefense) then CapWeight:=2 293 else CapWeight:=Feature[code[i]].Weight; 294 n:=CapWeight+Feature[code[i]].Cost; 295 d:=6; 296 while (n-1)*d*2>48-10 do dec(d); 297 for j:=0 to n-1 do 298 if j<CapWeight then 299 Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 300 yFeature+2+LinePitch*i+1,10,10,88,126) 301 else Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 302 yFeature+2+LinePitch*i+1,10,10,88,115); 303 end; // if not (code[i] in AutoFeature) 304 DarkGradient(offscreen.Canvas,xFeature+17,yFeature+LinePitch*i,16,1); 305 Frame(offscreen.canvas,xFeature+18,yFeature+1+LinePitch*i, 306 xFeature+20-2+13,yFeature+2+1-2+13+LinePitch*i,$C0C0C0,$C0C0C0); 307 Sprite(offscreen,HGrSystem,xFeature+20,yFeature+2+1+LinePitch*i, 308 10,10,66+code[i] mod 11 *11,137+code[i] div 11 *11); 309 310 if MyRO.DevModel.Cap[code[i]]>0 then TextColor:=MainTexture.clLitText 311 else TextColor:=-1; 312 313 if code[i]<mcFirstNonCap then 314 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+7, 315 yFeature+LinePitch*i-1,IntToStr(MyRO.DevModel.Cap[code[i]])); 316 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+88, 317 yFeature+LinePitch*i-1,Phrases.Lookup('FEATURES',code[i])); 318 end; 319 end; 320 321 // free features 322 j:=0; 323 for i:=0 to nFeature-1 do 324 if (i in AutoFeature) 325 and (1 shl Domain and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 326 and ((Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 327 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)) 328 and not ((Feature[i].Preq=adSteamEngine) 329 and (MyRO.Tech[adNuclearPower]>=tsApplicable)) then 330 begin 331 DarkGradient(offscreen.Canvas,xWeight+4,yWeight+32+LinePitch*j,16,1); 332 Frame(offscreen.canvas,xWeight+5,yWeight+33+LinePitch*j, 333 xWeight+18,yWeight+47+LinePitch*j,$C0C0C0,$C0C0C0); 334 Sprite(offscreen,HGrSystem,xWeight+7,yWeight+36+LinePitch*j, 335 10,10,66+i mod 11 *11,137+i div 11 *11); 336 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xWeight+26, 337 yWeight+31+LinePitch*j,Phrases.Lookup('FEATURES',i)); 338 inc(j); 339 end; 340 341 with Tribe[me].ModelPicture[MyRO.nModel] do 342 begin 343 FrameImage(offscreen.canvas,BigImp,xView+4,yView+4,xSizeBig,ySizeBig,0,0); 344 Sprite(offscreen,HGr,xView,yView,64,44,pix mod 10 *65+1,pix div 10*49+1); 345 end; 346 MarkUsedOffscreen(ClientWidth,ClientHeight); 347 end;{MainPaint} 310 // paint +/- butttons 311 if code[i] < mcFirstNonCap then 312 begin 313 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 314 i, 12, 12, 169, 172); 315 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 316 i, 12, 12, 169, 159); 317 RFrame(offscreen.Canvas, xFeature - (21 + 1), 318 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 319 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 320 MainTexture.clBevelLight); 321 end 322 else 323 begin 324 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 325 i, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 326 RFrame(offscreen.Canvas, xFeature - (9 + 1), 327 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 328 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 329 MainTexture.clBevelLight); 330 end; 331 332 // paint cost 333 LightGradient(offscreen.Canvas, xFeature + 34, 334 yFeature + LinePitch * i, 50, GrExt[HGrSystem].Data.Canvas.Pixels 335 [187, 137]); 336 if (Domain = dGround) and (code[i] = mcDefense) then 337 CapWeight := 2 338 else 339 CapWeight := Feature[code[i]].Weight; 340 n := CapWeight + Feature[code[i]].Cost; 341 d := 6; 342 while (n - 1) * d * 2 > 48 - 10 do 343 dec(d); 344 for j := 0 to n - 1 do 345 if j < CapWeight then 346 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 347 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 126) 348 else 349 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 350 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 115); 351 end; // if not (code[i] in AutoFeature) 352 DarkGradient(offscreen.Canvas, xFeature + 17, 353 yFeature + LinePitch * i, 16, 1); 354 Frame(offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * i, 355 xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * i, 356 $C0C0C0, $C0C0C0); 357 Sprite(offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch 358 * i, 10, 10, 66 + code[i] mod 11 * 11, 137 + code[i] div 11 * 11); 359 360 if MyRO.DevModel.Cap[code[i]] > 0 then 361 TextColor := MainTexture.clLitText 362 else 363 TextColor := -1; 364 365 if code[i] < mcFirstNonCap then 366 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 7, 367 yFeature + LinePitch * i - 1, IntToStr(MyRO.DevModel.Cap[code[i]])); 368 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 88, 369 yFeature + LinePitch * i - 1, Phrases.Lookup('FEATURES', code[i])); 370 end; 371 end; 372 373 // free features 374 j := 0; 375 for i := 0 to nFeature - 1 do 376 if (i in AutoFeature) and (1 shl Domain and Feature[i].Domains <> 0) and 377 (Feature[i].Preq <> preNA) and 378 ((Feature[i].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = me) 379 or (Feature[i].Preq >= 0) and (MyRO.Tech[Feature[i].Preq] >= tsApplicable) 380 ) and not((Feature[i].Preq = adSteamEngine) and 381 (MyRO.Tech[adNuclearPower] >= tsApplicable)) then 382 begin 383 DarkGradient(offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch 384 * j, 16, 1); 385 Frame(offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * j, 386 xWeight + 18, yWeight + 47 + LinePitch * j, $C0C0C0, $C0C0C0); 387 Sprite(offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * j, 388 10, 10, 66 + i mod 11 * 11, 137 + i div 11 * 11); 389 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xWeight + 26, 390 yWeight + 31 + LinePitch * j, Phrases.Lookup('FEATURES', i)); 391 inc(j); 392 end; 393 394 with Tribe[me].ModelPicture[MyRO.nModel] do 395 begin 396 FrameImage(offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig, 397 ySizeBig, 0, 0); 398 Sprite(offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1, 399 pix div 10 * 49 + 1); 400 end; 401 MarkUsedOffscreen(ClientWidth, ClientHeight); 402 end; { MainPaint } 348 403 349 404 procedure TDraftDlg.SetDomain(d: integer); … … 351 406 function Prio(fix: integer): integer; 352 407 var 353 FeaturePreq: integer; 354 begin 355 FeaturePreq:=Feature[fix].Preq; 356 assert(FeaturePreq<>preNA); 357 if fix<mcFirstNonCap then result:=10000+fix 358 else if FeaturePreq=preNone then result:=20000 359 else if FeaturePreq<0 then result:=40000 360 else result:=30000+AdvValue[FeaturePreq]; 361 if not (fix in AutoFeature) then inc(result,90000); 408 FeaturePreq: integer; 409 begin 410 FeaturePreq := Feature[fix].Preq; 411 assert(FeaturePreq <> preNA); 412 if fix < mcFirstNonCap then 413 result := 10000 + fix 414 else if FeaturePreq = preNone then 415 result := 20000 416 else if FeaturePreq < 0 then 417 result := 40000 418 else 419 result := 30000 + AdvValue[FeaturePreq]; 420 if not(fix in AutoFeature) then 421 inc(result, 90000); 362 422 end; 363 423 364 424 var 365 i,j,x: integer; 366 begin 367 Domain:=d; 368 Lines:=0; 369 for i:=0 to nFeature-1 do 370 if IsFeatureInList(Domain,i) then 371 begin code[Lines]:=i; inc(Lines) end; 372 yFeature:=yFeature0+(MaxLines-Lines)*LinePitch div 2; 373 374 // sort features 375 for i:=0 to Lines-2 do for j:=i+1 to Lines-1 do 376 if Prio(code[i])>Prio(code[j]) then 377 begin // exchange 378 x:=code[i]; 379 code[i]:=code[j]; 380 code[j]:=x 381 end; 382 end; 383 384 function TDraftDlg.IsFeatureInList(d,i: integer): boolean; 385 begin 386 result:= not (i in AutoFeature) 387 and (1 shl d and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 388 and ((Feature[i].Preq=preNone) 389 or (Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 390 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)); 425 i, j, x: integer; 426 begin 427 Domain := d; 428 Lines := 0; 429 for i := 0 to nFeature - 1 do 430 if IsFeatureInList(Domain, i) then 431 begin 432 code[Lines] := i; 433 inc(Lines) 434 end; 435 yFeature := yFeature0 + (MaxLines - Lines) * LinePitch div 2; 436 437 // sort features 438 for i := 0 to Lines - 2 do 439 for j := i + 1 to Lines - 1 do 440 if Prio(code[i]) > Prio(code[j]) then 441 begin // exchange 442 x := code[i]; 443 code[i] := code[j]; 444 code[j] := x 445 end; 446 end; 447 448 function TDraftDlg.IsFeatureInList(d, i: integer): boolean; 449 begin 450 result := not(i in AutoFeature) and (1 shl d and Feature[i].Domains <> 0) and 451 (Feature[i].Preq <> preNA) and 452 ((Feature[i].Preq = preNone) or (Feature[i].Preq = preSun) and 453 (MyRO.Wonder[woSun].EffectiveOwner = me) or (Feature[i].Preq >= 0) and 454 (MyRO.Tech[Feature[i].Preq] >= tsApplicable)); 391 455 end; 392 456 393 457 procedure TDraftDlg.FormShow(Sender: TObject); 394 458 var 395 count,d,i: integer; 396 begin 397 Domain:=dGround; 398 while (Domain<dAir) and (upgrade[Domain,0].Preq<>preNone) 399 and (MyRO.Tech[upgrade[Domain,0].Preq]<tsApplicable) do inc(Domain); 400 401 // count max number of features in any domain 402 MaxLines:=0; 403 for d:=0 to nDomains-1 do 404 if (upgrade[d,0].Preq=preNone) 405 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable) then 406 begin 407 count:=0; 408 for i:=0 to nFeature-1 do 409 if IsFeatureInList(d,i) then 410 inc(count); 411 if count>MaxLines then 412 MaxLines:=count; 413 end; 414 Cut:=(MaxLines0-MaxLines)*LinePitch; 415 OKBtn.Top:=477-Cut; 416 yDomain:=yDomain0-Cut; 417 yWeight:=yWeight0-Cut; 418 yTotal:=yTotal0-Cut; 419 yView:=yView0-Cut; 420 421 if WindowMode=wmModal then 422 begin {center on screen} 423 Left:=(Screen.Width-Template.Width) div 2; 424 Top:=(Screen.Height-(Template.Height-Cut)) div 2; 425 end; 426 427 SetDomain(Domain); 428 Server(sCreateDevModel,me,Domain,nil^); 429 MyModel[MyRO.nModel]:=MyRO.DevModel; 430 InitMyModel(MyRO.nModel,false); 431 OffscreenPaint; 432 IncCap:=-1; DecCap:=-1; 459 count, d, i: integer; 460 begin 461 Domain := dGround; 462 while (Domain < dAir) and (upgrade[Domain, 0].Preq <> preNone) and 463 (MyRO.Tech[upgrade[Domain, 0].Preq] < tsApplicable) do 464 inc(Domain); 465 466 // count max number of features in any domain 467 MaxLines := 0; 468 for d := 0 to nDomains - 1 do 469 if (upgrade[d, 0].Preq = preNone) or 470 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable) then 471 begin 472 count := 0; 473 for i := 0 to nFeature - 1 do 474 if IsFeatureInList(d, i) then 475 inc(count); 476 if count > MaxLines then 477 MaxLines := count; 478 end; 479 Cut := (MaxLines0 - MaxLines) * LinePitch; 480 OKBtn.Top := 477 - Cut; 481 yDomain := yDomain0 - Cut; 482 yWeight := yWeight0 - Cut; 483 yTotal := yTotal0 - Cut; 484 yView := yView0 - Cut; 485 486 if WindowMode = wmModal then 487 begin { center on screen } 488 Left := (Screen.Width - Template.Width) div 2; 489 Top := (Screen.Height - (Template.Height - Cut)) div 2; 490 end; 491 492 SetDomain(Domain); 493 Server(sCreateDevModel, me, Domain, nil^); 494 MyModel[MyRO.nModel] := MyRO.DevModel; 495 InitMyModel(MyRO.nModel, false); 496 OffscreenPaint; 497 IncCap := -1; 498 DecCap := -1; 433 499 end; 434 500 435 501 procedure TDraftDlg.ShowNewContent(NewMode: integer); 436 502 begin 437 inherited ShowNewContent(NewMode);503 inherited ShowNewContent(NewMode); 438 504 end; 439 505 … … 441 507 Shift: TShiftState; x, y: integer); 442 508 var 443 i,d: integer; 444 begin 445 if Button=mbLeft then 446 begin 447 for d:=0 to nDomains-1 do 448 if (d<>Domain) and ((upgrade[d,0].Preq=preNone) 449 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable)) 450 and (x>=xDomain+d*DomainPitch) and (x<xDomain+d*DomainPitch+36) 451 and (y>=yDomain) and (y<yDomain+36) then 509 i, d: integer; 510 begin 511 if Button = mbLeft then 512 begin 513 for d := 0 to nDomains - 1 do 514 if (d <> Domain) and ((upgrade[d, 0].Preq = preNone) or 515 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable)) and 516 (x >= xDomain + d * DomainPitch) and 517 (x < xDomain + d * DomainPitch + 36) and (y >= yDomain) and 518 (y < yDomain + 36) then 452 519 begin 453 SetDomain(d);454 Server(sCreateDevModel,me,Domain,nil^);455 MyModel[MyRO.nModel]:=MyRO.DevModel;456 InitMyModel(MyRO.nModel,false);457 SmartUpdateContent;520 SetDomain(d); 521 Server(sCreateDevModel, me, Domain, nil^); 522 MyModel[MyRO.nModel] := MyRO.DevModel; 523 InitMyModel(MyRO.nModel, false); 524 SmartUpdateContent; 458 525 end; 459 526 460 if (y>=yFeature) and (y<yFeature+LinePitch*Lines) then461 begin 462 i:=(y-yFeature) div LinePitch;463 if (x>=xFeature-21) and (x<ClientWidth) and (ssShift in Shift) then464 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i])465 else if not(code[i] in AutoFeature) then527 if (y >= yFeature) and (y < yFeature + LinePitch * Lines) then 528 begin 529 i := (y - yFeature) div LinePitch; 530 if (x >= xFeature - 21) and (x < ClientWidth) and (ssShift in Shift) then 531 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i]) 532 else if not(code[i] in AutoFeature) then 466 533 begin 467 if (code[i]<mcFirstNonCap) and (x>=xFeature-21) and (x<xFeature-21+12) then 534 if (code[i] < mcFirstNonCap) and (x >= xFeature - 21) and 535 (x < xFeature - 21 + 12) then 468 536 begin 469 IncCap:=code[i]; 470 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i,12,12,182,172); 471 SmartInvalidate; 537 IncCap := code[i]; 538 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 539 i, 12, 12, 182, 172); 540 SmartInvalidate; 472 541 end 473 else if (x>=xFeature-9) and (x<xFeature-9+12) then542 else if (x >= xFeature - 9) and (x < xFeature - 9 + 12) then 474 543 begin 475 DecCap:=code[i]; 476 if code[i]<mcFirstNonCap then 477 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i,12,12,182,159) 478 else Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 479 12,12,182,185+13*MyRO.DevModel.Cap[code[i]]); 480 SmartInvalidate; 544 DecCap := code[i]; 545 if code[i] < mcFirstNonCap then 546 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 547 i, 12, 12, 182, 159) 548 else 549 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 550 i, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 551 SmartInvalidate; 481 552 end; 482 553 end … … 488 559 Shift: TShiftState; x, y: integer); 489 560 var 490 NewValue: integer;491 begin 492 if IncCap>=0 then493 begin 494 NewValue:=MyRO.DevModel.Cap[IncCap]+1;495 Server(sSetDevModelCap+NewValue shl 4,me,IncCap,nil^);496 MyModel[MyRO.nModel]:=MyRO.DevModel;497 InitMyModel(MyRO.nModel,false);498 SmartUpdateContent;499 IncCap:=-1;561 NewValue: integer; 562 begin 563 if IncCap >= 0 then 564 begin 565 NewValue := MyRO.DevModel.Cap[IncCap] + 1; 566 Server(sSetDevModelCap + NewValue shl 4, me, IncCap, nil^); 567 MyModel[MyRO.nModel] := MyRO.DevModel; 568 InitMyModel(MyRO.nModel, false); 569 SmartUpdateContent; 570 IncCap := -1; 500 571 end 501 else if DecCap>=0 then 502 begin 503 if (DecCap>=mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap]>0) then 504 begin 505 NewValue:=MyRO.DevModel.Cap[DecCap]-1; 506 if DecCap>=mcFirstNonCap then NewValue:=-NewValue; 507 Server(sSetDevModelCap+NewValue shl 4,me,DecCap,nil^); 508 MyModel[MyRO.nModel]:=MyRO.DevModel; 509 InitMyModel(MyRO.nModel,false); 510 end; 511 SmartUpdateContent; 512 DecCap:=-1; 572 else if DecCap >= 0 then 573 begin 574 if (DecCap >= mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap] > 0) then 575 begin 576 NewValue := MyRO.DevModel.Cap[DecCap] - 1; 577 if DecCap >= mcFirstNonCap then 578 NewValue := -NewValue; 579 Server(sSetDevModelCap + NewValue shl 4, me, DecCap, nil^); 580 MyModel[MyRO.nModel] := MyRO.DevModel; 581 InitMyModel(MyRO.nModel, false); 582 end; 583 SmartUpdateContent; 584 DecCap := -1; 513 585 end; 514 586 end; … … 516 588 procedure TDraftDlg.OKBtnClick(Sender: TObject); 517 589 begin 518 ModalResult:=mrOK;590 ModalResult := mrOK; 519 591 end; 520 592 521 593 end. 522
Note:
See TracChangeset
for help on using the changeset viewer.