Changeset 465 for branches/highdpi/LocalPlayer/Draft.pas
- Timestamp:
- Nov 30, 2023, 10:16:14 PM (12 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/LocalPlayer/Draft.pas
r361 r465 5 5 6 6 uses 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 ButtonB, Area; 7 UDpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 8 Classes, Graphics, Controls, Forms, ExtCtrls, ButtonA, ButtonB, Area; 12 9 13 10 type … … 23 20 procedure CloseBtnClick(Sender: TObject); 24 21 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 25 Shift: TShiftState; x, y: integer);22 Shift: TShiftState; X, Y: Integer); 26 23 procedure OKBtnClick(Sender: TObject); 27 24 procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; 28 Shift: TShiftState; x, y: integer);25 Shift: TShiftState; X, Y: Integer); 29 26 public 30 procedure ShowNewContent(NewMode: integer);27 procedure ShowNewContent(NewMode: TWindowMode); 31 28 protected 32 29 procedure OffscreenPaint; override; 33 30 private 34 31 Domain, MaxLines, Lines, Cut, yDomain, yFeature, yWeight, yTotal, yView, 35 IncCap, DecCap: integer;36 code: array [0 .. nFeature - 1] of integer;32 IncCap, DecCap: Integer; 33 Code: array [0 .. nFeature - 1] of Integer; 37 34 Template, Back: TDpiBitmap; 38 function IsFeatureInList(d, i: integer): boolean; 39 procedure SetDomain(d: integer); 40 end; 41 42 var 43 DraftDlg: TDraftDlg; 35 function IsFeatureInList(D, I: Integer): Boolean; 36 procedure SetDomain(D: Integer); 37 end; 38 44 39 45 40 implementation 46 41 47 uses Help, Tribes, Directories; 42 uses 43 Term, Help, Tribes, Directories; 48 44 49 45 {$R *.lfm} … … 109 105 procedure TDraftDlg.OffscreenPaint; 110 106 111 function DomainAvailable( d: integer): boolean;112 begin 113 result := (upgrade[d, 0].Preq = preNone) or114 (MyRO.Tech[upgrade[ d, 0].Preq] >= tsApplicable);107 function DomainAvailable(D: Integer): Boolean; 108 begin 109 Result := (upgrade[D, 0].Preq = preNone) or 110 (MyRO.Tech[upgrade[D, 0].Preq] >= tsApplicable); 115 111 end; 116 112 117 113 procedure PaintTotalBars; 118 114 var 119 i, y, dx, num, w: integer;120 s: string;121 begin 122 with offscreen.Canvas do115 I, Y, dx, num, W: Integer; 116 S: string; 117 begin 118 with Offscreen.Canvas do 123 119 begin 124 120 // strength bar 125 y:= yTotal;126 DarkGradient( offscreen.Canvas, xTotal - 6, y+ 1, 184, 2);127 DarkGradient( offscreen.Canvas, xTotal2 + 172, y+ 1, 95, 2);128 RisedTextOut( offscreen.Canvas, xTotal - 2, y,121 Y := yTotal; 122 DarkGradient(Offscreen.Canvas, xTotal - 6, Y + 1, 184, 2); 123 DarkGradient(Offscreen.Canvas, xTotal2 + 172, Y + 1, 95, 2); 124 RisedTextOut(Offscreen.Canvas, xTotal - 2, Y, 129 125 Phrases.Lookup('UNITSTRENGTH')); 130 RisedTextOut( offscreen.Canvas, xTotal + 112 + 30, y,126 RisedTextOut(Offscreen.Canvas, xTotal + 112 + 30, Y, 131 127 'x' + IntToStr(MyRO.DevModel.MStrength)); 132 RisedTextOut( offscreen.Canvas, xTotal2 + 148 + 30, y, '=');133 s:= IntToStr(MyRO.DevModel.Attack) + '/' +128 RisedTextOut(Offscreen.Canvas, xTotal2 + 148 + 30, Y, '='); 129 S := IntToStr(MyRO.DevModel.Attack) + '/' + 134 130 IntToStr(MyRO.DevModel.Defense); 135 RisedTextOut( offscreen.Canvas, xTotal2 + 170 + 64 + 30 -136 BiColorTextWidth( offscreen.Canvas, s), y, s);131 RisedTextOut(Offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 132 BiColorTextWidth(Offscreen.Canvas, S), Y, S); 137 133 138 134 // transport bar 139 135 if MyRO.DevModel.MTrans > 0 then 140 136 begin 141 y:= yTotal + 19;142 DarkGradient( offscreen.Canvas, xTotal - 6, y+ 1, 184, 1);143 DarkGradient( offscreen.Canvas, xTotal2 + 172, y+ 1, 95, 1);144 RisedTextOut( offscreen.Canvas, xTotal - 2, y,137 Y := yTotal + 19; 138 DarkGradient(Offscreen.Canvas, xTotal - 6, Y + 1, 184, 1); 139 DarkGradient(Offscreen.Canvas, xTotal2 + 172, Y + 1, 95, 1); 140 RisedTextOut(Offscreen.Canvas, xTotal - 2, Y, 145 141 Phrases.Lookup('UNITTRANSPORT')); 146 RisedTextOut( offscreen.Canvas, xTotal + 112 + 30, y,142 RisedTextOut(Offscreen.Canvas, xTotal + 112 + 30, Y, 147 143 'x' + IntToStr(MyRO.DevModel.MTrans)); 148 RisedTextOut( offscreen.Canvas, xTotal2 + 148 + 30, y, '=');144 RisedTextOut(Offscreen.Canvas, xTotal2 + 148 + 30, Y, '='); 149 145 150 146 Font.Color := $000000; 151 147 dx := -237 - 30; 152 for i:= mcFirstNonCap - 1 downto 3 do153 if iin [mcSeaTrans, mcCarrier, mcAirTrans] then148 for I := mcFirstNonCap - 1 downto 3 do 149 if I in [mcSeaTrans, mcCarrier, mcAirTrans] then 154 150 begin 155 num := MyRO.DevModel.Cap[ i] * MyRO.DevModel.MTrans;151 num := MyRO.DevModel.Cap[I] * MyRO.DevModel.MTrans; 156 152 if num > 0 then 157 153 begin 158 inc(dx, 15);154 Inc(dx, 15); 159 155 Brush.Color := $C0C0C0; 160 FrameRect(Rect(xTotal2 - 3 - dx, y+ 2,161 xTotal2 + 11 - dx, y+ 16));156 FrameRect(Rect(xTotal2 - 3 - dx, Y + 2, 157 xTotal2 + 11 - dx, Y + 16)); 162 158 Brush.Style := bsClear; 163 Sprite( offscreen, HGrSystem, xTotal2 - 1 - dx, y+ 4, 10, 10,164 66 + i mod 11 * 11, 137 + idiv 11 * 11);159 Sprite(Offscreen, HGrSystem, xTotal2 - 1 - dx, Y + 4, 10, 10, 160 66 + I mod 11 * 11, 137 + I div 11 * 11); 165 161 if num > 1 then 166 162 begin 167 s:= IntToStr(num);168 w := TextWidth(s);169 inc(dx, w+ 1);163 S := IntToStr(num); 164 W := TextWidth(S); 165 Inc(dx, W + 1); 170 166 Brush.Color := $FFFFFF; 171 FillRect(Rect(xTotal2 - 3 - dx, y+ 2,172 xTotal2 + w - 1 - dx, y+ 16));167 FillRect(Rect(xTotal2 - 3 - dx, Y + 2, 168 xTotal2 + W - 1 - dx, Y + 16)); 173 169 Brush.Style := bsClear; 174 Textout(xTotal2 - 3 - dx + 1, y, s);170 Textout(xTotal2 - 3 - dx + 1, Y, S); 175 171 end; 176 172 end; 177 end 173 end; 178 174 end; 179 175 180 176 // speed bar 181 y:= yTotal + 38;182 LoweredTextOut( offscreen.Canvas, -1, MainTexture, xTotal - 2, y,177 Y := yTotal + 38; 178 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, xTotal - 2, Y, 183 179 Phrases.Lookup('UNITSPEED')); 184 DLine( offscreen.Canvas, xTotal - 2, xTotal + 174, y+ 16,180 DLine(Offscreen.Canvas, xTotal - 2, xTotal + 174, Y + 16, 185 181 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 186 DLine( offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y+ 16,182 DLine(Offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, Y + 16, 187 183 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 188 s:= MovementToString(MyRO.DevModel.Speed);189 RisedTextOut( offscreen.Canvas, xTotal2 + 170 + 64 + 30 -190 TextWidth( s), y, s);184 S := MovementToString(MyRO.DevModel.Speed); 185 RisedTextOut(Offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 186 TextWidth(S), Y, S); 191 187 192 188 // cost bar 193 y:= yTotal + 57;194 LoweredTextOut( offscreen.Canvas, -1, MainTexture, xTotal - 2, y,189 Y := yTotal + 57; 190 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, xTotal - 2, Y, 195 191 Phrases.Lookup('UNITCOST')); 196 LoweredTextOut( offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, y,192 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, Y, 197 193 'x' + IntToStr(MyRO.DevModel.MCost)); 198 LoweredTextOut( offscreen.Canvas, -1, MainTexture,199 xTotal2 + 148 + 30, y, '=');200 DLine( offscreen.Canvas, xTotal - 2, xTotal + 174, y+ 16,194 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, 195 xTotal2 + 148 + 30, Y, '='); 196 DLine(Offscreen.Canvas, xTotal - 2, xTotal + 174, Y + 16, 201 197 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 202 DLine( offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y+ 16,198 DLine(Offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, Y + 16, 203 199 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 204 s:= IntToStr(MyRO.DevModel.Cost);205 RisedTextOut( offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 -206 TextWidth( s), y, s);207 Sprite( offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y+ 4, 10,200 S := IntToStr(MyRO.DevModel.Cost); 201 RisedTextOut(Offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 202 TextWidth(S), Y, S); 203 Sprite(Offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, Y + 4, 10, 208 204 10, 88, 115); 209 205 210 if G.Difficulty[ me] <> 2 then206 if G.Difficulty[Me] <> 2 then 211 207 begin // corrected cost bar 212 y:= yTotal + 76;213 LoweredTextOut( offscreen.Canvas, -1, MainTexture, xTotal - 2, y,214 Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[ me])));215 LoweredTextOut( offscreen.Canvas, -1, MainTexture,216 xTotal2 + 148 + 30, y, '=');217 DLine( offscreen.Canvas, xTotal - 2, xTotal + 174, y+ 16,208 Y := yTotal + 76; 209 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, xTotal - 2, Y, 210 Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[Me]))); 211 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, 212 xTotal2 + 148 + 30, Y, '='); 213 DLine(Offscreen.Canvas, xTotal - 2, xTotal + 174, Y + 16, 218 214 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 219 DLine( offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y+ 16,215 DLine(Offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, Y + 16, 220 216 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight); 221 s:= IntToStr(MyRO.DevModel.Cost * BuildCostMod222 [G.Difficulty[ me]] div 12);223 RisedTextOut( offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 -224 TextWidth( s), y, s);225 Sprite( offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y+ 4, 10,217 S := IntToStr(MyRO.DevModel.Cost * BuildCostMod 218 [G.Difficulty[Me]] div 12); 219 RisedTextOut(Offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 220 TextWidth(S), Y, S); 221 Sprite(Offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, Y + 4, 10, 226 222 10, 88, 115); 227 223 end; … … 230 226 231 227 var 232 i, j, x, d, n, TextColor, CapWeight, DomainCount: integer;228 I, J, X, D, N, TextColor, CapWeight, DomainCount: Integer; 233 229 begin 234 230 inherited; … … 239 235 // assemble background from 2 texture tiles 240 236 begin 241 DpiBit Canvas(Back.Canvas, 0, 0, ClientWidth, 64,237 DpiBitBltCanvas(Back.Canvas, 0, 0, ClientWidth, 64, 242 238 MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2, 243 239 MainTexture.Height - 64); 244 DpiBit Canvas(Back.Canvas, 0, 64, ClientWidth, ClientHeight - 64,240 DpiBitBltCanvas(Back.Canvas, 0, 64, ClientWidth, ClientHeight - 64, 245 241 MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2, 246 242 0); 247 243 end 248 244 else 249 DpiBit Canvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight,245 DpiBitBltCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 250 246 MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2, 251 247 (MainTexture.Height - ClientHeight) div 2); … … 254 250 Template.Height - 64 - Cut); 255 251 256 DpiBit Canvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,252 DpiBitBltCanvas(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 257 253 Back.Canvas, 0, 0); 258 254 259 offscreen.Canvas.Font.Assign(UniFont[ftCaption]);260 RisedTextOut( offscreen.Canvas, 10, 7, Caption);261 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);255 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 256 RisedTextOut(Offscreen.Canvas, 10, 7, Caption); 257 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 262 258 263 259 with MyRO.DevModel do 264 260 begin 265 261 DomainCount := 0; 266 for d:= 0 to nDomains - 1 do267 if DomainAvailable( d) then268 inc(DomainCount);262 for D := 0 to nDomains - 1 do 263 if DomainAvailable(D) then 264 Inc(DomainCount); 269 265 if DomainCount > 1 then 270 266 begin 271 for d:= 0 to nDomains - 1 do272 if DomainAvailable( d) then267 for D := 0 to nDomains - 1 do 268 if DomainAvailable(D) then 273 269 begin 274 x := xDomain + d* DomainPitch;275 if d= Domain then276 ImageOp_BCC( offscreen, Templates.Data, x, yDomain, 142, 246 + 37 * d, 36,270 X := xDomain + D * DomainPitch; 271 if D = Domain then 272 ImageOp_BCC(Offscreen, Templates.Data, X, yDomain, 142, 246 + 37 * D, 36, 277 273 36, 0, $00C0FF) 278 274 else 279 ImageOp_BCC( offscreen, Templates.Data, x, yDomain, 142, 246 + 37 * d, 36,275 ImageOp_BCC(Offscreen, Templates.Data, X, yDomain, 142, 246 + 37 * D, 36, 280 276 36, 0, $606060); 281 277 end; 282 Frame( offscreen.Canvas, xDomain - 11, yDomain - 3,278 Frame(Offscreen.Canvas, xDomain - 11, yDomain - 3, 283 279 xDomain + 2 * DomainPitch + 46, yDomain + 38, $B0B0B0, $FFFFFF); 284 RFrame( offscreen.Canvas, xDomain - 12, yDomain - 4,280 RFrame(Offscreen.Canvas, xDomain - 12, yDomain - 4, 285 281 xDomain + 2 * DomainPitch + 47, yDomain + 39, $FFFFFF, $B0B0B0); 286 282 end; … … 295 291 296 292 // display weight 297 with offscreen.Canvas do298 begin 299 for i:= 0 to MaxWeight - 1 do300 if i< Weight then301 ImageOp_BCC( offscreen, Templates.Data, Point(xWeight + 20 * i, yWeight),293 with Offscreen.Canvas do 294 begin 295 for I := 0 to MaxWeight - 1 do 296 if I < Weight then 297 ImageOp_BCC(Offscreen, Templates.Data, Point(xWeight + 20 * I, yWeight), 302 298 WeightOn.BoundsRect, 0, $949494) 303 299 else 304 ImageOp_BCC( offscreen, Templates.Data, Point(xWeight + 20 * i, yWeight),300 ImageOp_BCC(Offscreen, Templates.Data, Point(xWeight + 20 * I, yWeight), 305 301 WeightOff.BoundsRect, 0, $949494); 306 302 end; 307 303 308 with offscreen.Canvas do309 for i:= 0 to Lines - 1 do304 with Offscreen.Canvas do 305 for I := 0 to Lines - 1 do 310 306 begin 311 if not( code[i] in AutoFeature) then307 if not(Code[I] in AutoFeature) then 312 308 begin 313 309 // paint +/- butttons 314 if code[i] < mcFirstNonCap then310 if Code[I] < mcFirstNonCap then 315 311 begin 316 Dump( offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch *317 i, 12, 12, 169, 172);318 Dump( offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *319 i, 12, 12, 169, 159);320 RFrame( offscreen.Canvas, xFeature - (21 + 1),321 yFeature + 2 + LinePitch * i- 1, xFeature - (21 - 24),322 yFeature + 2 + LinePitch * i+ 12, MainTexture.ColorBevelShade,312 Dump(Offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 313 I, 12, 12, 169, 172); 314 Dump(Offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 315 I, 12, 12, 169, 159); 316 RFrame(Offscreen.Canvas, xFeature - (21 + 1), 317 yFeature + 2 + LinePitch * I - 1, xFeature - (21 - 24), 318 yFeature + 2 + LinePitch * I + 12, MainTexture.ColorBevelShade, 323 319 MainTexture.ColorBevelLight); 324 320 end 325 321 else 326 322 begin 327 Dump( offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *328 i, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[code[i]]);329 RFrame( offscreen.Canvas, xFeature - (9 + 1),330 yFeature + 2 + LinePitch * i- 1, xFeature - (21 - 24),331 yFeature + 2 + LinePitch * i+ 12, MainTexture.ColorBevelShade,323 Dump(Offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 324 I, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[Code[I]]); 325 RFrame(Offscreen.Canvas, xFeature - (9 + 1), 326 yFeature + 2 + LinePitch * I - 1, xFeature - (21 - 24), 327 yFeature + 2 + LinePitch * I + 12, MainTexture.ColorBevelShade, 332 328 MainTexture.ColorBevelLight); 333 329 end; 334 330 335 331 // paint cost 336 LightGradient( offscreen.Canvas, xFeature + 34,337 yFeature + LinePitch * i, 50, HGrSystem.Data.Canvas.Pixels332 LightGradient(Offscreen.Canvas, xFeature + 34, 333 yFeature + LinePitch * I, 50, HGrSystem.Data.Canvas.Pixels 338 334 [187, 137]); 339 if (Domain = dGround) and ( code[i] = mcDefense) then335 if (Domain = dGround) and (Code[I] = mcDefense) then 340 336 CapWeight := 2 341 337 else 342 CapWeight := Feature[ code[i]].Weight;343 n := CapWeight + Feature[code[i]].Cost;344 d:= 6;345 while ( n - 1) * d* 2 > 48 - 10 do346 dec(d);347 for j := 0 to n- 1 do348 if j< CapWeight then349 Sprite( offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d,350 yFeature + 2 + LinePitch * i+ 1, 10, 10, 88, 126)338 CapWeight := Feature[Code[I]].Weight; 339 N := CapWeight + Feature[Code[I]].Cost; 340 D := 6; 341 while (N - 1) * D * 2 > 48 - 10 do 342 Dec(D); 343 for J := 0 to N - 1 do 344 if J < CapWeight then 345 Sprite(Offscreen, HGrSystem, xFeature + 54 + (J * 2 + 1 - N) * D, 346 yFeature + 2 + LinePitch * I + 1, 10, 10, 88, 126) 351 347 else 352 Sprite( offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d,353 yFeature + 2 + LinePitch * i+ 1, 10, 10, 88, 115);348 Sprite(Offscreen, HGrSystem, xFeature + 54 + (J * 2 + 1 - N) * D, 349 yFeature + 2 + LinePitch * I + 1, 10, 10, 88, 115); 354 350 end; // if not (code[i] in AutoFeature) 355 DarkGradient( offscreen.Canvas, xFeature + 17,356 yFeature + LinePitch * i, 16, 1);357 ScreenTools.Frame( offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * i,358 xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * i,351 DarkGradient(Offscreen.Canvas, xFeature + 17, 352 yFeature + LinePitch * I, 16, 1); 353 ScreenTools.Frame(Offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * I, 354 xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * I, 359 355 $C0C0C0, $C0C0C0); 360 Sprite( offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch361 * i, 10, 10, 66 + code[i] mod 11 * 11, 137 + code[i] div 11 * 11);362 363 if MyRO.DevModel.Cap[ code[i]] > 0 then356 Sprite(Offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch 357 * I, 10, 10, 66 + Code[I] mod 11 * 11, 137 + Code[I] div 11 * 11); 358 359 if MyRO.DevModel.Cap[Code[I]] > 0 then 364 360 TextColor := MainTexture.ColorLitText 365 361 else 366 362 TextColor := -1; 367 363 368 if code[i] < mcFirstNonCap then369 LoweredTextOut( offscreen.Canvas, TextColor, MainTexture, xFeature + 7,370 yFeature + LinePitch * i - 1, IntToStr(MyRO.DevModel.Cap[code[i]]));371 LoweredTextOut( offscreen.Canvas, TextColor, MainTexture, xFeature + 88,372 yFeature + LinePitch * i - 1, Phrases.Lookup('FEATURES', code[i]));364 if Code[I] < mcFirstNonCap then 365 LoweredTextOut(Offscreen.Canvas, TextColor, MainTexture, xFeature + 7, 366 yFeature + LinePitch * I - 1, IntToStr(MyRO.DevModel.Cap[Code[I]])); 367 LoweredTextOut(Offscreen.Canvas, TextColor, MainTexture, xFeature + 88, 368 yFeature + LinePitch * I - 1, Phrases.Lookup('FEATURES', Code[I])); 373 369 end; 374 370 end; 375 371 376 372 // free features 377 j:= 0;378 for i:= 0 to nFeature - 1 do379 if ( i in AutoFeature) and (1 shl Domain and Feature[i].Domains <> 0) and380 (Feature[ i].Preq <> preNA) and381 ((Feature[ i].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = me)382 or (Feature[ i].Preq >= 0) and (MyRO.Tech[Feature[i].Preq] >= tsApplicable)383 ) and not((Feature[ i].Preq = adSteamEngine) and373 J := 0; 374 for I := 0 to nFeature - 1 do 375 if (I in AutoFeature) and (1 shl Domain and Feature[I].Domains <> 0) and 376 (Feature[I].Preq <> preNA) and 377 ((Feature[I].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = Me) 378 or (Feature[I].Preq >= 0) and (MyRO.Tech[Feature[I].Preq] >= tsApplicable) 379 ) and not((Feature[I].Preq = adSteamEngine) and 384 380 (MyRO.Tech[adNuclearPower] >= tsApplicable)) then 385 381 begin 386 DarkGradient( offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch387 * j, 16, 1);388 Frame( offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * j,389 xWeight + 18, yWeight + 47 + LinePitch * j, $C0C0C0, $C0C0C0);390 Sprite( offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * j,391 10, 10, 66 + i mod 11 * 11, 137 + idiv 11 * 11);392 LoweredTextOut( offscreen.Canvas, -1, MainTexture, xWeight + 26,393 yWeight + 31 + LinePitch * j, Phrases.Lookup('FEATURES', i));394 inc(j);395 end; 396 397 with Tribe[ me].ModelPicture[MyRO.nModel] do398 begin 399 FrameImage( offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig,382 DarkGradient(Offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch 383 * J, 16, 1); 384 Frame(Offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * J, 385 xWeight + 18, yWeight + 47 + LinePitch * J, $C0C0C0, $C0C0C0); 386 Sprite(Offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * J, 387 10, 10, 66 + I mod 11 * 11, 137 + I div 11 * 11); 388 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, xWeight + 26, 389 yWeight + 31 + LinePitch * J, Phrases.Lookup('FEATURES', I)); 390 Inc(J); 391 end; 392 393 with Tribe[Me].ModelPicture[MyRO.nModel] do 394 begin 395 FrameImage(Offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig, 400 396 ySizeBig, 0, 0); 401 Sprite( offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1,397 Sprite(Offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1, 402 398 pix div 10 * 49 + 1); 403 399 end; 404 400 MarkUsedOffscreen(ClientWidth, ClientHeight); 405 end; { MainPaint }406 407 procedure TDraftDlg.SetDomain( d: integer);408 409 function Prio(fix: integer): integer;401 end; 402 403 procedure TDraftDlg.SetDomain(D: Integer); 404 405 function Prio(fix: Integer): Integer; 410 406 var 411 FeaturePreq: integer;407 FeaturePreq: Integer; 412 408 begin 413 409 FeaturePreq := Feature[fix].Preq; 414 assert(FeaturePreq <> preNA);410 Assert(FeaturePreq <> preNA); 415 411 if fix < mcFirstNonCap then 416 result := 10000 + fix412 Result := 10000 + fix 417 413 else if FeaturePreq = preNone then 418 result := 20000414 Result := 20000 419 415 else if FeaturePreq < 0 then 420 result := 40000416 Result := 40000 421 417 else 422 result := 30000 + AdvValue[FeaturePreq];418 Result := 30000 + AdvValue[FeaturePreq]; 423 419 if not(fix in AutoFeature) then 424 inc(result, 90000);420 Inc(Result, 90000); 425 421 end; 426 422 427 423 var 428 i, j, x: integer;429 begin 430 Domain := d;424 I, J, X: Integer; 425 begin 426 Domain := D; 431 427 Lines := 0; 432 for i:= 0 to nFeature - 1 do433 if IsFeatureInList(Domain, i) then434 begin 435 code[Lines] := i;436 inc(Lines)428 for I := 0 to nFeature - 1 do 429 if IsFeatureInList(Domain, I) then 430 begin 431 Code[Lines] := I; 432 Inc(Lines); 437 433 end; 438 434 yFeature := yFeature0 + (MaxLines - Lines) * LinePitch div 2; 439 435 440 436 // sort features 441 for i:= 0 to Lines - 2 do442 for j := i+ 1 to Lines - 1 do443 if Prio( code[i]) > Prio(code[j]) then437 for I := 0 to Lines - 2 do 438 for J := I + 1 to Lines - 1 do 439 if Prio(Code[I]) > Prio(Code[J]) then 444 440 begin // exchange 445 x := code[i];446 code[i] := code[j];447 code[j] := x441 X := Code[I]; 442 Code[I] := Code[J]; 443 Code[J] := X; 448 444 end; 449 445 end; 450 446 451 function TDraftDlg.IsFeatureInList( d, i: integer): boolean;452 begin 453 result := not(i in AutoFeature) and (1 shl d and Feature[i].Domains <> 0) and454 (Feature[ i].Preq <> preNA) and455 ((Feature[ i].Preq = preNone) or (Feature[i].Preq = preSun) and456 (MyRO.Wonder[woSun].EffectiveOwner = me) or (Feature[i].Preq >= 0) and457 (MyRO.Tech[Feature[ i].Preq] >= tsApplicable));447 function TDraftDlg.IsFeatureInList(D, I: Integer): Boolean; 448 begin 449 Result := not(I in AutoFeature) and (1 shl D and Feature[I].Domains <> 0) and 450 (Feature[I].Preq <> preNA) and 451 ((Feature[I].Preq = preNone) or (Feature[I].Preq = preSun) and 452 (MyRO.Wonder[woSun].EffectiveOwner = Me) or (Feature[I].Preq >= 0) and 453 (MyRO.Tech[Feature[I].Preq] >= tsApplicable)); 458 454 end; 459 455 460 456 procedure TDraftDlg.FormShow(Sender: TObject); 461 457 var 462 count, d, i: integer;458 count, D, I: Integer; 463 459 begin 464 460 Domain := dGround; 465 461 while (Domain < dAir) and (upgrade[Domain, 0].Preq <> preNone) and 466 462 (MyRO.Tech[upgrade[Domain, 0].Preq] < tsApplicable) do 467 inc(Domain);463 Inc(Domain); 468 464 469 465 // count max number of features in any domain 470 466 MaxLines := 0; 471 for d:= 0 to nDomains - 1 do472 if (upgrade[ d, 0].Preq = preNone) or473 (MyRO.Tech[upgrade[ d, 0].Preq] >= tsApplicable) then467 for D := 0 to nDomains - 1 do 468 if (upgrade[D, 0].Preq = preNone) or 469 (MyRO.Tech[upgrade[D, 0].Preq] >= tsApplicable) then 474 470 begin 475 471 count := 0; 476 for i:= 0 to nFeature - 1 do477 if IsFeatureInList( d, i) then478 inc(count);472 for I := 0 to nFeature - 1 do 473 if IsFeatureInList(D, I) then 474 Inc(count); 479 475 if count > MaxLines then 480 476 MaxLines := count; … … 494 490 495 491 SetDomain(Domain); 496 Server(sCreateDevModel, me, Domain, nil^);492 Server(sCreateDevModel, Me, Domain, nil^); 497 493 MyModel[MyRO.nModel] := MyRO.DevModel; 498 InitMyModel(MyRO.nModel, false);494 InitMyModel(MyRO.nModel, False); 499 495 OffscreenPaint; 500 496 IncCap := -1; … … 502 498 end; 503 499 504 procedure TDraftDlg.ShowNewContent(NewMode: integer);500 procedure TDraftDlg.ShowNewContent(NewMode: TWindowMode); 505 501 begin 506 502 inherited ShowNewContent(NewMode); … … 508 504 509 505 procedure TDraftDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 510 Shift: TShiftState; x, y: integer);506 Shift: TShiftState; X, Y: Integer); 511 507 var 512 i, d: integer;508 I, D: Integer; 513 509 begin 514 510 if Button = mbLeft then 515 511 begin 516 for d:= 0 to nDomains - 1 do517 if ( d <> Domain) and ((upgrade[d, 0].Preq = preNone) or518 (MyRO.Tech[upgrade[ d, 0].Preq] >= tsApplicable)) and519 ( x >= xDomain + d* DomainPitch) and520 ( x < xDomain + d * DomainPitch + 36) and (y>= yDomain) and521 ( y< yDomain + 36) then512 for D := 0 to nDomains - 1 do 513 if (D <> Domain) and ((upgrade[D, 0].Preq = preNone) or 514 (MyRO.Tech[upgrade[D, 0].Preq] >= tsApplicable)) and 515 (X >= xDomain + D * DomainPitch) and 516 (X < xDomain + D * DomainPitch + 36) and (Y >= yDomain) and 517 (Y < yDomain + 36) then 522 518 begin 523 SetDomain( d);524 Server(sCreateDevModel, me, Domain, nil^);519 SetDomain(D); 520 Server(sCreateDevModel, Me, Domain, nil^); 525 521 MyModel[MyRO.nModel] := MyRO.DevModel; 526 InitMyModel(MyRO.nModel, false);522 InitMyModel(MyRO.nModel, False); 527 523 SmartUpdateContent; 528 524 end; 529 525 530 if ( y >= yFeature) and (y< yFeature + LinePitch * Lines) then531 begin 532 i := (y- yFeature) div LinePitch;533 if ( x >= xFeature - 21) and (x< ClientWidth) and (ssShift in Shift) then534 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i])535 else if not( code[i] in AutoFeature) then526 if (Y >= yFeature) and (Y < yFeature + LinePitch * Lines) then 527 begin 528 I := (Y - yFeature) div LinePitch; 529 if (X >= xFeature - 21) and (X < ClientWidth) and (ssShift in Shift) then 530 MainScreen.HelpDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), hkFeature, Code[I]) 531 else if not(Code[I] in AutoFeature) then 536 532 begin 537 if ( code[i] < mcFirstNonCap) and (x>= xFeature - 21) and538 ( x< xFeature - 21 + 12) then533 if (Code[I] < mcFirstNonCap) and (X >= xFeature - 21) and 534 (X < xFeature - 21 + 12) then 539 535 begin 540 IncCap := code[i];541 Dump( offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch *542 i, 12, 12, 182, 172);536 IncCap := Code[I]; 537 Dump(Offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 538 I, 12, 12, 182, 172); 543 539 SmartInvalidate; 544 540 end 545 else if ( x >= xFeature - 9) and (x< xFeature - 9 + 12) then541 else if (X >= xFeature - 9) and (X < xFeature - 9 + 12) then 546 542 begin 547 DecCap := code[i];548 if code[i] < mcFirstNonCap then549 Dump( offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *550 i, 12, 12, 182, 159)543 DecCap := Code[I]; 544 if Code[I] < mcFirstNonCap then 545 Dump(Offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 546 I, 12, 12, 182, 159) 551 547 else 552 Dump( offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *553 i, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[code[i]]);548 Dump(Offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 549 I, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[Code[I]]); 554 550 SmartInvalidate; 555 551 end; 556 end 557 end 558 end 552 end; 553 end; 554 end; 559 555 end; 560 556 561 557 procedure TDraftDlg.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; 562 Shift: TShiftState; x, y: integer);558 Shift: TShiftState; X, Y: Integer); 563 559 var 564 NewValue: integer;560 NewValue: Integer; 565 561 begin 566 562 if IncCap >= 0 then 567 563 begin 568 564 NewValue := MyRO.DevModel.Cap[IncCap] + 1; 569 Server(sSetDevModelCap + NewValue shl 4, me, IncCap, nil^);565 Server(sSetDevModelCap + NewValue shl 4, Me, IncCap, nil^); 570 566 MyModel[MyRO.nModel] := MyRO.DevModel; 571 InitMyModel(MyRO.nModel, false);567 InitMyModel(MyRO.nModel, False); 572 568 SmartUpdateContent; 573 569 IncCap := -1; … … 580 576 if DecCap >= mcFirstNonCap then 581 577 NewValue := -NewValue; 582 Server(sSetDevModelCap + NewValue shl 4, me, DecCap, nil^);578 Server(sSetDevModelCap + NewValue shl 4, Me, DecCap, nil^); 583 579 MyModel[MyRO.nModel] := MyRO.DevModel; 584 InitMyModel(MyRO.nModel, false);580 InitMyModel(MyRO.nModel, False); 585 581 end; 586 582 SmartUpdateContent;
Note:
See TracChangeset
for help on using the changeset viewer.