Changeset 210 for branches/highdpi/LocalPlayer
- Timestamp:
- May 9, 2020, 4:02:07 PM (5 years ago)
- Location:
- branches/highdpi/LocalPlayer
- Files:
-
- 28 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/LocalPlayer/Battle.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Protocol, Messg, ButtonBase, ButtonA, Types, LCLIntf, LCLType,8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg , UDpiControls;7 UDpiControls, ScreenTools, Protocol, ButtonBase, ButtonA, Types, LCLIntf, LCLType, 8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg; 9 9 10 10 type … … 107 107 VLightGradient(ca, xm - 8, ym + 8 + LABaseDamage, LADamage - LABaseDamage, 108 108 FanaticColor); 109 DpiBit Blt(ca.Handle, xm - 12, ym - 12, 24, 24,110 GrExt[HGrSystem].Mask.Canvas .Handle, 26, 146, SRCAND);111 DpiBit Blt(ca.Handle, xm - 12, ym - 12, 24, 24,112 GrExt[HGrSystem].Data.Canvas .Handle, 26, 146, SRCPAINT);109 DpiBitCanvas(ca, xm - 12, ym - 12, 24, 24, 110 GrExt[HGrSystem].Mask.Canvas, 26, 146, SRCAND); 111 DpiBitCanvas(ca, xm - 12, ym - 12, 24, 24, 112 GrExt[HGrSystem].Data.Canvas, 26, 146, SRCPAINT); 113 113 114 114 LabelText := Format('%d', [Forecast.AStr]); … … 132 132 if Forecast.EndHealthDef <= 0 then 133 133 begin 134 DpiBit Blt(ca.Handle, xm + 9 + LDDamage - 7, ym - 6, 14, 17,135 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);136 DpiBit Blt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17,137 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);138 DpiBit Blt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17,139 GrExt[HGrSystem].Data.Canvas .Handle, 51, 153, SRCPAINT);134 DpiBitCanvas(ca, xm + 9 + LDDamage - 7, ym - 6, 14, 17, 135 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 136 DpiBitCanvas(ca, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 137 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 138 DpiBitCanvas(ca, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 139 GrExt[HGrSystem].Data.Canvas, 51, 153, SRCPAINT); 140 140 end; 141 141 LabelText := Format('%d', [DDamage]); … … 152 152 if Forecast.EndHealthAtt <= 0 then 153 153 begin 154 DpiBit Blt(ca.Handle, xm - 6, ym + 9 + LADamage - 7, 14, 17,155 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);156 DpiBit Blt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17,157 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);158 DpiBit Blt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17,159 GrExt[HGrSystem].Data.Canvas .Handle, 51, 153, SRCPAINT);154 DpiBitCanvas(ca, xm - 6, ym + 9 + LADamage - 7, 14, 17, 155 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 156 DpiBitCanvas(ca, xm - 7, ym + 8 + LADamage - 7, 14, 17, 157 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 158 DpiBitCanvas(ca, xm - 7, ym + 8 + LADamage - 7, 14, 17, 159 GrExt[HGrSystem].Data.Canvas, 51, 153, SRCPAINT); 160 160 end; 161 161 LabelText := Format('%d', [MyUn[uix].Health - Forecast.EndHealthAtt]); … … 173 173 174 174 NoMap.SetOutput(Buffer); 175 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm + 8 + 4,176 ym - 8 - 12 - 48 , SRCCOPY);175 DpiBitCanvas(Buffer.Canvas, 0, 0, 66, 48, ca, xm + 8 + 4, 176 ym - 8 - 12 - 48); 177 177 { if TerrType<fForest then 178 178 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) … … 185 185 end; } 186 186 NoMap.PaintUnit(1, 0, UnitInfo, 0); 187 DpiBit Blt(ca.Handle, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas.Handle,188 0, 0 , SRCCOPY);189 190 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm - 8 - 4 - 66,191 ym + 8 + 12 , SRCCOPY);187 DpiBitCanvas(ca, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas, 188 0, 0); 189 190 DpiBitCanvas(Buffer.Canvas, 0, 0, 66, 48, ca, xm - 8 - 4 - 66, 191 ym + 8 + 12); 192 192 MakeUnitInfo(me, MyUn[uix], UnitInfo); 193 193 UnitInfo.Flags := UnitInfo.Flags and not unFortified; 194 194 NoMap.PaintUnit(1, 0, UnitInfo, 0); 195 DpiBitBlt(ca.Handle, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas.Handle, 196 0, 0, SRCCOPY); 195 DpiBitCanvas(ca, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas, 0, 0); 197 196 end; { PaintBattleOutcome } 198 197 -
branches/highdpi/LocalPlayer/CityScreen.pas
r193 r210 5 5 6 6 uses 7 {$IFDEF LINUX}7 UDpiControls, {$IFDEF LINUX} 8 8 LMessages, 9 9 {$ENDIF} 10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, UDpiControls,10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, 11 11 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 12 12 ButtonA, ButtonC, Area, GraphType; … … 90 90 91 91 uses 92 Select, Messg, MessgEx, Help, Tribes, Directories, Math ;92 Select, Messg, MessgEx, Help, Tribes, Directories, Math, UPixelPointer, Sound; 93 93 94 94 {$R *.lfm} … … 216 216 Template := TDpiBitmap.Create; 217 217 Template.PixelFormat := pf24bit; 218 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'City.png', gfNoGamma);218 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'City.png', gfNoGamma); 219 219 CityMapTemplate := TDpiBitmap.Create; 220 220 CityMapTemplate.PixelFormat := pf24bit; 221 LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics'+ DirectorySeparator + 'BigCityMap.png', gfNoGamma);221 LoadGraphicFile(CityMapTemplate, GetGraphicsDir + DirectorySeparator + 'BigCityMap.png', gfNoGamma); 222 222 SmallCityMapTemplate := TDpiBitmap.Create; 223 223 SmallCityMapTemplate.PixelFormat := pf24bit; 224 LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics'+ DirectorySeparator + 'SmallCityMap.png',224 LoadGraphicFile(SmallCityMapTemplate, GetGraphicsDir + DirectorySeparator + 'SmallCityMap.png', 225 225 gfNoGamma); 226 226 SmallCityMap := TDpiBitmap.Create; … … 260 260 Back.Canvas.FillRect(0, 0, ClientWidth, ClientHeight); 261 261 262 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,263 MainTexture.Image.Canvas .Handle, 0, 0, SRCCOPY);262 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 263 MainTexture.Image.Canvas, 0, 0); 264 264 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 265 265 end; … … 291 291 Color2 := Colors.Canvas.Pixels[clkAge0 + Age, cliHouse]; 292 292 SmallCityMap.Canvas.FillRect(0, 0, SmallCityMap.Width, SmallCityMap.Height); 293 Dpi bitblt(SmallCityMap.Canvas.Handle, 0, 0, 83, hSmallMap,294 SmallCityMapTemplate.Canvas .Handle, 83 * SizeClass, 0, SRCCOPY);293 DpiBitCanvas(SmallCityMap.Canvas, 0, 0, 83, hSmallMap, 294 SmallCityMapTemplate.Canvas, 83 * SizeClass, 0); 295 295 if IsPort then 296 296 begin 297 Dpi bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap,298 SmallCityMapTemplate.Canvas .Handle, 332 + 15, 0, SRCCOPY);297 DpiBitCanvas(SmallCityMap.Canvas, 83, 0, 15, hSmallMap, 298 SmallCityMapTemplate.Canvas, 332 + 15, 0); 299 299 ImageOp_CCC(SmallCityMap, 0, 0, 83, hSmallMap, Color0, Color1, Color2); 300 300 Color2 := Colors.Canvas.Pixels[clkCity, cliWater]; … … 303 303 else 304 304 begin 305 Dpi bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap,306 SmallCityMapTemplate.Canvas .Handle, 332, 0, SRCCOPY);305 DpiBitCanvas(SmallCityMap.Canvas, 83, 0, 15, hSmallMap, 306 SmallCityMapTemplate.Canvas, 332, 0); 307 307 ImageOp_CCC(SmallCityMap, 0, 0, wSmallMap, hSmallMap, Color0, 308 308 Color1, Color2); … … 311 311 with SmallCityMap.Canvas do 312 312 begin 313 brush.Color := ScreenTools.Colors.Canvas.Pixels[clkAge0 + Age, cliImp];313 Brush.Color := ScreenTools.Colors.Canvas.Pixels[clkAge0 + Age, cliImp]; 314 314 for i := 0 to 29 do 315 315 begin … … 359 359 ZoomCityMap.Canvas.FillRect(0, 0, ZoomCityMap.Width, ZoomCityMap.Height); 360 360 361 Dpi bitblt(ZoomCityMap.Canvas.Handle, 0, 0, wZoomMap, hZoomMap,362 Back.Canvas .Handle, xZoomMap, yZoomMap, SRCCOPY);361 DpiBitCanvas(ZoomCityMap.Canvas, 0, 0, wZoomMap, hZoomMap, 362 Back.Canvas, xZoomMap, yZoomMap); 363 363 if Mode = mImp then begin 364 364 if ZoomArea < 3 then begin … … 442 442 PixelPtr: TPixelPointer; 443 443 begin 444 X := ScaleToVcl(X); 445 Y := ScaleToVcl(Y); 446 W := ScaleToVcl(W); 447 H := ScaleToVcl(H); 444 448 Offscreen.BeginUpdate; 445 PixelPtr .Init(Offscreen, X, Y);449 PixelPtr := PixelPointer(Offscreen, X, Y); 446 450 for YY := 0 to H - 1 do begin 447 451 for XX := 0 to W - 1 do begin … … 498 502 499 503 var 500 x, y, xGr, i, i1,j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix,504 x, y, xGr, i, j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix, 501 505 HappyGain, OptiType, rx, ry, TrueFood, TrueProd, TruePoll: integer; 502 506 av: integer; … … 542 546 RedTex.clTextShade := $0000FF; 543 547 544 Dpibitblt(offscreen.Canvas.Handle, 0, 0, 640, 480, Back.Canvas.Handle, 0, 545 0, SRCCOPY); 546 547 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 548 DpiBitCanvas(offscreen.Canvas, 0, 0, 640, 480, Back.Canvas, 0, 0); 549 550 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 548 551 RisedTextOut(offscreen.Canvas, 42, 7, Caption); 549 552 with offscreen.Canvas do … … 558 561 TextOut(8 + 14 - textwidth(s) div 2, 7, s); 559 562 end; 560 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);563 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 561 564 562 565 if not IsCityAlive then … … 614 617 false, AllowChange and IsCityAlive and 615 618 (c.Status and csResourceWeightsMask = 0)); 616 Dpi bitblt(offscreen.Canvas.Handle, xmArea + 102, 42, 90, 33, Back.Canvas.Handle,617 xmArea + 102, 42 , SRCCOPY);619 DpiBitCanvas(offscreen.Canvas, xmArea + 102, 42, 90, 33, Back.Canvas, 620 xmArea + 102, 42); 618 621 619 622 if IsCityAlive then … … 645 648 else 646 649 xGr := 141; 647 Dpi bitblt(offscreen.Canvas.Handle, xmArea - 192 + 5 + i * d, ymArea - 96 - 29,648 27, 30, GrExt[HGrSystem].Mask.Canvas .Handle, xGr, 171, SRCAND); { shadow }650 DpiBitCanvas(offscreen.Canvas, xmArea - 192 + 5 + i * d, ymArea - 96 - 29, 651 27, 30, GrExt[HGrSystem].Mask.Canvas, xGr, 171, SRCAND); { shadow } 649 652 Sprite(offscreen, HGrSystem, xmArea - 192 + 4 + i * d, ymArea - 96 - 30, 27, 650 653 30, xGr, 171); … … 657 660 begin 658 661 xGr := 1 + 112; 659 Dpi bitblt(offscreen.Canvas.Handle, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27,660 30, GrExt[HGrSystem].Mask.Canvas .Handle, xGr, 171, SRCAND); { shadow }662 DpiBitCanvas(offscreen.Canvas, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27, 663 30, GrExt[HGrSystem].Mask.Canvas, xGr, 171, SRCAND); { shadow } 661 664 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 - i * d, 29, 27, 30, 662 665 xGr, 171); … … 803 806 804 807 // small map 805 Dpi bitblt(offscreen.Canvas.Handle, xSmallMap, ySmallMap, wSmallMap, hSmallMap,806 SmallCityMap.Canvas .Handle, 0, 0, SRCCOPY);808 DpiBitCanvas(offscreen.Canvas, xSmallMap, ySmallMap, wSmallMap, hSmallMap, 809 SmallCityMap.Canvas, 0, 0); 807 810 if Mode = mImp then 808 811 Frame(offscreen.Canvas, xSmallMap + 48 * (ZoomArea div 3), … … 831 834 Sprite(offscreen, HGrSystem, x + 6, y - 5, 10, 10, 154, 126); 832 835 833 Dpi bitblt(offscreen.Canvas.Handle, xZoomMap, yZoomMap, wZoomMap, hZoomMap,834 ZoomCityMap.Canvas .Handle, 0, 0, SRCCOPY);836 DpiBitCanvas(offscreen.Canvas, xZoomMap, yZoomMap, wZoomMap, hZoomMap, 837 ZoomCityMap.Canvas, 0, 0); 835 838 836 839 for i := 0 to 5 do … … 1620 1623 with Canvas do 1621 1624 begin 1622 Dpi bitblt(Canvas.Handle, xView + 5, yView + 1, 64, 2, Back.Canvas.Handle,1623 xView + 5, yView + 1 , SRCCOPY);1624 Dpi bitblt(Canvas.Handle, xView + 5, yView + 3, 2, 42, Back.Canvas.Handle,1625 xView + 5, yView + 3 , SRCCOPY);1626 Dpi bitblt(Canvas.Handle, xView + 5 + 62, yView + 3, 2, 42,1627 Back.Canvas .Handle, xView + 5 + 62, yView + 3, SRCCOPY);1625 DpiBitCanvas(Canvas, xView + 5, yView + 1, 64, 2, Back.Canvas, 1626 xView + 5, yView + 1); 1627 DpiBitCanvas(Canvas, xView + 5, yView + 3, 2, 42, Back.Canvas, 1628 xView + 5, yView + 3); 1629 DpiBitCanvas(Canvas, xView + 5 + 62, yView + 3, 2, 42, 1630 Back.Canvas, xView + 5 + 62, yView + 3); 1628 1631 ScreenTools.Frame(Canvas, xView + 9 - 1, yView + 5 - 1, xView + 9 + xSizeBig, 1629 1632 yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 1630 1633 RFrame(Canvas, xView + 9 - 2, yView + 5 - 2, xView + 9 + xSizeBig + 1, 1631 1634 yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 1632 brush.Color := $000000;1635 Brush.Color := $000000; 1633 1636 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 1634 1637 yView + 5 + 40)); 1635 brush.style := bsClear;1638 Brush.style := bsClear; 1636 1639 end 1637 1640 else if BlinkTime = 6 then … … 1644 1647 else if c.Project and cpImp = 0 then 1645 1648 begin // project is unit 1646 Dpi bitblt(Canvas.Handle, xView + 9, yView + 5, xSizeBig, ySizeBig,1647 bigimp.Canvas.Handle, 0, 0, SRCCOPY);1649 DpiBitCanvas(Canvas, xView + 9, yView + 5, xSizeBig, ySizeBig, 1650 Bigimp.Canvas, 0, 0); 1648 1651 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1649 1652 Sprite(Canvas, HGr, xView + 5, yView + 1, 64, 44, pix mod 10 * 65 + 1, -
branches/highdpi/LocalPlayer/CityType.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType,7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType, 8 8 SysUtils, Classes, Graphics, Controls, Forms, 9 9 ButtonB, ExtCtrls; … … 39 39 CityTypeDlg: TCityTypeDlg; 40 40 41 42 41 implementation 43 42 44 uses 45 Help, UDpiControls; 43 uses Help; 46 44 47 45 {$R *.lfm} … … 116 114 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelLight, 117 115 MainTexture.clBevelShade); 118 DpiBitBlt(offscreen.Canvas.Handle, xSwitch + 2 + i * 42, ySwitch + 2, 119 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, (i + 3) * xSizeSmall, 120 0, SRCCOPY) 116 DpiBitCanvas(offscreen.Canvas, xSwitch + 2 + i * 42, ySwitch + 2, 117 xSizeSmall, ySizeSmall, SmallImp.Canvas, (i + 3) * xSizeSmall, 0); 121 118 end; 122 119 RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2, … … 151 148 yList + 16 + ySizeSmall div 2 + i div nListCol * 32, 152 149 MainTexture.clBevelLight, MainTexture.clBevelShade); 153 DpiBit Blt(offscreen.Canvas.Handle, xList + 21 - xSizeSmall div 2 +150 DpiBitCanvas(offscreen.Canvas, xList + 21 - xSizeSmall div 2 + 154 151 i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32, 155 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,152 xSizeSmall, ySizeSmall, SmallImp.Canvas, 156 153 MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall, 157 154 (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 * 158 ySizeSmall , SRCCOPY);155 ySizeSmall); 159 156 inc(i); 160 157 end; … … 174 171 nPool div nPoolCol * 32, MainTexture.clBevelLight, 175 172 MainTexture.clBevelShade); 176 DpiBit Blt(offscreen.Canvas.Handle, xPool + 21 - xSizeSmall div 2 +173 DpiBitCanvas(offscreen.Canvas, xPool + 21 - xSizeSmall div 2 + 177 174 nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 + 178 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,175 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas, 179 176 iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 * 180 ySizeSmall , SRCCOPY);181 inc(nPool) 177 ySizeSmall); 178 inc(nPool); 182 179 end; 183 180 DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0; … … 254 251 begin 255 252 dragiix := MyData.ImpOrder[ctype, i]; 256 Screen.Cursor := crImpDrag;253 DpiScreen.Cursor := crImpDrag; 257 254 SmartUpdateContent 258 255 end; … … 270 267 begin 271 268 dragiix := Pooliix[i]; 272 Screen.Cursor := crImpDrag;269 DpiScreen.Cursor := crImpDrag; 273 270 SmartUpdateContent 274 271 end; … … 332 329 SmartUpdateContent 333 330 end; 334 Screen.Cursor := crDefault331 DpiScreen.Cursor := crDefault 335 332 end; 336 333 -
branches/highdpi/LocalPlayer/ClientTools.pas
r70 r210 695 695 initialization 696 696 697 assert(nImp < 128);697 Assert(nImp < 128); 698 698 CalculateAdvValues; 699 699 -
branches/highdpi/LocalPlayer/Diagram.pas
r193 r210 5 5 6 6 uses 7 BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,8 ButtonB, Menus , UDpiControls;7 UDpiControls, BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 8 ButtonB, Menus; 9 9 10 10 type -
branches/highdpi/LocalPlayer/Draft.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 9 10 ButtonA, … … 91 92 Template := TDpiBitmap.Create; 92 93 Template.PixelFormat := pf24bit; 93 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'MiliRes.png', gfNoGamma);94 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'MiliRes.png', gfNoGamma); 94 95 end; 95 96 … … 238 239 // assemble background from 2 texture tiles 239 240 begin 240 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, 64,241 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,242 hMainTexture - 64 , SRCCOPY);243 Dpi bitblt(Back.Canvas.Handle, 0, 64, ClientWidth, ClientHeight - 64,244 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,245 0 , SRCCOPY);241 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, 64, 242 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 243 hMainTexture - 64); 244 DpiBitCanvas(Back.Canvas, 0, 64, ClientWidth, ClientHeight - 64, 245 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 246 0); 246 247 end 247 248 else 248 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,249 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,250 (hMainTexture - ClientHeight) div 2 , SRCCOPY);249 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 250 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 251 (hMainTexture - ClientHeight) div 2); 251 252 ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64); 252 253 ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width, 253 254 Template.Height - 64 - Cut); 254 255 255 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,256 Back.Canvas .Handle, 0, 0, SRCCOPY);256 DpiBitCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 257 Back.Canvas, 0, 0); 257 258 258 259 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); -
branches/highdpi/LocalPlayer/Enhance.pas
r179 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, ClientTools, Term, LCLIntf, LCLType,7 UDpiControls, ScreenTools, BaseWin, Protocol, ClientTools, Term, LCLIntf, LCLType, 8 8 9 9 SysUtils, Classes, Graphics, Controls, Forms, … … 45 45 EnhanceDlg: TEnhanceDlg; 46 46 47 48 47 implementation 49 48 50 uses 51 Help, UDpiControls; 49 uses Help; 52 50 53 51 {$R *.lfm} … … 98 96 for i := 0 to ControlCount - 1 do 99 97 if Controls[i] is TButtonC then 100 DpiBit Blt(Canvas.Handle, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8,101 GrExt[HGrSystem].Data.Canvas .Handle, 121 + Controls[i].Tag mod 7 * 9,102 1 + Controls[i].Tag div 7 * 9 , SRCCOPY);98 DpiBitCanvas(Canvas, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8, 99 GrExt[HGrSystem].Data.Canvas, 121 + Controls[i].Tag mod 7 * 9, 100 1 + Controls[i].Tag div 7 * 9); 103 101 end; 104 102 -
branches/highdpi/LocalPlayer/Help.lfm
r193 r210 1 1 object HelpDlg: THelpDlg 2 2 Left = 394 3 Height = 7184 3 Top = 180 5 Width = 8406 4 BorderIcons = [] 7 5 BorderStyle = bsNone 8 ClientHeight = 7189 ClientWidth = 8406 ClientHeight = 479 7 ClientWidth = 560 10 8 Color = clBtnFace 11 DesignTimePPI = 1449 Font.Charset = DEFAULT_CHARSET 12 10 Font.Color = clWindowText 13 Font.Height = - 2011 Font.Height = -13 14 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 15 14 FormStyle = fsStayOnTop 16 15 OnClose = FormClose … … 18 17 OnDestroy = FormDestroy 19 18 OnKeyDown = FormKeyDown 19 OnMouseWheel = FormMouseWheel 20 20 OnMouseDown = PaintBox1MouseDown 21 21 OnMouseMove = PaintBox1MouseMove 22 OnMouseWheel = FormMouseWheel23 22 OnPaint = FormPaint 24 LCLVersion = '2.0.8.0'23 PixelsPerInch = 96 25 24 object CloseBtn: TButtonB 26 Left = 78327 Height = 3828 Top = 929 Width = 3825 Left = 522 26 Top = 6 27 Width = 25 28 Height = 25 30 29 Down = False 31 30 Permanent = False … … 34 33 end 35 34 object BackBtn: TButtonB 36 Left = 6337 Height = 3838 Top = 939 Width = 3835 Left = 42 36 Top = 6 37 Width = 25 38 Height = 25 40 39 Down = False 41 40 Permanent = False … … 44 43 end 45 44 object TopBtn: TButtonB 46 Left = 2047 Height = 3848 Top = 949 Width = 3845 Left = 13 46 Top = 6 47 Width = 25 48 Height = 25 50 49 Down = False 51 50 Permanent = False … … 54 53 end 55 54 object SearchBtn: TButtonB 56 Left = 74057 Height = 3858 Top = 959 Width = 3855 Left = 493 56 Top = 6 57 Width = 25 58 Height = 25 60 59 Down = False 61 60 Permanent = False -
branches/highdpi/LocalPlayer/Help.pas
r193 r210 5 5 6 6 uses 7 Protocol, ScreenTools, BaseWin, StringTables, Math, UDpiControls,8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,9 ExtCtrls, ButtonB, PVSB, Types;7 UDpiControls, Protocol, ScreenTools, BaseWin, StringTables, Math, LCLIntf, LCLType, 8 Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 9 ButtonB, PVSB, Types, fgl; 10 10 11 11 const … … 41 41 THyperText = class(TStringList) 42 42 public 43 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: integer = 0;43 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: Integer = 0; 44 44 LinkCategory: integer = 0; LinkIndex: integer = 0); 45 procedure LF; 45 procedure LineFeed; 46 procedure AppendList(Source: THyperText); 46 47 destructor Destroy; override; 48 end; 49 50 { THistItem } 51 52 THistItem = class 53 Kind: Integer; 54 No: Integer; 55 Pos: Integer; 56 SearchContent: string; 57 procedure Assign(Source: THistItem); 58 end; 59 60 { THistItems } 61 62 THistItems = class(TFPGObjectList<THistItem>) 63 function AddNew(Kind, No, Pos: Integer; SearchContent: string): THistItem; 47 64 end; 48 65 … … 72 89 procedure OffscreenPaint; override; 73 90 private 74 Kind, no, Sel, nHist, CaptionColor: integer; 75 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, 76 hJOBHELP: integer; 77 SearchContent, NewSearchContent: string; 91 Kind: Integer; 92 no: Integer; 93 Sel: Integer; 94 CaptionColor: Integer; 95 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, hJOBHELP: Integer; 96 SearchContent: string; 97 NewSearchContent: string; 78 98 CaptionFont: TDpiFont; 79 MainText, SearchResult: THyperText; 99 MainText: THyperText; 100 SearchResult: THyperText; 80 101 HelpText: TStringTable; 81 102 ExtPic, TerrIcon: TDpiBitmap; 82 sb: TPVScrollbar; 83 x0: array [-2 .. 180] of integer; 84 HistKind: array [0 .. MaxHist - 1] of integer; 85 HistNo: array [0 .. MaxHist - 1] of integer; 86 HistPos: array [0 .. MaxHist - 1] of integer; 87 HistSearchContent: array [0 .. MaxHist - 1] of shortstring; 103 ScrollBar: TPVScrollbar; 104 x0: array [-2..180] of Integer; 105 procedure PaintTerrIcon(x, y, xSrc, ySrc: Integer); 88 106 procedure ScrollBarUpdate(Sender: TObject); 89 procedure line(ca: TDpiCanvas; i: integer; lit: boolean); 90 procedure Prepare(sbPos: integer = 0); 91 procedure WaterSign(x0, y0, iix: integer); 107 procedure Line(ca: TDpiCanvas; i: Integer; lit: Boolean); 108 procedure Prepare(sbPos: Integer = 0); 109 procedure ShowNewContentProcExecute(NewMode: Integer; HelpContext: string); 110 procedure WaterSign(x0, y0, iix: Integer); 92 111 procedure Search(SearchString: string); 93 112 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 94 113 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 95 114 public 96 Difficulty: integer;97 procedure ShowNewContent(NewMode, Category, Index: integer);115 HistItems: THistItems; 116 Difficulty: Integer; 98 117 procedure ClearHistory; 99 function TextIndex(Item: string): integer; 118 procedure ShowNewContent(NewMode, Category, Index: Integer); 119 function TextIndex(Item: string): Integer; 100 120 end; 101 121 … … 103 123 HelpDlg: THelpDlg; 104 124 125 105 126 implementation 106 127 107 128 uses 108 Directories, ClientTools, Term, Tribes, Inp, Messg ;129 Directories, ClientTools, Term, Tribes, Inp, Messg, UPixelPointer, Global; 109 130 110 131 {$R *.lfm} 111 132 112 133 type 134 135 { THelpLineInfo } 136 113 137 THelpLineInfo = class 114 Format, Picpix: Byte; 138 Format: Byte; 139 Picpix: Byte; 115 140 Link: Word; 116 end; 141 procedure Assign(Source: THelpLineInfo); 142 end; 143 144 { THelpLineInfo } 145 146 procedure THelpLineInfo.Assign(Source: THelpLineInfo); 147 begin 148 Format := Source.Format; 149 PicPix := Source.PicPix; 150 Link := Source.Link; 151 end; 152 153 { THistItem } 154 155 procedure THistItem.Assign(Source: THistItem); 156 begin 157 Kind := Source.Kind; 158 No := Source.No; 159 Pos := Source.Pos; 160 SearchContent := Source.SearchContent; 161 end; 162 163 { THistItems } 164 165 function THistItems.AddNew(Kind, No, Pos: Integer; SearchContent: string 166 ): THistItem; 167 begin 168 Result := THistItem.Create; 169 Result.Kind := Kind; 170 Result.No := No; 171 Result.Pos := Pos; 172 Result.SearchContent := SearchContent; 173 Add(Result); 174 end; 117 175 118 176 procedure THyperText.AddLine(s: String; Format: integer; Picpix: integer; … … 130 188 end; 131 189 132 procedure THyperText.L F;190 procedure THyperText.LineFeed; 133 191 begin 134 192 AddLine; 193 end; 194 195 procedure THyperText.AppendList(Source: THyperText); 196 var 197 I: Integer; 198 HelpLineInfo: THelpLineInfo; 199 begin 200 for I := 0 to Source.Count - 1 do begin 201 HelpLineInfo := THelpLineInfo.Create; 202 HelpLineInfo.Assign(THelpLineInfo(Source.Objects[I])); 203 AddObject(Source.Strings[I], HelpLineInfo); 204 end; 135 205 end; 136 206 … … 198 268 begin 199 269 inherited; 270 HistItems := THistItems.Create; 271 200 272 CaptionLeft := BackBtn.Left + BackBtn.Width; 201 273 CaptionRight := SearchBtn.Left; … … 205 277 SearchResult := THyperText.Create; 206 278 SearchResult.OwnsObjects := True; 207 sb:= TPVScrollbar.Create(Self);208 sb.SetBorderSpacing(36, 9, 11);209 sb.OnUpdate := ScrollBarUpdate;279 ScrollBar := TPVScrollbar.Create(Self); 280 ScrollBar.SetBorderSpacing(36, 9, 11); 281 ScrollBar.OnUpdate := ScrollBarUpdate; 210 282 211 283 HelpText := TStringTable.Create; … … 218 290 hJOBHELP := HelpText.Gethandle('JOBHELP'); 219 291 220 CaptionFont := TDpiFont.Create;292 CaptionFont := Font.Create; 221 293 CaptionFont.Assign(UniFont[ftNormal]); 222 294 CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold]; … … 233 305 TerrIcon.Canvas.FillRect(0, 0, TerrIcon.Width, TerrIcon.Height); 234 306 SearchContent := ''; 235 nHist := -1; 236 end; 237 238 procedure THelpDlg.ClearHistory; 239 begin 240 nHist := -1; 307 ShowNewContentProc := ShowNewContentProcExecute; 308 end; 309 310 procedure THelpDlg.ShowNewContentProcExecute(NewMode: Integer; 311 HelpContext: string); 312 begin 313 HelpDlg.ShowNewContent(NewMode, hkText, 314 HelpDlg.TextIndex(HelpContext)) 241 315 end; 242 316 243 317 procedure THelpDlg.FormDestroy(Sender: TObject); 244 318 begin 245 FreeAndNil(sb); 319 ShowNewContentProc := nil; 320 FreeAndNil(ScrollBar); 246 321 FreeAndNil(MainText); 247 322 FreeAndNil(SearchResult); … … 250 325 FreeAndNil(HelpText); 251 326 // FreeAndNil(CaptionFont); 327 FreeAndNil(HistItems); 252 328 end; 253 329 … … 255 331 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 256 332 begin 257 if sb.ProcessMouseWheel(WheelDelta) then begin333 if ScrollBar.ProcessMouseWheel(WheelDelta) then begin 258 334 PaintBox1MouseMove(nil, [], MousePos.X - Left, 259 335 MousePos.Y - Top); … … 269 345 begin 270 346 { TODO: Handled by MouseWheel event 271 if sb.Process(m) then begin347 if ScrollBar.Process(m) then begin 272 348 Sel := -1; 273 349 SmartUpdateContent(true) … … 279 355 begin 280 356 if Sel <> -1 then begin 281 line(Canvas, Sel, false);357 Line(Canvas, Sel, false); 282 358 Sel := -1 283 359 end 284 360 end; 285 361 362 procedure THelpDlg.ClearHistory; 363 begin 364 HistItems.Clear; 365 end; 366 286 367 procedure THelpDlg.FormPaint(Sender: TObject); 287 368 begin … … 290 371 end; 291 372 292 procedure THelpDlg. line(ca: TDpiCanvas; i: integer; lit: boolean);373 procedure THelpDlg.Line(ca: TDpiCanvas; i: Integer; lit: Boolean); 293 374 var 294 TextColor, x, y: integer;375 TextColor, x, y: Integer; 295 376 TextSize: TSize; 296 377 s: string; 297 378 begin 298 s := MainText[ sb.Position + i];379 s := MainText[ScrollBar.Position + i]; 299 380 if s = '' then 300 exit;381 Exit; 301 382 x := x0[i]; 302 383 y := 2 + i * 24; … … 306 387 y := y + WideFrame 307 388 end; 308 if THelpLineInfo(MainText.Objects[ sb.Position + i]).Format389 if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format 309 390 in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then 310 391 begin … … 315 396 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 316 397 ca.Brush.Style:=bsClear; } 317 DpiBit Blt(ca.Handle, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas.Handle, 1,318 146 , SRCCOPY);398 DpiBitCanvas(ca, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas, 1, 399 146); 319 400 BiColorTextOut(ca, $FFFFFF, $7F007F, x + 10 - ca.Textwidth(s[1]) div 2, 320 401 y - 3, s[1]); … … 322 403 ca.Font.Assign(UniFont[ftNormal]); 323 404 end 324 else if THelpLineInfo(MainText.Objects[ sb.Position + i]).Format = pkSection405 else if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format = pkSection 325 406 then 326 407 begin … … 341 422 TextSize.cy := WideFrame + InnerHeight - y; 342 423 FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame, 343 sb.Position * 24 - WideFrame, Paper);424 ScrollBar.Position * 24 - WideFrame, Paper); 344 425 end; 345 426 BiColorTextOut(ca, TextColor, $7F007F, x, y, s); … … 347 428 with ca do 348 429 begin 349 assert(ca = Canvas);350 pen.color := TextColor;351 moveto(x + 1, y + TextSize.cy - 2);352 lineto(x + TextSize.cx, y + TextSize.cy - 2);430 Assert(ca = Canvas); 431 Pen.Color := TextColor; 432 MoveTo(x + 1, y + TextSize.cy - 2); 433 LineTo(x + TextSize.cx, y + TextSize.cy - 2); 353 434 end; 354 435 if (Kind = hkMisc) and (no = miscMain) then … … 363 444 var 364 445 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 365 Heaven: array [0 ..nHeaven] of integer;446 Heaven: array [0..nHeaven] of integer; 366 447 PaintPtr, CoalPtr: TPixelPointer; 367 ImpPtr: array [-1 .. 1] of TPixelPointer; 368 begin 369 { TODO 448 ImpPtr: array [-1..1] of TPixelPointer; 449 begin 370 450 // assume eiffel tower has free common heaven 371 451 for dy := 0 to nHeaven - 1 do … … 377 457 xSrc := iix mod 7 * xSizeBig; 378 458 ySrc := (iix div 7 + 1) * ySizeBig; 379 for y := 0 to ScaleToVcl(ySizeBig * 2)- 1 do459 for y := 0 to ySizeBig * 2 - 1 do 380 460 if ((y0 + y) >= 0) and ((y0 + y) < InnerHeight) then begin 381 PaintPtr .Init(OffScreen, 0, ScaleToVcl(y0 + y));382 CoalPtr .Init(Templates, 0, ScaleToVcl(yCoal + y));461 PaintPtr := PixelPointer(OffScreen, 0, y0 + y); 462 CoalPtr := PixelPointer(Templates, 0, yCoal + y); 383 463 for dy := -1 to 1 do 384 464 if ((Max(y + dy, 0) shr 1) >= 0) and ((Max(y + dy, 0) shr 1) < ySizeBig) then 385 ImpPtr[dy] .Init(BigImp, 0, ScaleToVcl(ySrc + (Max(y + dy, 0) shr 1)));386 for x := 0 to ScaleToVcl(xSizeBig * 2)- 1 do begin465 ImpPtr[dy] := PixelPointer(BigImp, 0, ySrc + (Max(y + dy, 0) shr 1)); 466 for x := 0 to xSizeBig * 2 - 1 do begin 387 467 sum := 0; 388 468 for dx := -1 to 1 do begin … … 413 493 Offscreen.EndUpdate; 414 494 BigImp.EndUpdate; 415 } 495 end; 496 497 procedure THelpDlg.PaintTerrIcon(x, y, xSrc, ySrc: integer); 498 begin 499 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 500 $000000, $000000); 501 if 2 * yyt < 40 then begin 502 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 503 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 504 xSrc, ySrc); 505 end else 506 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 507 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 508 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 509 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 510 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 511 xSrc, ySrc); 416 512 end; 417 513 418 514 procedure THelpDlg.OffscreenPaint; 419 420 procedure PaintTerrIcon(x, y, xSrc, ySrc: integer);421 begin422 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig,423 $000000, $000000);424 if 2 * yyt < 40 then425 begin426 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc);427 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt,428 xSrc, ySrc);429 end430 else431 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);432 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt);433 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc);434 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt);435 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt,436 xSrc, ySrc);437 end;438 439 515 var 440 i, j, yl, srcno, ofs, cnt, y: integer;516 i, j, yl, srcno, ofs, cnt, y: Integer; 441 517 s: string; 442 518 HelpLineInfo: THelpLineInfo; … … 445 521 CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption]; 446 522 FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0, 447 sb.Position * 24, Paper);523 ScrollBar.Position * 24, Paper); 448 524 with OffScreen.Canvas do 449 525 begin 450 526 Font.Assign(UniFont[ftNormal]); 451 for i := - sb.Position to InnerHeight div 24 do452 if sb.Position + i < MainText.Count then527 for i := -ScrollBar.Position to InnerHeight div 24 do 528 if ScrollBar.Position + i < MainText.Count then 453 529 begin 454 HelpLineInfo := THelpLineInfo(MainText.Objects[ sb.Position + i]);530 HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]); 455 531 if HelpLineInfo.Format = pkExternal then 456 532 begin … … 458 534 if 4 + i * 24 + yl > InnerHeight then 459 535 yl := InnerHeight - (4 + i * 24); 460 DpiBit Blt(Handle, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas.Handle,461 0, 0 , SRCCOPY);536 DpiBitCanvas(OffScreen.Canvas, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas, 537 0, 0); 462 538 end; 463 539 end; 464 540 for i := -2 to InnerHeight div 24 do 465 if ( sb.Position + i >= 0) and (sb.Position + i < MainText.Count) then541 if (ScrollBar.Position + i >= 0) and (ScrollBar.Position + i < MainText.Count) then 466 542 begin 467 HelpLineInfo := THelpLineInfo(MainText.Objects[ sb.Position + i]);543 HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]); 468 544 if HelpLineInfo.Link <> 0 then 469 545 begin … … 499 575 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 500 576 if HelpLineInfo.Picpix = imPalace then 501 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,502 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,503 0 * xSizeSmall, 1 * ySizeSmall , SRCCOPY)577 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 578 xSizeSmall, ySizeSmall, SmallImp.Canvas, 579 0 * xSizeSmall, 1 * ySizeSmall) 504 580 else 505 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,506 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,581 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 582 xSizeSmall, ySizeSmall, SmallImp.Canvas, 507 583 HelpLineInfo.Picpix mod 7 * xSizeSmall, 508 584 (HelpLineInfo.Picpix + SystemIconLines * 7) div 7 * 509 ySizeSmall , SRCCOPY);585 ySizeSmall); 510 586 x0[i] := x0[i] + (8 + 8 + 36); 511 587 end; … … 566 642 $000000, $000000); 567 643 if AdvIcon[HelpLineInfo.Picpix] < 84 then 568 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,569 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,644 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 645 xSizeSmall, ySizeSmall, SmallImp.Canvas, 570 646 (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 7) mod 7 * 571 647 xSizeSmall, (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 572 7) div 7 * ySizeSmall , SRCCOPY)648 7) div 7 * ySizeSmall) 573 649 else 574 650 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, … … 576 652 295 + (AdvIcon[HelpLineInfo.Picpix] - 84) div 8 * 21); 577 653 j := AdvValue[HelpLineInfo.Picpix] div 1000; 578 DpiBit Blt(Handle, x0[i] + 4, 4 + i * 24, 14, 14,579 GrExt[HGrSystem].Mask.Canvas .Handle, 127 + j * 15, 85, SRCAND);654 DpiBitCanvas(OffScreen.Canvas, x0[i] + 4, 4 + i * 24, 14, 14, 655 GrExt[HGrSystem].Mask.Canvas, 127 + j * 15, 85, SRCAND); 580 656 Sprite(OffScreen, HGrSystem, x0[i] + 3, 3 + i * 24, 14, 14, 581 657 127 + j * 15, 85); … … 753 829 ScreenTools.Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 754 830 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 755 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, xSizeSmall,756 ySizeSmall, SmallImp.Canvas .Handle, (HelpLineInfo.Picpix - 1) *757 xSizeSmall, ySizeSmall , SRCCOPY);831 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, xSizeSmall, 832 ySizeSmall, SmallImp.Canvas, (HelpLineInfo.Picpix - 1) * 833 xSizeSmall, ySizeSmall); 758 834 x0[i] := x0[i] + (8 + 8 + 36); 759 835 end; … … 769 845 x0[i] := 64 + 8 + 8; 770 846 else 771 x0[i] := x0[i] + 8 847 x0[i] := x0[i] + 8; 772 848 end; 773 Self. line(OffScreen.Canvas, i, false)849 Self.Line(OffScreen.Canvas, i, False) 774 850 end; 775 851 end; 776 852 MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48); 777 end; { OffscreenPaint }853 end; 778 854 779 855 procedure THelpDlg.ScrollBarUpdate(Sender: TObject); … … 785 861 procedure THelpDlg.Prepare(sbPos: integer = 0); 786 862 var 787 i, j, special, Domain, Headline, TerrType, TerrSubType: integer;863 i, j, Special, Domain, Headline, TerrType, TerrSubType: integer; 788 864 s: string; 789 865 ps: pchar; 790 866 List: THyperText; 791 CheckSeeAlso: boolean;792 793 procedure AddAdv (i: integer);867 CheckSeeAlso: Boolean; 868 869 procedure AddAdvance(i: integer); 794 870 begin 795 871 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, … … 803 879 end; 804 880 805 procedure AddImp (i: integer);881 procedure AddImprovement(i: integer); 806 882 begin 807 883 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, … … 815 891 end; 816 892 817 procedure AddTer (i: integer);893 procedure AddTerrain(i: integer); 818 894 begin 819 895 if MainText.Count > 1 then 820 896 begin 821 MainText.L F;897 MainText.LineFeed; 822 898 end; 823 899 MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i); … … 836 912 begin 837 913 if MainText.Count > 1 then 838 MainText.L F;914 MainText.LineFeed; 839 915 FindStdModelPicture(SpecialModelPictureCode[i], pix, Name); 840 916 MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i) … … 850 926 begin 851 927 AddLine('', pkLogo); 852 L F;928 LineFeed; 853 929 end 854 930 else if Item = 'TECHFORMULA' then … … 866 942 for i := 1 to 3 do 867 943 begin 868 L F;944 LineFeed; 869 945 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i); 870 946 end … … 877 953 end; 878 954 879 procedure DecodeItem(s: string; var Category, Index: integer);955 procedure DecodeItem(s: string; var Category, Index: Integer); 880 956 var 881 i: integer; 882 begin 883 if (length(s) > 0) and (s[1] = ':') then 884 begin 957 i: Integer; 958 begin 959 if (Length(s) > 0) and (s[1] = ':') then begin 885 960 Category := hkMisc; 886 961 Index := 0; 887 962 for i := 3 to length(s) do 888 Index := Index * 10 + ord(s[i]) - 48;963 Index := Index * 10 + Ord(s[i]) - 48; 889 964 case s[2] of 890 'A': 891 Category := hkAdv; 892 'B': 893 Category := hkImp; 894 'T': 895 Category := hkTer; 896 'F': 897 Category := hkFeature; 898 'E': 899 Category := hkInternet; 900 'S': 901 Category := hkModel; 902 'C': 903 Index := miscCredits; 904 'J': 905 Index := miscJobList; 906 'G': 907 Index := miscGovList; 965 'A': Category := hkAdv; 966 'B': Category := hkImp; 967 'T': Category := hkTer; 968 'F': Category := hkFeature; 969 'E': Category := hkInternet; 970 'S': Category := hkModel; 971 'C': Index := miscCredits; 972 'J': Index := miscJobList; 973 'G': Index := miscGovList; 908 974 end; 909 975 if (Category <> hkMisc) and (Index = 0) then 910 976 Index := 200; 911 end 912 else 913 begin 977 end else begin 914 978 Category := hkText; 915 Index := HelpText.Gethandle( copy(s, 1, 255));979 Index := HelpText.Gethandle(Copy(s, 1, 255)); 916 980 end; 917 981 end; … … 935 999 repeat 936 1000 inc(p) 937 until (p > length(s)) or (s[p] = '\');938 Caption := copy(s, 2, p - 2);1001 until (p > Length(s)) or (s[p] = '\'); 1002 Caption := Copy(s, 2, p - 2); 939 1003 Delete(s, 1, p); 940 1004 end … … 944 1008 repeat 945 1009 inc(p) 946 until (p > length(s)) or (s[p] = '\');947 AddStandardBlock( copy(s, 2, p - 2));1010 until (p > Length(s)) or (s[p] = '\'); 1011 AddStandardBlock(Copy(s, 2, p - 2)); 948 1012 Delete(s, 1, p); 949 1013 end 950 1014 else if s[1] = '@' then 951 1015 begin // image 952 if ( length(s) >= 2) and (s[2] = '@') then1016 if (Length(s) >= 2) and (s[2] = '@') then 953 1017 begin // generate from icon 954 1018 Picpix := 0; 955 1019 p := 3; 956 while (p <= length(s)) and (s[p] <> '\') do1020 while (p <= Length(s)) and (s[p] <> '\') do 957 1021 begin 958 Picpix := Picpix * 10 + ord(s[p]) - 48;1022 Picpix := Picpix * 10 + Ord(s[p]) - 48; 959 1023 inc(p) 960 1024 end; … … 962 1026 Picpix := 0; 963 1027 MainText.AddLine('', pkIllu, Picpix); 964 MainText.L F;965 MainText.L F;1028 MainText.LineFeed; 1029 MainText.LineFeed; 966 1030 end 967 1031 else … … 969 1033 p := 1; 970 1034 repeat 971 inc(p)972 until (p > length(s)) or (s[p] = '\');1035 Inc(p) 1036 until (p > Length(s)) or (s[p] = '\'); 973 1037 if LoadGraphicFile(ExtPic, LocalizedFilePath('Help' + 974 DirectorySeparator + copy(s, 2, p - 2)) + '.png') then1038 DirectorySeparator + Copy(s, 2, p - 2)) + '.png') then 975 1039 begin 976 1040 MainText.AddLine('', pkExternal); 977 1041 for i := 0 to (ExtPic.Height - 12) div 24 do 978 MainText.L F;1042 MainText.LineFeed; 979 1043 end; 980 1044 end; … … 989 1053 repeat 990 1054 inc(p) 991 until (p > length(s)) or (s[p] = '\') or (s[p] = ' ');992 DecodeItem( copy(s, 2, p - 2), LinkCategory, LinkIndex);1055 until (p > Length(s)) or (s[p] = '\') or (s[p] = ' '); 1056 DecodeItem(Copy(s, 2, p - 2), LinkCategory, LinkIndex); 993 1057 CurrentFormat := 0; 994 1058 if (LinkCategory <> hkText) and (LinkIndex < 200) then … … 1008 1072 begin 1009 1073 CurrentFormat := pkTer; 1010 Picpix := LinkIndex 1074 Picpix := LinkIndex; 1011 1075 end; 1012 1076 hkFeature: … … 1024 1088 if s[1] = ':' then 1025 1089 LinkCategory := LinkCategory + hkCrossLink; 1026 if (p > length(s)) or (s[p] = ' ') then1090 if (p > Length(s)) or (s[p] = ' ') then 1027 1091 Delete(s, 1, p) 1028 1092 else … … 1030 1094 end; 1031 1095 '!': // highlited 1032 if ( length(s) >= 2) and (s[2] = '!') then1096 if (Length(s) >= 2) and (s[2] = '!') then 1033 1097 begin 1034 1098 if MainText.Count > 1 then 1035 MainText.L F;1099 MainText.LineFeed; 1036 1100 FollowFormat := pkCaption; 1037 1101 CurrentFormat := pkCaption; … … 1060 1124 repeat 1061 1125 repeat 1062 inc(p)1063 until (p > length(s)) or (s[p] = ' ') or (s[p] = '\');1064 if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <=1126 Inc(p) 1127 until (p > Length(s)) or (s[p] = ' ') or (s[p] = '\'); 1128 if (BiColorTextWidth(OffScreen.Canvas, Copy(s, 1, p - 1)) <= 1065 1129 RightMargin - ofs) then 1066 1130 l := p - 1 1067 1131 else 1068 1132 Break; 1069 until (p >= length(s)) or (s[l + 1] = '\');1070 MainText.AddLine( copy(s, 1, l), CurrentFormat, Picpix, LinkCategory,1133 until (p >= Length(s)) or (s[l + 1] = '\'); 1134 MainText.AddLine(Copy(s, 1, l), CurrentFormat, Picpix, LinkCategory, 1071 1135 LinkIndex); 1072 if (l < length(s)) and (s[l + 1] = '\') then1136 if (l < Length(s)) and (s[l + 1] = '\') then 1073 1137 FollowFormat := pkNormal; 1074 1138 Delete(s, 1, l + 1); … … 1082 1146 end; 1083 1147 1084 procedure AddModelText(i: integer);1148 procedure AddModelText(i: Integer); 1085 1149 var 1086 pix: integer;1150 pix: Integer; 1087 1151 s: string; 1088 1152 begin 1089 with MainText do 1090 begin 1091 if Count > 1 then 1092 begin 1093 LF; 1094 LF; 1153 with MainText do begin 1154 if Count > 1 then begin 1155 LineFeed; 1156 LineFeed; 1095 1157 end; 1096 1158 FindStdModelPicture(SpecialModelPictureCode[i], pix, s); … … 1126 1188 procedure AddJobList; 1127 1189 var 1128 i, JobCost: integer; 1129 begin 1130 with MainText do 1131 begin 1132 for i := 0 to nJobHelp - 1 do 1133 begin 1134 if i > 0 then 1135 begin 1136 LF; 1137 LF 1190 i, JobCost: Integer; 1191 begin 1192 with MainText do begin 1193 for i := 0 to nJobHelp - 1 do begin 1194 if i > 0 then begin 1195 LineFeed; 1196 LineFeed; 1138 1197 end; 1139 1198 AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection); … … 1144 1203 JobCost := -1; 1145 1204 case JobHelp[i] of 1146 jCanal: 1147 JobCost := CanalWork; 1148 jFort: 1149 JobCost := FortWork; 1150 jBase: 1151 JobCost := BaseWork; 1205 jCanal: JobCost := CanalWork; 1206 jFort: JobCost := FortWork; 1207 jBase: JobCost := BaseWork; 1152 1208 end; 1153 1209 if JobCost >= 0 then … … 1156 1212 else 1157 1213 AddTextual(HelpText.Lookup('JOBCOSTVAR')); 1158 if JobPreq[JobHelp[i]] <> preNone then 1159 begin 1214 if JobPreq[JobHelp[i]] <> preNone then begin 1160 1215 AddPreqAdv(JobPreq[JobHelp[i]]); 1161 1216 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), … … 1168 1223 procedure AddGraphicCredits; 1169 1224 var 1170 i: integer;1225 i: Integer; 1171 1226 s: string; 1172 1227 sr: TSearchRec; 1173 List, plus: TStringList;1228 List, Plus: TStringList; 1174 1229 begin 1175 1230 List := TStringList.Create; 1176 plus := TStringList.Create;1177 if FindFirst( HomeDir + 'Graphics'+ DirectorySeparator + '*.credits.txt', $27, sr) = 0 then1231 Plus := TStringList.Create; 1232 if FindFirst(GetGraphicsDir + DirectorySeparator + '*.credits.txt', $27, sr) = 0 then 1178 1233 repeat 1179 plus.LoadFromFile(HomeDir + 'Graphics'+ DirectorySeparator + sr.Name);1180 List.AddStrings( plus);1234 Plus.LoadFromFile(GetGraphicsDir + DirectorySeparator + sr.Name); 1235 List.AddStrings(Plus); 1181 1236 until FindNext(sr) <> 0; 1182 1237 FindClose(sr); 1183 plus.Free;1238 Plus.Free; 1184 1239 1185 1240 List.Sort; … … 1189 1244 List.Delete(i) 1190 1245 else 1191 inc(i); 1192 1193 for i := 0 to List.Count - 1 do 1194 begin 1246 Inc(i); 1247 1248 for i := 0 to List.Count - 1 do begin 1195 1249 s := List[i]; 1196 1250 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1204 1258 procedure AddSoundCredits; 1205 1259 var 1206 i: integer;1260 i: Integer; 1207 1261 s: string; 1208 1262 List: TStringList; 1209 1263 begin 1210 1264 List := TStringList.Create; 1211 List.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.credits.txt'); 1212 for i := 0 to List.Count - 1 do 1213 begin 1265 List.LoadFromFile(GetSoundsDir + DirectorySeparator + 'sound.credits.txt'); 1266 for i := 0 to List.Count - 1 do begin 1214 1267 s := List[i]; 1215 1268 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1227 1280 MainText.Delete(Headline) 1228 1281 else 1229 MainText.L F;1282 MainText.LineFeed; 1230 1283 MainText.AddLine(HelpText.Lookup(Item), pkSection); 1231 1284 Headline := MainText.Count - 1; … … 1233 1286 1234 1287 begin { Prepare } 1235 with MainText do 1236 begin 1288 with MainText do begin 1237 1289 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 1238 CheckSeeAlso := false;1290 CheckSeeAlso := False; 1239 1291 Clear; 1240 1292 Headline := -1; 1241 1293 if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then 1242 L F;1294 LineFeed; 1243 1295 case Kind of 1244 1296 hkText: … … 1252 1304 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon, 1253 1305 0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK')); 1254 L F;1306 LineFeed; 1255 1307 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6, 1256 1308 hkText, HelpText.Gethandle('CONCEPTS')); 1257 L F;1309 LineFeed; 1258 1310 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1, 1259 1311 hkTer, 200); 1260 L F;1312 LineFeed; 1261 1313 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2, 1262 1314 hkMisc, miscJobList); 1263 L F;1315 LineFeed; 1264 1316 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39, 1265 1317 hkAdv, 200); 1266 L F;1318 LineFeed; 1267 1319 FindStdModelPicture(SpecialModelPictureCode[6], i, s); 1268 1320 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i, 1269 1321 hkModel, 0); 1270 L F;1322 LineFeed; 1271 1323 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28, 1272 1324 hkFeature, 200); 1273 L F;1325 LineFeed; 1274 1326 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon, 1275 1327 7 * SystemIconLines + imCourt, hkImp, 200); 1276 L F;1328 LineFeed; 1277 1329 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon, 1278 1330 7 * SystemIconLines + imStockEx, hkImp, 201); 1279 L F;1331 LineFeed; 1280 1332 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon, 1281 1333 7 * SystemIconLines, hkImp, 202); 1282 L F;1334 LineFeed; 1283 1335 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon, 1284 1336 gDemocracy + 6, hkMisc, miscGovList); 1285 L F;1337 LineFeed; 1286 1338 AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText, 1287 1339 HelpText.Gethandle('HOTKEYS')); 1288 L F;1340 LineFeed; 1289 1341 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1, 1290 1342 hkText, HelpText.Gethandle('ABOUT')); 1291 L F;1343 LineFeed; 1292 1344 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22, 1293 1345 hkMisc, miscCredits); … … 1296 1348 begin 1297 1349 AddItem('CREDITS'); 1298 L F;1350 LineFeed; 1299 1351 AddGraphicCredits; 1300 1352 NextSection('CRED_CAPSOUND'); … … 1310 1362 Caption := HelpText.Lookup('HELPTITLE_JOBLIST'); 1311 1363 AddJobList; 1312 L F;1364 LineFeed; 1313 1365 AddItem('TERIMPEXCLUDE'); 1314 L F;1366 LineFeed; 1315 1367 AddItem('TERIMPCITY'); 1316 1368 end; … … 1321 1373 begin 1322 1374 AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection); 1323 L F;1375 LineFeed; 1324 1376 if i = nGov then 1325 1377 AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace) 1326 1378 else 1327 1379 AddLine('', pkBigIcon, i + 6); 1328 L F;1380 LineFeed; 1329 1381 AddTextual(HelpText.LookupByHandle(hGOVHELP, i mod nGov)); 1330 1382 if i mod nGov >= 2 then … … 1336 1388 if i < nGov then 1337 1389 begin 1338 L F;1339 L F;1390 LineFeed; 1391 LineFeed; 1340 1392 end 1341 1393 end … … 1345 1397 Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1346 1398 AddTextual(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1347 MainText.A ddStrings(SearchResult);1348 end 1399 MainText.AppendList(SearchResult); 1400 end; 1349 1401 end; // case no 1350 1402 end; … … 1355 1407 Caption := HelpText.Lookup('HELPTITLE_TECHLIST'); 1356 1408 List := THyperText.Create; 1409 List.OwnsObjects := True; 1357 1410 for j := 0 to 3 do 1358 1411 begin 1359 1412 if j > 0 then 1360 1413 begin 1361 L F;1362 L F;1414 LineFeed; 1415 LineFeed; 1363 1416 end; 1364 1417 AddLine(HelpText.Lookup('TECHAGE', j), pkSection); … … 1378 1431 hkAdv, i); 1379 1432 List.Sort; 1380 A ddStrings(List);1433 AppendList(List); 1381 1434 end; 1382 List.Free 1435 List.Free; 1383 1436 end 1384 1437 else // single advance 1385 1438 begin 1386 1439 Caption := Phrases.Lookup('ADVANCES', no); 1387 L F;1440 LineFeed; 1388 1441 AddLine(Phrases.Lookup('ADVANCES', no), pkCaption); 1389 1442 if no in FutureTech then 1390 1443 begin 1391 1444 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1392 L F;1445 LineFeed; 1393 1446 if no = futResearchTechnology then 1394 1447 AddItem('FUTURETECHHELP100') … … 1413 1466 for i := 0 to 27 do 1414 1467 if Imp[i].Preq = no then 1415 AddImp (i);1468 AddImprovement(i); 1416 1469 for i := 28 to nImp - 1 do 1417 1470 if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then 1418 AddImp (i);1471 AddImprovement(i); 1419 1472 for i := 28 to nImp - 1 do 1420 1473 if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then 1421 AddImp (i);1474 AddImprovement(i); 1422 1475 NextSection('MODELALLOW'); 1423 1476 for i := 0 to nSpecialModel - 1 do … … 1432 1485 if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or 1433 1486 (AdvPreq[i, 2] = no) then 1434 AddAdv (i);1487 AddAdvance(i); 1435 1488 NextSection('UPGRADEALLOW'); 1436 1489 for Domain := 0 to nDomains - 1 do … … 1456 1509 for i := 0 to 27 do 1457 1510 if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then 1458 AddImp (i);1511 AddImprovement(i); 1459 1512 NextSection('ADVEFFECT'); 1460 1513 s := HelpText.LookupByHandle(hADVHELP, no); … … 1471 1524 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1472 1525 List := THyperText.Create; 1526 List.OwnsObjects := True; 1473 1527 for i := 28 to nImp - 1 do 1474 1528 if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and … … 1477 1531 i, hkImp, i); 1478 1532 List.Sort; 1479 A ddStrings(List);1480 List.Free 1533 AppendList(List); 1534 List.Free; 1481 1535 end 1482 1536 else if no = 201 then … … 1489 1543 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1490 1544 hkImp, i); 1491 { L F;1492 L F;1545 { LineFeed; 1546 LineFeed; 1493 1547 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1494 1548 for i:=28 to nImp-1 do … … 1508 1562 begin // single building 1509 1563 Caption := Phrases.Lookup('IMPROVEMENTS', no); 1510 L F;1564 LineFeed; 1511 1565 AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no); 1512 1566 case Imp[no].Kind of 1513 ikWonder: 1514 AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1515 ikCommon: 1516 AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1517 ikShipPart: 1518 AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1567 ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1568 ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1569 ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1519 1570 else 1520 1571 AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1521 1572 end; 1522 if Imp[no].Kind <> ikShipPart then 1523 begin 1573 if Imp[no].Kind <> ikShipPart then begin 1524 1574 NextSection('EFFECT'); 1525 1575 AddTextual(HelpText.LookupByHandle(hIMPHELP, no)); 1526 1576 end; 1527 if no = woSun then 1528 begin 1577 if no = woSun then begin 1529 1578 AddFeature(mcFirst); 1530 1579 AddFeature(mcWill); … … 1533 1582 if (no < 28) and not Phrases2FallenBackToEnglish then 1534 1583 begin 1535 L F;1584 LineFeed; 1536 1585 if Imp[no].Expiration >= 0 then 1537 1586 AddTextual(Phrases2.Lookup('HELP_WONDERMORALE1')) … … 1563 1612 j := 1 1564 1613 end; 1565 AddImp (ImpReplacement[i].OldImp);1614 AddImprovement(ImpReplacement[i].OldImp); 1566 1615 end; 1567 1616 if Imp[no].Kind = ikShipPart then 1568 1617 begin 1569 L F;1618 LineFeed; 1570 1619 if no = imShipComp then 1571 1620 i := 1 … … 1588 1637 NextSection('SEEALSO'); 1589 1638 if (no < 28) and (Imp[no].Expiration >= 0) then 1590 AddImp (woEiffel);1639 AddImprovement(woEiffel); 1591 1640 for i := 0 to nImpReplacement - 1 do 1592 1641 if ImpReplacement[i].OldImp = no then 1593 AddImp (ImpReplacement[i].NewImp);1642 AddImprovement(ImpReplacement[i].NewImp); 1594 1643 if no = imSupermarket then 1595 1644 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, … … 1604 1653 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1605 1654 for i := 0 to nTerrainHelp - 1 do 1606 AddTer (TerrainHelp[i]);1655 AddTerrain(TerrainHelp[i]); 1607 1656 end 1608 1657 else … … 1620 1669 begin 1621 1670 Caption := Phrases.Lookup('TERRAIN', no); 1622 L F;1671 LineFeed; 1623 1672 AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no); 1624 1673 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1625 L F;1674 LineFeed; 1626 1675 if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then 1627 1676 AddLine(Format(HelpText.Lookup('RESPROD'), … … 1649 1698 if no = 3 * 12 then 1650 1699 begin 1651 L F;1700 LineFeed; 1652 1701 AddTextual(HelpText.Lookup('DEADLANDS')); 1653 1702 end; 1654 1703 if (TerrType = fDesert) and (no <> fDesert + 12) then 1655 1704 begin 1656 L F;1705 LineFeed; 1657 1706 AddTextual(Format(HelpText.Lookup('HOSTILE'), [DesertThurst])); 1658 1707 end; 1659 1708 if TerrType = fArctic then 1660 1709 begin 1661 L F;1710 LineFeed; 1662 1711 AddTextual(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst])); 1663 1712 end; 1664 1713 if (no < 3 * 12) and (TransTerrain >= 0) then 1665 1714 begin 1666 L F;1715 LineFeed; 1667 1716 i := TransTerrain; 1668 1717 if (TerrType <> fGrass) and (i <> fGrass) then 1669 1718 i := i + TerrSubType * 12; 1670 // trafo to same special resource group1719 // trafo to same Special resource group 1671 1720 AddLine(Format(HelpText.Lookup('TRAFO'), 1672 1721 [Phrases.Lookup('TERRAIN', i)]), pkTer, i, … … 1674 1723 if no = fSwamp + 12 then 1675 1724 begin 1676 L F;1725 LineFeed; 1677 1726 AddLine(Format(HelpText.Lookup('TRAFO'), 1678 1727 [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer, … … 1681 1730 else if i = fGrass then 1682 1731 begin 1683 L F;1732 LineFeed; 1684 1733 AddLine(Format(HelpText.Lookup('TRAFO'), 1685 1734 [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12, … … 1690 1739 if no = 3 * 12 then 1691 1740 begin 1692 L F;1693 for special := 1 to 3 do1741 LineFeed; 1742 for Special := 1 to 3 do 1694 1743 begin 1695 if special > 1 then1696 L F;1697 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer,1698 3 * 12 + special);1744 if Special > 1 then 1745 LineFeed; 1746 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + Special), pkTer, 1747 3 * 12 + Special); 1699 1748 end 1700 1749 end 1701 1750 else if (no < 12) and (no <> fGrass) and (no <> fOcean) then 1702 1751 begin 1703 L F;1704 for special := 1 to 2 do1705 if (no <> fArctic) and (no <> fSwamp) or ( special < 2) then1752 LineFeed; 1753 for Special := 1 to 2 do 1754 if (no <> fArctic) and (no <> fSwamp) or (Special < 2) then 1706 1755 begin 1707 if special > 1 then1708 L F;1709 AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer,1710 no + special * 12);1711 i := FoodRes[ special] - FoodRes[0];1756 if Special > 1 then 1757 LineFeed; 1758 AddLine(Phrases.Lookup('TERRAIN', no + Special * 12), pkTer, 1759 no + Special * 12); 1760 i := FoodRes[Special] - FoodRes[0]; 1712 1761 if i <> 0 then 1713 1762 MainText[Count - 1] := MainText[Count - 1] + 1714 1763 Format(HelpText.Lookup('SPECIALFOOD'), [i]); 1715 i := ProdRes[ special] - ProdRes[0];1764 i := ProdRes[Special] - ProdRes[0]; 1716 1765 if i <> 0 then 1717 1766 MainText[Count - 1] := MainText[Count - 1] + 1718 1767 Format(HelpText.Lookup('SPECIALPROD'), [i]); 1719 i := TradeRes[ special] - TradeRes[0];1768 i := TradeRes[Special] - TradeRes[0]; 1720 1769 if i <> 0 then 1721 1770 MainText[Count - 1] := MainText[Count - 1] + … … 1725 1774 if no = 3 * 12 then 1726 1775 begin 1727 L F;1776 LineFeed; 1728 1777 AddTextual(HelpText.Lookup('RARE')); 1729 1778 end; … … 1731 1780 begin 1732 1781 NextSection('SEEALSO'); 1733 AddImp (woGardens);1782 AddImprovement(woGardens); 1734 1783 CheckSeeAlso := true 1735 1784 end … … 1742 1791 Caption := HelpText.Lookup('HELPTITLE_FEATURELIST'); 1743 1792 List := THyperText.Create; 1744 for special := 0 to 2 do 1793 List.OwnsObjects := True; 1794 for Special := 0 to 2 do 1745 1795 begin 1746 if special > 0 then 1747 begin 1748 LF; 1749 LF 1750 end; 1751 case special of 1752 0: 1753 AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1754 1: 1755 AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1756 2: 1757 AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1796 if Special > 0 then 1797 begin 1798 LineFeed; 1799 LineFeed; 1800 end; 1801 case Special of 1802 0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1803 1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1804 2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1758 1805 end; 1759 1806 List.Clear; … … 1767 1814 else 1768 1815 j := 1; 1769 if j = special then1816 if j = Special then 1770 1817 List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 1771 1818 hkFeature, i); 1772 1819 end; 1773 1820 List.Sort; 1774 A ddStrings(List);1821 AppendList(List); 1775 1822 end; 1776 List.Free 1823 List.Free; 1777 1824 end 1778 1825 else 1779 1826 begin // single feature 1780 1827 Caption := Phrases.Lookup('FEATURES', no); 1781 L F;1828 LineFeed; 1782 1829 AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no); 1783 1830 if no < mcFirstNonCap then … … 1807 1854 if Feature[no].Preq <> preNone then 1808 1855 begin 1809 L F;1856 LineFeed; 1810 1857 if Feature[no].Preq = preSun then 1811 1858 AddPreqImp(woSun) // sun tsu feature … … 1816 1863 end; 1817 1864 NextSection('SEEALSO'); 1818 CheckSeeAlso := true1865 CheckSeeAlso := True; 1819 1866 end; 1820 1867 … … 1825 1872 if i <> 2 then 1826 1873 AddModelText(i); 1827 L F;1874 LineFeed; 1828 1875 AddItem('MODELNOTE'); 1829 1876 end; … … 1834 1881 if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then 1835 1882 case SeeAlso[i].SeeKind of 1836 hkImp: 1837 AddImp(SeeAlso[i].SeeNo); 1838 hkAdv: 1839 AddAdv(SeeAlso[i].SeeNo); 1840 hkFeature: 1841 AddFeature(SeeAlso[i].SeeNo); 1883 hkImp: AddImprovement(SeeAlso[i].SeeNo); 1884 hkAdv: AddAdvance(SeeAlso[i].SeeNo); 1885 hkFeature: AddFeature(SeeAlso[i].SeeNo); 1842 1886 end; 1843 1887 if (Headline >= 0) and (Count = Headline + 1) then 1844 1888 Delete(Headline) 1845 1889 else 1846 L F;1890 LineFeed; 1847 1891 1848 1892 //Self.Show; 1849 sb.Init(Count - 1, InnerHeight div 24);1850 sb.SetPos(sbPos);1851 BackBtn.Visible := nHist > 0;1852 TopBtn.Visible := ( nHist > 0) or (Kind <> hkMisc) or (no <> miscMain);1893 ScrollBar.Init(Count - 1, InnerHeight div 24); 1894 ScrollBar.SetPos(sbPos); 1895 BackBtn.Visible := HistItems.Count > 1; 1896 TopBtn.Visible := (HistItems.Count > 1) or (Kind <> hkMisc) or (no <> miscMain); 1853 1897 Sel := -1; 1854 1898 end; // with MainText 1855 end; { Prepare }1856 1857 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer);1899 end; 1900 1901 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: Integer); 1858 1902 begin 1859 1903 if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and 1860 (Index = miscSearchResult) then 1861 begin 1862 if nHist = MaxHist then 1863 begin 1864 move(HistKind[2], HistKind[1], 4 * (nHist - 2)); 1865 move(HistNo[2], HistNo[1], 4 * (nHist - 2)); 1866 move(HistPos[2], HistPos[1], 4 * (nHist - 2)); 1867 move(HistSearchContent[2], HistSearchContent[1], 1868 sizeof(shortstring) * (nHist - 2)); 1869 end 1870 else 1871 inc(nHist); 1872 if nHist > 0 then 1873 begin 1874 HistKind[nHist - 1] := Kind; 1875 HistNo[nHist - 1] := no; 1876 HistPos[nHist - 1] := sb.Position; 1877 HistSearchContent[nHist - 1] := SearchContent 1878 end 1904 (Index = miscSearchResult) then begin 1905 if HistItems.Count = MaxHist then HistItems.Delete(0); 1906 if HistItems.Count = 0 then 1907 HistItems.AddNew(Category, Index, ScrollBar.Position, NewSearchContent) 1908 else HistItems.AddNew(Kind, No, ScrollBar.Position, SearchContent); 1879 1909 end; 1880 1910 Kind := Category; … … 1889 1919 x, y: integer); 1890 1920 var 1891 i0, Sel0: integer;1921 i0, Sel0: Integer; 1892 1922 begin 1893 1923 y := y - WideFrame; 1894 i0 := sb.Position;1924 i0 := ScrollBar.Position; 1895 1925 Sel0 := Sel; 1896 1926 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and … … 1905 1935 begin 1906 1936 if Sel0 <> -1 then 1907 line(Canvas, Sel0, false);1937 Line(Canvas, Sel0, False); 1908 1938 if Sel <> -1 then 1909 line(Canvas, Sel, true)1939 Line(Canvas, Sel, True) 1910 1940 end 1911 1941 end; … … 1915 1945 begin 1916 1946 if Sel >= 0 then 1917 with THelpLineInfo(MainText.Objects[Sel + sb.Position]) do1947 with THelpLineInfo(MainText.Objects[Sel + ScrollBar.Position]) do 1918 1948 if Link shr 8 and $3F = hkInternet then 1919 1949 case Link and $FF of 1920 1: OpenDocument( pchar(HomeDir + 'AI Template' + DirectorySeparator + 'AI development manual.html'));1921 2: OpenURL( 'http://c-evo.org');1922 3: OpenURL( 'http://c-evo.org/_sg/contact');1950 1: OpenDocument(HomeDir + AITemplateFileName); 1951 2: OpenURL(CevoHomepage); 1952 3: OpenURL(CevoContact); 1923 1953 end 1924 1954 else … … 1934 1964 1935 1965 procedure THelpDlg.BackBtnClick(Sender: TObject); 1936 begin 1937 if nHist > 0 then 1938 begin 1939 dec(nHist); 1940 if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and 1941 (HistSearchContent[nHist] <> SearchContent) then 1966 var 1967 HistItem: THistItem; 1968 begin 1969 if HistItems.Count > 1 then begin 1970 HistItem := THistItem.Create; 1971 HistItem.Assign(HistItems.Last); 1972 HistItems.Delete(HistItems.Count - 1); 1973 if (HistItem.Kind = hkMisc) and (HistItem.No = miscSearchResult) and 1974 (HistItem.SearchContent <> SearchContent) then 1942 1975 begin 1943 SearchContent := Hist SearchContent[nHist];1976 SearchContent := HistItem.SearchContent; 1944 1977 Search(SearchContent); 1945 1978 end; 1946 Kind := Hist Kind[nHist];1947 no := Hist No[nHist];1948 Prepare(Hist Pos[nHist]);1979 Kind := HistItem.Kind; 1980 no := HistItem.No; 1981 Prepare(HistItem.Pos); 1949 1982 OffscreenPaint; 1950 1983 Invalidate; 1951 end 1984 HistItem.Free; 1985 end; 1952 1986 end; 1953 1987 1954 1988 procedure THelpDlg.TopBtnClick(Sender: TObject); 1955 1989 begin 1956 nHist := 0;1990 while HistItems.Count > 1 do HistItems.Delete(HistItems.Count - 1); 1957 1991 Kind := hkMisc; 1958 1992 no := miscMain; … … 1968 2002 end; 1969 2003 1970 function THelpDlg.TextIndex(Item: string): integer;1971 begin 1972 result := HelpText.Gethandle(Item)2004 function THelpDlg.TextIndex(Item: string): Integer; 2005 begin 2006 Result := HelpText.Gethandle(Item) 1973 2007 end; 1974 2008 … … 1987 2021 InputDlg.CenterToRect(BoundsRect); 1988 2022 InputDlg.ShowModal; 1989 if (InputDlg.ModalResult = mrOK) and ( length(InputDlg.EInput.Text) >= 2) then2023 if (InputDlg.ModalResult = mrOK) and (Length(InputDlg.EInput.Text) >= 2) then 1990 2024 begin 1991 2025 Search(InputDlg.EInput.Text); … … 2004 2038 NewSearchContent := InputDlg.EInput.Text; 2005 2039 ShowNewContent(FWindowMode, hkMisc, miscSearchResult); 2006 end 2007 end 2008 end 2040 end; 2041 end; 2042 end; 2009 2043 end; 2010 2044 2011 2045 procedure THelpDlg.Search(SearchString: string); 2012 2046 var 2013 h, i, PrevHandle, PrevIndex, p, RightMargin: integer;2047 h, i, PrevHandle, PrevIndex, p, RightMargin: Integer; 2014 2048 s: string; 2015 2049 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255; 2016 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean;2050 bGOVHELP, bSPECIALMODEL, bJOBHELP: Boolean; 2017 2051 begin 2018 2052 SearchResult.Clear; … … 2020 2054 mIMPHELP := []; 2021 2055 mFEATUREHELP := []; 2022 bGOVHELP := false;2023 bSPECIALMODEL := false;2024 bJOBHELP := false;2056 bGOVHELP := False; 2057 bSPECIALMODEL := False; 2058 bJOBHELP := False; 2025 2059 2026 2060 // search in generic reference 2027 2061 SearchString := UpperCase(SearchString); 2028 for i := 0 to 35 + 4 do 2029 begin 2062 for i := 0 to 35 + 4 do begin 2030 2063 s := Phrases.Lookup('TERRAIN', i); 2031 2064 if pos(SearchString, UpperCase(s)) > 0 then … … 2042 2075 imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'), 2043 2076 pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37); 2044 Break 2045 end 2077 Break; 2078 end; 2046 2079 end; 2047 2080 for i := 0 to nJobHelp - 1 do … … 2051 2084 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2052 2085 hkMisc + hkCrossLink, miscJobList); 2053 bJOBHELP := true;2054 Break 2086 bJOBHELP := True; 2087 Break; 2055 2088 end; 2056 2089 for i := 0 to nAdv - 1 do … … 2065 2098 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i); 2066 2099 include(mADVHELP, i); 2067 end 2100 end; 2068 2101 end; 2069 2102 for i := 0 to nSpecialModel - 1 do … … 2074 2107 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0, 2075 2108 hkModel + hkCrossLink, 0); 2076 bSPECIALMODEL := true;2077 Break 2109 bSPECIALMODEL := True; 2110 Break; 2078 2111 end; 2079 2112 end; … … 2081 2114 begin 2082 2115 s := Phrases.Lookup('FEATURES', i); 2083 if pos(SearchString, UpperCase(s)) > 0 then2116 if Pos(SearchString, UpperCase(s)) > 0 then 2084 2117 begin 2085 2118 if i < mcFirstNonCap then … … 2090 2123 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2091 2124 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2092 include(mFEATUREHELP, i);2093 end 2125 Include(mFEATUREHELP, i); 2126 end; 2094 2127 end; 2095 2128 for i := 0 to nImp - 1 do 2096 2129 begin 2097 2130 s := Phrases.Lookup('IMPROVEMENTS', i); 2098 if pos(SearchString, UpperCase(s)) > 0 then2131 if Pos(SearchString, UpperCase(s)) > 0 then 2099 2132 begin 2100 2133 case Imp[i].Kind of … … 2109 2142 end; 2110 2143 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i); 2111 include(mIMPHELP, i);2144 Include(mIMPHELP, i); 2112 2145 end 2113 2146 end; 2114 2147 for i := 0 to nGov - 1 do 2115 if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then2148 if Pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then 2116 2149 begin 2117 2150 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2118 2151 hkMisc + hkCrossLink, miscGovList); 2119 bGOVHELP := true;2120 Break 2152 bGOVHELP := True; 2153 Break; 2121 2154 end; 2122 2155 … … 2139 2172 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2140 2173 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i) 2141 end 2174 end; 2142 2175 end 2143 2176 else if h = hIMPHELP then … … 2158 2191 end; 2159 2192 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i) 2160 end 2193 end; 2161 2194 end 2162 2195 else if h = hFEATUREHELP then … … 2173 2206 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2174 2207 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2175 end 2208 end; 2176 2209 end 2177 2210 else if h = hGOVHELP then … … 2196 2229 begin 2197 2230 s := HelpText.LookupByHandle(h); 2198 p := pos('$', s);2231 p := Pos('$', s); 2199 2232 if p > 0 then 2200 2233 begin 2201 s := copy(s, p + 1, maxint);2202 p := pos('\', s);2234 s := Copy(s, p + 1, maxint); 2235 p := Pos('\', s); 2203 2236 if p > 0 then 2204 s := copy(s, 1, p - 1);2237 s := Copy(s, 1, p - 1); 2205 2238 SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h); 2206 end 2207 end 2208 until false;2239 end; 2240 end; 2241 until False; 2209 2242 2210 2243 // cut lines to fit to window -
branches/highdpi/LocalPlayer/IsoEngine.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, ScreenTools, Tribes, UDpiControls, 8 {$IFNDEF SCR}Term, {$ENDIF} 9 LCLIntf, LCLType, SysUtils, Classes, Graphics; 7 UDpiControls, Protocol, ClientTools, ScreenTools, Tribes, {$IFNDEF SCR}Term, {$ENDIF} 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer; 10 9 11 10 type … … 24 23 procedure PaintCity(x, y: integer; const CityInfo: TCityInfo; 25 24 accessory: boolean = true); 26 procedure BitBlt (Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,25 procedure BitBltBitmap(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 27 26 Rop: integer); 28 27 … … 40 39 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, 41 40 DefHealth, FAdviceLoc: integer; 42 DataDC, MaskDC: HDC; 41 DataCanvas: TDpiCanvas; 42 MaskCanvas: TDpiCanvas; 43 43 function Connection4(Loc, Mask, Value: integer): integer; 44 44 function Connection8(Loc, Mask: integer): integer; … … 89 89 90 90 // sprites indexes 91 sp DeadLands= 2 * TerrainIconCols + 6;91 spRow2 = 2 * TerrainIconCols + 6; 92 92 spBlink1 = 1 * TerrainIconCols + 8; 93 93 spBlink2 = 2 * TerrainIconCols + 8; … … 107 107 spPollution = 12 * TerrainIconCols + 6; 108 108 spFortBack = 12 * TerrainIconCols + 7; 109 spMinerals = 12 * TerrainIconCols + 8; 109 110 spRiver = 13 * TerrainIconCols; 111 spRiverMouths = 15 * TerrainIconCols; 112 spGrid = 15 * TerrainIconCols + 6; 110 113 spJungle = 18 * TerrainIconCols; 114 spCanalMouths = 20 * TerrainIconCols; 111 115 112 116 var … … 137 141 i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer; 138 142 LandMore, OceanMore, DitherMask, Mask24: TDpiBitmap; 139 MaskLine: array [0 .. 32* 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt143 MaskLine: array [0 .. 50 * 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt 140 144 Border: boolean; 141 145 begin … … 191 195 DitherMask.SetSize(xxt * 2, yyt * 2); 192 196 DitherMask.Canvas.FillRect(0, 0, DitherMask.Width, DitherMask.Height); 193 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,194 GrExt[HGrTerrain].Mask.Canvas .Handle, 1 + 7 * (xxt * 2 + 1),197 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 198 GrExt[HGrTerrain].Mask.Canvas, 1 + 7 * (xxt * 2 + 1), 195 199 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 196 200 … … 213 217 end; 214 218 for y := -1 to 6 do 215 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 216 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 217 SRCCOPY); 219 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 220 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 218 221 for y := -2 to 6 do 219 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt,220 yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,222 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 223 yyt, GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 221 224 SRCPAINT); 222 225 for y := -2 to 6 do 223 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt,224 xxt, yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt,226 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 227 xxt, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, 225 228 SRCPAINT); 226 229 for y := -2 to 6 do 227 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt,228 yyt, DitherMask.Canvas .Handle, xxt, yyt, SRCAND);230 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 231 yyt, DitherMask.Canvas, xxt, yyt, SRCAND); 229 232 for y := -2 to 6 do 230 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt,231 xxt, yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);233 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 234 xxt, yyt, DitherMask.Canvas, 0, yyt, SRCAND); 232 235 end; 233 236 … … 250 253 end; 251 254 for x := -2 to 6 do 252 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 253 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 254 SRCCOPY); 255 BitBlt(LandMore.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt, yyt, 256 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, SRCPAINT); 255 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 256 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 257 DpiBitCanvas(LandMore.Canvas, xxt * 2, (y + 2) * yyt, xxt, yyt, 258 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, SRCPAINT); 257 259 for x := 0 to 7 do 258 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt,259 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt,260 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 261 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, 260 262 SRCPAINT); 261 263 for x := -2 to 6 do 262 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt,263 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, 0, SRCAND);264 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 265 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND); 264 266 end; 265 267 … … 273 275 ySrc := 1 + yyt; 274 276 if (x >= 1) = (y >= 2) then 275 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,276 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc, SRCCOPY);277 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 278 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 277 279 if (x >= 1) and ((y < 2) or (x >= 2)) then 278 280 begin 279 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,280 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,281 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 282 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 281 283 SRCPAINT); 282 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,283 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt, SRCPAINT);284 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 285 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, SRCPAINT); 284 286 end; 285 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,286 DitherMask.Canvas .Handle, xxt, yyt, SRCAND);287 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,288 DitherMask.Canvas .Handle, 0, yyt, SRCAND);287 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 288 DitherMask.Canvas, xxt, yyt, SRCAND); 289 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 290 DitherMask.Canvas, 0, yyt, SRCAND); 289 291 end; 290 292 … … 298 300 ySrc := 1 + yyt; 299 301 if (x < 1) or (y >= 2) then 300 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,301 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc, SRCCOPY);302 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 303 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 302 304 if (x = 1) and (y < 2) or (x >= 2) and (y >= 1) then 303 305 begin 304 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,305 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,306 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 307 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 306 308 SRCPAINT); 307 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,308 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt, SRCPAINT);309 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 310 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, SRCPAINT); 309 311 end; 310 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,311 DitherMask.Canvas .Handle, 0, 0, SRCAND);312 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 313 DitherMask.Canvas, 0, 0, SRCAND); 312 314 end; 313 315 314 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,315 DitherMask.Canvas .Handle, 0, 0, DSTINVERT); { invert dither mask }316 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,317 GrExt[HGrTerrain].Mask.Canvas .Handle, 1, 1 + yyt, SRCPAINT);316 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 317 DitherMask.Canvas, 0, 0, DSTINVERT); { invert dither mask } 318 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 319 GrExt[HGrTerrain].Mask.Canvas, 1, 1 + yyt, SRCPAINT); 318 320 319 321 for x := -1 to 6 do 320 322 for y := -2 to 6 do 321 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt,322 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, 0, SRCAND);323 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 324 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND); 323 325 324 326 for y := -1 to 6 do 325 327 for x := -2 to 7 do 326 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt,327 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);328 329 BitBlt(LandPatch.Canvas.Handle, 0, 0, (xxt * 2) * 9, yyt * 9,330 LandMore.Canvas .Handle, 0, 0, SRCPAINT);328 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 329 xxt * 2, yyt, DitherMask.Canvas, 0, yyt, SRCAND); 330 331 DpiBitCanvas(LandPatch.Canvas, 0, 0, (xxt * 2) * 9, yyt * 9, 332 LandMore.Canvas, 0, 0, SRCPAINT); 331 333 332 334 for x := 0 to 3 do 333 335 for y := 0 to 3 do 334 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,335 DitherMask.Canvas .Handle, 0, 0, SRCAND);336 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 337 DitherMask.Canvas, 0, 0, SRCAND); 336 338 337 339 for y := 0 to 3 do 338 340 for x := 0 to 4 do 339 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) - xxt, y * yyt, xxt * 2,340 yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);341 342 BitBlt(OceanPatch.Canvas.Handle, 0, 0, (xxt * 2) * 4, yyt * 4,343 OceanMore.Canvas .Handle, 0, 0, SRCPAINT);341 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2) - xxt, y * yyt, xxt * 2, 342 yyt, DitherMask.Canvas, 0, yyt, SRCAND); 343 344 DpiBitCanvas(OceanPatch.Canvas, 0, 0, (xxt * 2) * 4, yyt * 4, 345 OceanMore.Canvas, 0, 0, SRCPAINT); 344 346 345 347 with DitherMask.Canvas do … … 348 350 FillRect(Rect(0, 0, xxt * 2, yyt)); 349 351 end; 350 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt,351 GrExt[HGrTerrain].Mask.Canvas .Handle, 1, 1 + yyt, SRCCOPY);352 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt, 353 GrExt[HGrTerrain].Mask.Canvas, 1, 1 + yyt); 352 354 353 355 for x := 0 to 6 do 354 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt,355 DitherMask.Canvas .Handle, 0, 0, SRCAND);356 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, DitherMask.Canvas.Handle,356 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt, 357 DitherMask.Canvas, 0, 0, SRCAND); 358 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt, DitherMask.Canvas, 357 359 0, 0, DSTINVERT); 358 360 359 361 for y := 0 to 6 do 360 BitBlt(LandPatch.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt * 2, yyt,361 DitherMask.Canvas .Handle, 0, 0, SRCAND);362 DpiBitCanvas(LandPatch.Canvas, xxt * 2, (y + 2) * yyt, xxt * 2, yyt, 363 DitherMask.Canvas, 0, 0, SRCAND); 362 364 363 365 LandMore.Free; … … 373 375 begin 374 376 for i := 0 to yyt * 3 - 1 do 375 MaskLine[i] .Init(Mask24, 0, 1 + ySrc * (yyt * 3 + 1) + i);377 MaskLine[i] := PixelPointer(Mask24, 0, 1 + ySrc * (yyt * 3 + 1) + i); 376 378 for xSrc := 0 to 9 - 1 do 377 379 begin … … 422 424 Borders := TDpiBitmap.Create; 423 425 Borders.PixelFormat := pf24bit; 424 Borders.SetSize(xxt * 2, (yyt * 2) * nPl);426 Borders.SetSize(xxt * 2, (yyt * 2) * nPl); 425 427 Borders.Canvas.FillRect(0, 0, Borders.Width, Borders.Height); 426 428 BordersOK := 0; … … 474 476 begin 475 477 Width := Width - (FLeft - x); 476 x := FLeft 478 x := FLeft; 477 479 end; 478 480 if y < FTop then 479 481 begin 480 482 Height := Height - (FTop - y); 481 y := FTop 483 y := FTop; 482 484 end; 483 485 if x + Width >= FRight then … … 499 501 end; 500 502 501 procedure TIsoMap.BitBlt (Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,503 procedure TIsoMap.BitBltBitmap(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 502 504 Rop: integer); 503 505 begin … … 506 508 Width := Width - (FLeft - x); 507 509 xSrc := xSrc + (FLeft - x); 508 x := FLeft 510 x := FLeft; 509 511 end; 510 512 if y < FTop then … … 512 514 Height := Height - (FTop - y); 513 515 ySrc := ySrc + (FTop - y); 514 y := FTop 516 y := FTop; 515 517 end; 516 518 if x + Width >= FRight then … … 521 523 exit; 522 524 523 DpiBitBlt(FOutput.Canvas.Handle, x, y, Width, Height, Src.Canvas.Handle, 524 xSrc, ySrc, Rop); 525 DpiBitCanvas(FOutput.Canvas, x, y, Width, Height, Src.Canvas, xSrc, ySrc, Rop); 525 526 end; 526 527 527 528 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 528 529 begin 529 BitBlt (GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND);530 BitBlt (GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT);530 BitBltBitmap(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 531 BitBltBitmap(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT); 531 532 end; 532 533 … … 561 562 exit; 562 563 563 DpiBit Blt(FOutput.Canvas.Handle, xDst, yDst, Width, Height, MaskDC, xSrc, ySrc, SRCAND);564 DpiBitCanvas(FOutput.Canvas, xDst, yDst, Width, Height, MaskCanvas, xSrc, ySrc, SRCAND); 564 565 if not PureBlack then 565 DpiBitBlt(FOutput.Canvas.Handle, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 566 SRCPAINT); 566 DpiBitCanvas(FOutput.Canvas, xDst, yDst, Width, Height, DataCanvas, xSrc, ySrc, SRCPAINT); 567 567 end; 568 568 … … 612 612 xGr := 121 + j mod 7 * 9; 613 613 yGr := 1 + j div 7 * 9; 614 BitBlt (GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, xGr,614 BitBltBitmap(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, xGr, 615 615 yGr, SRCAND); 616 616 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); … … 620 620 if Flags and unFortified <> 0 then 621 621 begin 622 { Data DC:=GrExt[HGrTerrain].Data.Canvas.Handle;623 Mask DC:=GrExt[HGrTerrain].Mask.Canvas.Handle;622 { DataCanvas:=GrExt[HGrTerrain].Data.Canvas; 623 MaskCanvas:=GrExt[HGrTerrain].Mask.Canvas; 624 624 TSprite(x,y+16,12*9+7); } 625 625 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1); 626 end 627 end 626 end; 627 end; 628 628 end; { PaintUnit } 629 629 … … 819 819 exit; 820 820 821 BitBlt (GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt,821 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 822 822 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 823 823 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 824 BitBlt (GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt,824 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 825 825 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 826 826 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 827 BitBlt (GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt,827 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 828 828 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 829 829 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 830 BitBlt (GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt,830 BitBltBitmap(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 831 831 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 832 832 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 833 833 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 834 834 if Conn and 1 <> 0 then 835 BitBlt (GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) +835 BitBltBitmap(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) + 836 836 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 837 837 if Conn and 2 <> 0 then 838 BitBlt (GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt,838 BitBltBitmap(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 839 839 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 840 840 if Conn and 4 <> 0 then 841 BitBlt (GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1),841 BitBltBitmap(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 842 842 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 843 843 if Conn and 8 <> 0 then 844 BitBlt (GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1),844 BitBltBitmap(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 845 845 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 846 846 end; … … 876 876 end 877 877 else if Tile and fDeadLands <> 0 then 878 TSprite(x, y, sp DeadLands);878 TSprite(x, y, spRow2); 879 879 880 880 if ShowObjects then … … 898 898 for Dir := 0 to 3 do 899 899 if Conn and (1 shl Dir) <> 0 then { river mouths } 900 TSprite(x, y, 15 * TerrainIconCols + Dir);900 TSprite(x, y, spRiverMouths + Dir); 901 901 if ShowObjects then 902 902 begin … … 904 904 for Dir := 0 to 7 do 905 905 if Conn and (1 shl Dir) <> 0 then { canal mouths } 906 TSprite(x, y, 20 * TerrainIconCols + 1 + Dir);906 TSprite(x, y, spCanalMouths + 1 + Dir); 907 907 end 908 908 end; … … 1007 1007 if BordersOK and (1 shl p1) = 0 then 1008 1008 begin 1009 // Clearing before bitbltSRCCOPY shouldn't be neccesary but for some1009 // Clearing before BitBltBitmap SRCCOPY shouldn't be neccesary but for some 1010 1010 // reason without it code works different then under Delphi 1011 1011 Borders.Canvas.FillRect(Bounds(0, p1 * (yyt * 2), xxt * 2, yyt * 2)); 1012 1012 1013 DpiBit Blt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), xxt * 2,1014 yyt * 2, GrExt[HGrTerrain].Data.Canvas .Handle,1015 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1) , SRCCOPY);1013 DpiBitCanvas(Borders.Canvas, 0, p1 * (yyt * 2), xxt * 2, 1014 yyt * 2, GrExt[HGrTerrain].Data.Canvas, 1015 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1)); 1016 1016 Borders.BeginUpdate; 1017 1017 for dy := 0 to yyt * 2 - 1 do 1018 1018 begin 1019 PixelPtr .Init(Borders, 0, p1 * (yyt * 2) + dy);1019 PixelPtr := PixelPointer(Borders, 0, p1 * (yyt * 2) + dy); 1020 1020 for dx := 0 to xxt * 2 - 1 do begin 1021 1021 if PixelPtr.Pixel^.B = 99 then begin … … 1043 1043 if p2 <> p1 then 1044 1044 begin 1045 BitBlt (GrExt[HGrTerrain].Mask, x + dx * xxt, y + dy * yyt, xxt,1045 BitBltBitmap(GrExt[HGrTerrain].Mask, x + dx * xxt, y + dy * yyt, xxt, 1046 1046 yyt, 1 + 8 * (xxt * 2 + 1) + dx * xxt, 1047 1047 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1048 BitBlt (Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, dx * xxt,1048 BitBltBitmap(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, dx * xxt, 1049 1049 p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1050 1050 end … … 1112 1112 end; 1113 1113 end; 1114 if Tile and fDeadLands<> 0 then1115 TSprite(x, y, (12 + Tile shr 25 and 3) * TerrainIconCols + 8);1114 if (Tile and fDeadLands) <> 0 then 1115 TSprite(x, y, spMinerals + (Tile shr 25 and 3) * TerrainIconCols); 1116 1116 1117 1117 if Options and (1 shl moEditMode) <> 0 then … … 1131 1131 1 + yyt + 15 * (yyt * 3 + 1)) 1132 1132 else 1133 TSprite(x, y, 6 + TerrainIconCols * 15, xxt <> 33);1133 TSprite(x, y, spGrid, xxt <> 33); 1134 1134 1135 1135 if FoW and (Tile and fObserved = 0) then … … 1340 1340 FOutput.BeginUpdate; 1341 1341 for y := y0 to y1 - 1 do begin 1342 Line .Init(FOutput, 0, y);1342 Line := PixelPointer(FOutput, 0, y); 1343 1343 y_n := (y - ym) / yyt; 1344 1344 if abs(y_n) < rShade then begin … … 1487 1487 bix := 0 1488 1488 end; 1489 BitBlt (OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt,1489 BitBltBitmap(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1490 1490 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 1491 1491 end … … 1535 1535 bix := Aix; 1536 1536 if Aix = -1 then 1537 BitBlt (GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt,1537 BitBltBitmap(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1538 1538 yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt, 1539 1539 SRCCOPY) // arctic <-> ocean 1540 1540 else if bix = -1 then 1541 BitBlt (GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt,1541 BitBltBitmap(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1542 1542 yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt, 1543 1543 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 1544 1544 else 1545 BitBlt (LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt,1545 BitBltBitmap(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1546 1546 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 1547 1547 end 1548 1548 end; 1549 1549 1550 Data DC := GrExt[HGrTerrain].Data.Canvas.Handle;1551 Mask DC := GrExt[HGrTerrain].Mask.Canvas.Handle;1550 DataCanvas := GrExt[HGrTerrain].Data.Canvas; 1551 MaskCanvas := GrExt[HGrTerrain].Mask.Canvas; 1552 1552 for dy := -2 to ny + 1 do 1553 1553 for dx := -1 to nx do -
branches/highdpi/LocalPlayer/LocalPlayer.pas
r155 r210 11 11 12 12 uses 13 Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram,13 UDpiControls, Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram, 14 14 NatStat, Wonders, Nego, Enhance, BaseWin, Battle, Rates, TechTree, 15 15 … … 25 25 FormsCreated := true; 26 26 // TODO: Changing application name in runtime will cause change of Linux XML registry file path 27 // Application.MainForm := MainScreen;28 Application.CreateForm(TMainScreen, MainScreen);29 Application.CreateForm(TCityDlg, CityDlg);30 Application.CreateForm(TModalSelectDlg, ModalSelectDlg);31 Application.CreateForm(TListDlg, ListDlg);32 Application.CreateForm(TMessgExDlg, MessgExDlg);33 Application.CreateForm(TDraftDlg, DraftDlg);34 Application.CreateForm(TCityTypeDlg, CityTypeDlg);35 Application.CreateForm(THelpDlg, HelpDlg);36 Application.CreateForm(TUnitStatDlg, UnitStatDlg);37 Application.CreateForm(TDiaDlg, DiaDlg);38 Application.CreateForm(TNatStatDlg, NatStatDlg);39 Application.CreateForm(TWondersDlg, WondersDlg);40 Application.CreateForm(TNegoDlg, NegoDlg);41 Application.CreateForm(TEnhanceDlg, EnhanceDlg);42 Application.CreateForm(TBattleDlg, BattleDlg);43 // Application.CreateForm(TAdvisorDlg, AdvisorDlg);44 Application.CreateForm(TRatesDlg, RatesDlg);45 Application.CreateForm(TTechTreeDlg, TechTreeDlg);27 // DpiApplication.MainForm := MainScreen; 28 DpiApplication.CreateForm(TMainScreen, MainScreen); 29 DpiApplication.CreateForm(TCityDlg, CityDlg); 30 DpiApplication.CreateForm(TModalSelectDlg, ModalSelectDlg); 31 DpiApplication.CreateForm(TListDlg, ListDlg); 32 DpiApplication.CreateForm(TMessgExDlg, MessgExDlg); 33 DpiApplication.CreateForm(TDraftDlg, DraftDlg); 34 DpiApplication.CreateForm(TCityTypeDlg, CityTypeDlg); 35 DpiApplication.CreateForm(THelpDlg, HelpDlg); 36 DpiApplication.CreateForm(TUnitStatDlg, UnitStatDlg); 37 DpiApplication.CreateForm(TDiaDlg, DiaDlg); 38 DpiApplication.CreateForm(TNatStatDlg, NatStatDlg); 39 DpiApplication.CreateForm(TWondersDlg, WondersDlg); 40 DpiApplication.CreateForm(TNegoDlg, NegoDlg); 41 DpiApplication.CreateForm(TEnhanceDlg, EnhanceDlg); 42 DpiApplication.CreateForm(TBattleDlg, BattleDlg); 43 // DpiApplication.CreateForm(TAdvisorDlg, AdvisorDlg); 44 DpiApplication.CreateForm(TRatesDlg, RatesDlg); 45 DpiApplication.CreateForm(TTechTreeDlg, TechTreeDlg); 46 46 end; 47 47 MainScreen.Client(Command, Player, Data); -
branches/highdpi/LocalPlayer/MessgEx.pas
r193 r210 5 5 6 6 uses 7 Messg, Protocol, ScreenTools, Platform, DateUtils, UDpiControls,7 UDpiControls, Messg, Protocol, ScreenTools, Platform, DateUtils, 8 8 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 9 9 ButtonB, StdCtrls, DrawDlg; … … 73 73 74 74 uses 75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, 76 IsoEngine, Diagram ;75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, UPixelPointer, 76 IsoEngine, Diagram, Sound; 77 77 78 78 {$R *.lfm} … … 209 209 Ticks0 := NowPrecise; 210 210 repeat 211 Application.ProcessMessages;211 DpiApplication.ProcessMessages; 212 212 Sleep(1); 213 213 Ticks := NowPrecise; … … 246 246 for iy := 0 to 39 do begin 247 247 for ix := 0 to 55 do begin 248 SrcPtr .Init(BigImp, ix + xIcon, iy + yIcon);248 SrcPtr := PixelPointer(BigImp, ix + xIcon, iy + yIcon); 249 249 xR := ix * (37 + iy * 5 / 40) / 56; 250 250 xDst := Trunc(xR); … … 291 291 292 292 // paint 293 BitBltCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y, SRCCOPY);293 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y); 294 294 295 295 if IconIndex >= 0 then … … 304 304 ImageOp_BCC(LogoBuffer, Templates, 0, 0, xb, yb, wb, hb, clCover, clPage); 305 305 306 DpiBit Blt(ca.Handle, x, y, wb, hb, LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY);306 DpiBitCanvas(ca, x, y, wb, hb, LogoBuffer.Canvas, 0, 0); 307 307 end; 308 308 … … 328 328 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do 329 329 begin 330 DpiBit Blt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Mask.Canvas.Handle,330 DpiBitCanvas(Canvas, x, y, 64, 48, GrExt[HGr].Mask.Canvas, 331 331 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND); 332 DpiBit Blt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Data.Canvas.Handle,332 DpiBitCanvas(Canvas, x, y, 64, 48, GrExt[HGr].Data.Canvas, 333 333 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT); 334 334 end; … … 345 345 if UnitsInLine > LostUnitsPerLine then 346 346 UnitsInLine := LostUnitsPerLine; 347 end 347 end; 348 348 end; 349 349 end; … … 371 371 begin 372 372 p1 := MyRO.Wonder[IconIndex].EffectiveOwner; 373 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, xSizeBig + 2 * GlowRange,374 ySizeBig + 2 * GlowRange, Canvas .Handle,375 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange , SRCCOPY);376 DpiBit Blt(Buffer.Canvas.Handle, GlowRange, GlowRange, xSizeBig, ySizeBig,377 BigImp.Canvas .Handle, IconIndex mod 7 * xSizeBig,378 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig , SRCCOPY);373 DpiBitCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange, 374 ySizeBig + 2 * GlowRange, Canvas, 375 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange); 376 DpiBitCanvas(Buffer.Canvas, GlowRange, GlowRange, xSizeBig, ySizeBig, 377 BigImp.Canvas, IconIndex mod 7 * xSizeBig, 378 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig); 379 379 if p1 < 0 then 380 380 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) … … 382 382 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 383 383 Tribe[p1].Color); 384 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - (28 + GlowRange),384 DpiBitCanvas(Canvas, ClientWidth div 2 - (28 + GlowRange), 385 385 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange, 386 Buffer.Canvas .Handle, 0, 0, SRCCOPY);386 Buffer.Canvas, 0, 0); 387 387 end 388 388 else … … 400 400 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, 401 401 ySizeBig, 0, 0); 402 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44,403 GrExt[HGr].Mask.Canvas .Handle, pix mod 10 * 65 + 1,402 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44, 403 GrExt[HGr].Mask.Canvas, pix mod 10 * 65 + 1, 404 404 pix div 10 * 49 + 1, SRCAND); 405 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44,406 GrExt[HGr].Data.Canvas .Handle, pix mod 10 * 65 + 1,405 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44, 406 GrExt[HGr].Data.Canvas, pix mod 10 * 65 + 1, 407 407 pix div 10 * 49 + 1, SRCPAINT); 408 408 end; … … 415 415 Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1, 416 416 ClientWidth div 2 + 32, 24 + 48, $000000, $000000); 417 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 24, 64, 48,418 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas .Handle,417 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 24, 64, 48, 418 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas, 419 419 1 + Tribe[IconIndex].facepix mod 10 * 65, 420 1 + Tribe[IconIndex].facepix div 10 * 49 , SRCCOPY)420 1 + Tribe[IconIndex].facepix div 10 * 49) 421 421 end; 422 422 mikPureIcon: … … 429 429 mikEnemyShipComplete: 430 430 begin 431 BitBltCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas,432 (ClientWidth - 140) div 2, 24 , SRCCOPY);431 DpiBitCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas, 432 (ClientWidth - 140) div 2, 24); 433 433 ImageOp_BCC(Buffer, Templates, 0, 0, 1, 279, 140, 120, 0, $FFFFFF); 434 DpiBit Blt(Canvas.Handle, (ClientWidth - 140) div 2, 24, 140, 120,435 Buffer.Canvas .Handle, 0, 0, SRCCOPY);434 DpiBitCanvas(Canvas, (ClientWidth - 140) div 2, 24, 140, 120, 435 Buffer.Canvas, 0, 0); 436 436 end; 437 437 mikMyArmy: … … 450 450 if OpenSound <> '' then 451 451 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 452 end; { FormPaint }452 end; 453 453 454 454 procedure TMessgExDlg.Button1Click(Sender: TObject); … … 469 469 procedure TMessgExDlg.Button3Click(Sender: TObject); 470 470 begin 471 ModalResult := mrCancel 471 ModalResult := mrCancel; 472 472 end; 473 473 474 474 procedure TMessgExDlg.RemoveBtnClick(Sender: TObject); 475 475 begin 476 ModalResult := mrNo 476 ModalResult := mrNo; 477 477 end; 478 478 … … 485 485 ModalResult := mrCancel 486 486 else if Button2.Visible then 487 ModalResult := mrIgnore 487 ModalResult := mrIgnore; 488 488 end; 489 489 … … 497 497 Kind := mkOk; 498 498 ShowModal; 499 end 499 end; 500 500 end; 501 501 … … 522 522 Kind := QueryKind; 523 523 ShowModal; 524 result := ModalResult 525 end 524 result := ModalResult; 525 end; 526 526 end; 527 527 … … 537 537 HelpNo := ContextNo; 538 538 ShowModal; 539 end 539 end; 540 540 end; 541 541 … … 552 552 end; 553 553 554 554 555 initialization 555 556 -
branches/highdpi/LocalPlayer/NatStat.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 9 10 ButtonB, ButtonC, Menus, EOTButton; … … 92 93 Template := TDpiBitmap.Create; 93 94 Template.PixelFormat := pf24bit; 94 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'Nation.png', gfNoGamma);95 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Nation.png', gfNoGamma); 95 96 end; 96 97 … … 108 109 begin 109 110 AgePrepared := MainTextureAge; 110 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,111 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,112 (hMainTexture - ClientHeight) div 2 , SRCCOPY);111 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 112 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 113 (hMainTexture - ClientHeight) div 2); 113 114 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 114 115 end … … 263 264 Extinct := 1 shl pView and MyRO.Alive = 0; 264 265 265 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,266 Back.Canvas .Handle, 0, 0, SRCCOPY);266 DpiBitCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 267 Back.Canvas, 0, 0); 267 268 268 269 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); -
branches/highdpi/LocalPlayer/Nego.pas
r178 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics,8 Controls, Forms, ButtonA, ButtonB, ButtonN , UDpiControls;7 UDpiControls, ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonA, ButtonB, ButtonN; 9 9 10 10 const … … 15 15 type 16 16 THistory = record 17 n: integer;18 Text: array 19 end; 20 21 TCommandAllowedEnum = scDipNoticeStart ..scDipBreakStart;17 n: Integer; 18 Text: array[0 .. MaxHistory - 1] of ansistring; 19 end; 20 21 TCommandAllowedEnum = scDipNoticeStart..scDipBreakStart; 22 22 23 23 { TNegoDlg } -
branches/highdpi/LocalPlayer/PVSB.pas
r178 r210 5 5 6 6 uses 7 {$IFDEF WINDOWS}7 UDpiControls, {$IFDEF WINDOWS} 8 8 Windows, 9 9 {$ENDIF} 10 10 Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils, 11 StdCtrls, Math , UDpiControls;11 StdCtrls, Math; 12 12 13 13 type … … 109 109 if Max < ScrollBar.PageSize then Result := False 110 110 else begin 111 NewPos := ScrollBar.Position - Delta div 30 0;111 NewPos := ScrollBar.Position - Delta div 30; 112 112 if NewPos < 0 then NewPos := 0; 113 113 if NewPos > Max - ScrollBar.PageSize + 1 then … … 153 153 begin 154 154 FMax := AValue; 155 ScrollBar.Max := Math.Max(0, Max{$IFDEF LINUX} - PageSize + 1{$ENDIF});155 ScrollBar.Max := Math.Max(0, FMax); 156 156 end; 157 157 -
branches/highdpi/LocalPlayer/Rates.pas
r193 r210 5 5 6 6 uses 7 Protocol, ScreenTools, BaseWin, LCLIntf, LCLType,7 UDpiControls, Protocol, ScreenTools, BaseWin, LCLIntf, LCLType, 8 8 9 9 SysUtils, Classes, Graphics, Controls, Forms, … … 29 29 RatesDlg: TRatesDlg; 30 30 31 32 31 implementation 33 32 34 33 uses 35 ClientTools, Term, Tribes , UDpiControls;34 ClientTools, Term, Tribes; 36 35 37 36 {$R *.lfm} … … 96 95 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2, 52, xSizeBig, 97 96 ySizeBig, Tribe[me].Color); 98 DpiBit Blt(Offscreen.Canvas.Handle, ClientWidth div 2 - xSizeBig div 2, 52,99 xSizeBig, ySizeBig, BigImp.Canvas .Handle, (woLiberty mod 7) * xSizeBig,100 (woLiberty div 7 + SystemIconLines) * ySizeBig , SRCCOPY);97 DpiBitCanvas(Offscreen.Canvas, ClientWidth div 2 - xSizeBig div 2, 52, 98 xSizeBig, ySizeBig, BigImp.Canvas, (woLiberty mod 7) * xSizeBig, 99 (woLiberty div 7 + SystemIconLines) * ySizeBig); 101 100 end 102 101 else … … 123 122 begin 124 123 for i := 0 to current div 8 - 1 do 125 DpiBit Blt(Handle, x + max - 8 - i * 8, y, 8, 7,126 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * 2, SRCCOPY);127 DpiBit Blt(Handle, x + max - current, y, current - 8 * (current div 8), 7,128 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * 2, SRCCOPY);124 DpiBitCanvas(Offscreen.Canvas, x + max - 8 - i * 8, y, 8, 7, 125 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * 2); 126 DpiBitCanvas(Offscreen.Canvas, x + max - current, y, current - 8 * (current div 8), 7, 127 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * 2); 129 128 Brush.Color := $000000; 130 129 FillRect(Rect(x, y, x + max - current, y + 7)); -
branches/highdpi/LocalPlayer/Select.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, UDpiControls, 8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, 8 9 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, 9 10 ExtCtrls, ButtonB, ButtonBase, Menus, Types; 10 11 … … 196 197 if pix and cpType = 0 then 197 198 if (pix and cpIndex = imPalace) and (MyRO.Government <> gAnarchy) then 198 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,199 ySizeSmall, SmallImp.Canvas .Handle, (MyRO.Government - 1) *200 xSizeSmall, ySizeSmall , SRCCOPY)199 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 200 ySizeSmall, SmallImp.Canvas, (MyRO.Government - 1) * 201 xSizeSmall, ySizeSmall) 201 202 else 202 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,203 ySizeSmall, SmallImp.Canvas .Handle, pix and cpIndex mod 7 *203 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 204 ySizeSmall, SmallImp.Canvas, pix and cpIndex mod 7 * 204 205 xSizeSmall, (pix and cpIndex + SystemIconLines * 7) div 7 * 205 ySizeSmall , SRCCOPY)206 ySizeSmall) 206 207 else 207 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,208 ySizeSmall, SmallImp.Canvas .Handle, (3 + pix and cpIndex) *209 xSizeSmall, 0 , SRCCOPY)208 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 209 ySizeSmall, SmallImp.Canvas, (3 + pix and cpIndex) * 210 xSizeSmall, 0); 210 211 end; 211 212 end; … … 567 568 MainTexture.clBevelLight, MainTexture.clBevelShade); 568 569 if AdvIcon[lix] < 84 then 569 DpiBit Blt(offscreen.Canvas.Handle, (8 + 16), y0, xSizeSmall,570 ySizeSmall, SmallImp.Canvas .Handle,570 DpiBitCanvas(offscreen.Canvas, (8 + 16), y0, xSizeSmall, 571 ySizeSmall, SmallImp.Canvas, 571 572 (AdvIcon[lix] + SystemIconLines * 7) mod 7 * xSizeSmall, 572 573 (AdvIcon[lix] + SystemIconLines * 7) div 7 * 573 ySizeSmall , SRCCOPY)574 ySizeSmall) 574 575 else 575 576 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, … … 577 578 295 + (AdvIcon[lix] - 84) div 8 * 21); 578 579 j := AdvValue[lix] div 1000; 579 DpiBit Blt(Handle, (8 + 16 - 4), y0 + 2, 14, 14,580 GrExt[HGrSystem].Mask.Canvas .Handle, 127 + j * 15,580 DpiBitCanvas(Canvas, (8 + 16 - 4), y0 + 2, 14, 14, 581 GrExt[HGrSystem].Mask.Canvas, 127 + j * 15, 581 582 85, SRCAND); 582 583 Sprite(offscreen, HGrSystem, (8 + 16 - 5), y0 + 1, 14, 14, … … 672 673 8 + 16 + xSizeSmall, y0 - 15 + (16 - 1 + ySizeSmall), 673 674 MainTexture.clBevelLight, MainTexture.clBevelShade); 674 DpiBit Blt(offscreen.Canvas.Handle, 8 + 16, y0 - 15 + (16 - 1),675 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,676 (lix - 1) * xSizeSmall, ySizeSmall , SRCCOPY);675 DpiBitCanvas(offscreen.Canvas, 8 + 16, y0 - 15 + (16 - 1), 676 xSizeSmall, ySizeSmall, SmallImp.Canvas, 677 (lix - 1) * xSizeSmall, ySizeSmall); 677 678 end 678 679 end; … … 815 816 LoweredTextOut(Canvas, -1, MainTexture, xScreen + 10, 816 817 ClientHeight - 29, s); 817 BitBltCanvas(ScienceNationDot.Canvas, 0, 0, 17, 17, Canvas,818 xScreen - 10, ClientHeight - 27 , SRCCOPY);818 DpiBitCanvas(ScienceNationDot.Canvas, 0, 0, 17, 17, Canvas, 819 xScreen - 10, ClientHeight - 27); 819 820 ImageOp_BCC(ScienceNationDot, Templates, 0, 0, 114, 211, 17, 17, 820 821 MainTexture.clBevelShade, Tribe[ScienceNation].Color); 821 DpiBit Blt(Canvas.Handle, xScreen - 10, ClientHeight - 27, 17, 17,822 ScienceNationDot.Canvas .Handle, 0, 0, SRCCOPY);822 DpiBitCanvas(Canvas, xScreen - 10, ClientHeight - 27, 17, 17, 823 ScienceNationDot.Canvas, 0, 0); 823 824 end; 824 825 end -
branches/highdpi/LocalPlayer/TechTree.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Messg, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics,8 Controls, Forms, ButtonB ase, ButtonB, DrawDlg, UDpiControls;7 UDpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonB, DrawDlg; 9 9 10 10 type … … 30 30 TechTreeDlg: TTechTreeDlg; 31 31 32 32 33 implementation 33 34 … … 77 78 X, w: Integer; 78 79 begin 79 with Canvas do 80 begin 80 with Canvas do begin 81 81 // black border 82 82 brush.color := $000000; … … 107 107 -BlackBorder - yOffset, Paper); 108 108 end; 109 DpiBit Blt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset),109 DpiBitCanvas(Canvas, max(BlackBorder, BlackBorder + xOffset), 110 110 max(BlackBorder, BlackBorder + yOffset), 111 111 min(Image.width, min(Image.width + xOffset, … … 113 113 ), min(Image.height, min(Image.height + yOffset, 114 114 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder - 115 yOffset))), Image.Canvas .Handle, max(0, -xOffset),116 max(0, -yOffset) , SRCCOPY);115 yOffset))), Image.Canvas, max(0, -xOffset), 116 max(0, -yOffset)); 117 117 end; 118 118 119 119 procedure TTechTreeDlg.FormShow(Sender: TObject); 120 120 var 121 X, Y, ad , TexWidth, TexHeight: Integer;121 X, Y, ad: Integer; 122 122 s: string; 123 SrcPixel, DstPixel: TPixelPointer; 124 begin 125 if Image = nil then126 begin123 const 124 TransparentColor = $7F007F; 125 begin 126 if Image = nil then begin 127 127 Image := TDpiBitmap.Create; 128 128 Image.PixelFormat := pf24bit; 129 129 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma); 130 130 131 with Image.Canvas do 132 begin 131 with Image.Canvas do begin 133 132 // write advance names 134 133 Font.Assign(UniFont[ftSmall]); … … 146 145 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s); 147 146 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1] 148 := $7F007F;147 := TransparentColor; 149 148 end 150 149 end; … … 161 160 end; 162 161 163 // texturize background 164 Image.BeginUpdate; 165 TexWidth := Paper.Width; 166 TexHeight := Paper.Height; 167 DstPixel.Init(Image); 168 SrcPixel.Init(Paper); 169 for Y := 0 to Image.Height - 1 do begin 170 for X := 0 to Image.Width - 1 do begin 171 if (DstPixel.Pixel^.ARGB and $FFFFFF) = $7F007F then begin // transparent 172 SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight); 173 DstPixel.Pixel^.B := SrcPixel.Pixel^.B; 174 DstPixel.Pixel^.G := SrcPixel.Pixel^.G; 175 DstPixel.Pixel^.R := SrcPixel.Pixel^.R; 176 end; 177 DstPixel.NextPixel; 178 end; 179 DstPixel.NextLine; 180 end; 181 Image.EndUpdate; 162 Texturize(Image, Paper, TransparentColor); 182 163 end; 183 164 … … 204 185 xDown := X; 205 186 yDown := Y; 206 end 187 end; 207 188 end; 208 189 … … 234 215 235 216 SmartInvalidate; 236 end 217 end; 237 218 end; 238 219 … … 246 227 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 247 228 begin 248 Close ();229 Close; 249 230 end; 250 231 -
branches/highdpi/LocalPlayer/Term.lfm
r90 r210 1 1 object MainScreen: TMainScreen 2 2 Left = 231 3 Height = 4803 Height = 600 4 4 Top = 190 5 Width = 8005 Width = 1000 6 6 HorzScrollBar.Visible = False 7 7 VertScrollBar.Visible = False 8 8 Caption = 'C-evo' 9 ClientHeight = 48010 ClientWidth = 8009 ClientHeight = 600 10 ClientWidth = 1000 11 11 Color = clBtnFace 12 Constraints.MinHeight = 480 13 Constraints.MinWidth = 800 12 Constraints.MinHeight = 600 13 Constraints.MinWidth = 1000 14 DesignTimePPI = 120 14 15 Font.Color = clWindowText 15 Font.Height = -1 316 Font.Height = -16 16 17 Font.Name = 'MS Sans Serif' 17 18 KeyPreview = True … … 30 31 OnShow = FormShow 31 32 Position = poDefault 32 LCLVersion = ' 1.6.0.4'33 LCLVersion = '2.0.6.0' 33 34 WindowState = wsMaximized 34 35 object UnitBtn: TButtonB 35 36 Tag = 14 36 Left = 2 0837 Height = 2538 Top = 38439 Width = 2537 Left = 260 38 Height = 31 39 Top = 480 40 Width = 31 40 41 Visible = False 41 42 Down = False … … 46 47 object MapBtn0: TButtonC 47 48 Tag = 51 48 Left = 1649 Height = 1 250 Top = 3 0451 Width = 1 249 Left = 20 50 Height = 15 51 Top = 380 52 Width = 15 52 53 Visible = False 53 54 Down = False … … 58 59 object MapBtn1: TButtonC 59 60 Tag = 291 60 Left = 1661 Height = 1 262 Top = 32063 Width = 1 261 Left = 20 62 Height = 15 63 Top = 400 64 Width = 15 64 65 Visible = False 65 66 Down = False … … 70 71 object MapBtn4: TButtonC 71 72 Tag = 1028 72 Left = 1673 Height = 1 274 Top = 36875 Width = 1 273 Left = 20 74 Height = 15 75 Top = 460 76 Width = 15 76 77 Visible = False 77 78 Down = False … … 82 83 object MapBtn5: TButtonC 83 84 Tag = 1328 84 Left = 1685 Height = 1 286 Top = 38487 Width = 1 285 Left = 20 86 Height = 15 87 Top = 480 88 Width = 15 88 89 Visible = False 89 90 Down = False … … 94 95 object MapBtn6: TButtonC 95 96 Tag = 1541 96 Left = 1697 Height = 1 298 Top = 40099 Width = 1 297 Left = 20 98 Height = 15 99 Top = 500 100 Width = 15 100 101 Visible = False 101 102 Down = False … … 106 107 object TerrainBtn: TButtonB 107 108 Tag = 28 108 Left = 240109 Height = 25110 Top = 384111 Width = 25109 Left = 300 110 Height = 31 111 Top = 480 112 Width = 31 112 113 Visible = False 113 114 Down = False … … 118 119 object UnitInfoBtn: TButtonB 119 120 Tag = 15 120 Left = 176121 Height = 25122 Top = 384123 Width = 25121 Left = 220 122 Height = 31 123 Top = 480 124 Width = 31 124 125 Visible = False 125 126 Down = False … … 129 130 end 130 131 object EOT: TEOTButton 131 Left = 712132 Height = 48133 Top = 368134 Width = 48132 Left = 890 133 Height = 60 134 Top = 460 135 Width = 60 135 136 Visible = False 136 137 Down = False … … 141 142 object MenuArea: TArea 142 143 Left = 2 143 Height = 36144 Height = 45 144 145 Top = 1 145 Width = 36146 Width = 45 146 147 end 147 148 object TreasuryArea: TArea 148 Left = 2 08149 Height = 36149 Left = 260 150 Height = 45 150 151 Top = 1 151 Width = 164152 Width = 205 152 153 end 153 154 object ResearchArea: TArea 154 Left = 384155 Height = 36155 Left = 480 156 Height = 45 156 157 Top = 1 157 Width = 240158 Width = 300 158 159 end 159 160 object ManagementArea: TArea 160 Left = 704161 Height = 40162 Top = 3 12163 Width = 56161 Left = 880 162 Height = 50 163 Top = 390 164 Width = 70 164 165 end 165 166 object MovieSpeed1Btn: TButtonB 166 167 Tag = 256 167 Left = 384168 Height = 25169 Top = 384170 Width = 25168 Left = 480 169 Height = 31 170 Top = 480 171 Width = 31 171 172 Visible = False 172 173 Down = False … … 177 178 object MovieSpeed2Btn: TButtonB 178 179 Tag = 512 179 Left = 416180 Height = 25181 Top = 384182 Width = 25180 Left = 520 181 Height = 31 182 Top = 480 183 Width = 31 183 184 Visible = False 184 185 Down = False … … 189 190 object MovieSpeed3Btn: TButtonB 190 191 Tag = 768 191 Left = 448192 Height = 25193 Top = 384194 Width = 25192 Left = 560 193 Height = 31 194 Top = 480 195 Width = 31 195 196 Visible = False 196 197 Down = False … … 201 202 object MovieSpeed4Btn: TButtonB 202 203 Tag = 1024 203 Left = 480204 Height = 25205 Top = 384206 Width = 25204 Left = 600 205 Height = 31 206 Top = 480 207 Width = 31 207 208 Visible = False 208 209 Down = False … … 215 216 Interval = 50 216 217 OnTimer = Timer1Timer 217 left = 8218 top = 48218 left = 10 219 top = 60 219 220 end 220 221 object GamePopup: TPopupMenu 221 222 AutoPopup = False 222 left = 40223 top = 48223 left = 50 224 top = 60 224 225 object mHelp: TMenuItem 225 226 Tag = 7 … … 452 453 RadioItem = True 453 454 OnClick = mNormalTilesClick 455 end 456 object mBigTiles: TMenuItem 457 Caption = '90px' 458 RadioItem = True 459 OnClick = mBigTilesClick 454 460 end 455 461 end … … 580 586 object UnitPopup: TPopupMenu 581 587 AutoPopup = False 582 left = 1 04583 top = 48588 left = 130 589 top = 60 584 590 object mdisband: TMenuItem 585 591 Tag = 72 … … 663 669 object StatPopup: TPopupMenu 664 670 AutoPopup = False 665 left = 72666 top = 48671 left = 90 672 top = 60 667 673 object mUnitStat: TMenuItem 668 674 Tag = 9 … … 719 725 end 720 726 object EditPopup: TPopupMenu 721 left = 168722 top = 48727 left = 210 728 top = 60 723 729 object mCreateUnit: TMenuItem 724 730 Tag = 47 … … 726 732 end 727 733 object TerrainPopup: TPopupMenu 728 left = 1 36729 top = 48734 left = 170 735 top = 60 730 736 object mtrans: TMenuItem 731 737 Tag = 273 -
branches/highdpi/LocalPlayer/Term.pas
r193 r210 5 5 6 6 uses 7 {$IFDEF Windows}7 UDpiControls, {$IFDEF Windows} 8 8 Windows, 9 9 {$ENDIF} … … 13 13 Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase, 14 14 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, DrawDlg, Types, 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area, 16 UDpiControls; 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area; 17 16 18 17 const … … 27 26 28 27 TMainScreen = class(TDrawDlg) 28 mBigTiles: TMenuItem; 29 29 Timer1: TTimer; 30 30 GamePopup: TPopupMenu; … … 219 219 procedure mSmallTilesClick(Sender: TObject); 220 220 procedure mNormalTilesClick(Sender: TObject); 221 procedure mBigTilesClick(Sender: TObject); 221 222 procedure GrWallBtnDownChanged(Sender: TObject); 222 223 procedure BareBtnDownChanged(Sender: TObject); … … 234 235 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 235 236 HaveStrategyAdvice, FirstMovieTurn: boolean; 237 function ChooseUnusedTribe: integer; 238 procedure GetTribeList; 239 procedure InitModule; 240 procedure InitTurn(NewPlayer: integer); 236 241 procedure ScrollBarUpdate(Sender: TObject); 237 242 procedure ArrangeMidPanel; … … 271 276 procedure SetTileSize(x, y: integer); 272 277 procedure RectInvalidate(Left, Top, Rigth, Bottom: integer); 278 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 273 279 procedure SmartRectInvalidate(Left, Top, Rigth, Bottom: integer); 280 procedure LoadSettings; 274 281 procedure SaveSettings; 275 282 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 276 283 procedure OnEOT(var Msg: TMessage); message WM_EOT; 284 procedure SoundPreload(Check: integer); 277 285 public 278 286 UsedOffscreenWidth, UsedOffscreenHeight: integer; … … 391 399 'CITY_WONDEREX', 'CITY_EMDELAY', 'CITY_FOUNDED', 'CITY_FOUNDED', '', 392 400 'CITY_INVALIDTYPE'); 401 402 // sound blocks for preload 403 sbStart = $01; 404 sbWonder = $02; 405 sbScience = $04; 406 sbContact = $08; 407 sbTurn = $10; 408 sbAll = $FF; 393 409 394 410 type … … 460 476 procedure HelpOnTerrain(Loc, NewMode: integer); 461 477 478 462 479 implementation 463 480 464 481 uses 465 482 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 466 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, 467 Battle, Rates, TechTree, Registry ;483 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, UPixelPointer, Sound, 484 Battle, Rates, TechTree, Registry, Global; 468 485 469 486 {$R *.lfm} … … 560 577 if ydivider > ySizeSmall then 561 578 ydivider := ySizeSmall; 562 PixelPtr .Init(BigImp, 0, cut + iy * ySizeBig + y);579 PixelPtr := PixelPointer(BigImp, 0, cut + iy * ySizeBig + y); 563 580 for x := 0 to xSizeBig - 1 do 564 581 begin … … 593 610 SmallImp.BeginUpdate; 594 611 for y := 0 to ny - 1 do begin 595 PixelPtr .Init(SmallImp, 0, y);612 PixelPtr := PixelPointer(SmallImp, 0, y); 596 613 for x := 0 to nx - 1 do 597 614 for ch := 0 to 2 do begin … … 1292 1309 end; 1293 1310 1294 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 1295 1296 procedure GetTribeList; 1297 var 1298 SearchRec: TSearchRec; 1299 Color: TColor; 1300 Name: string; 1301 ok: boolean; 1302 begin 1303 UnusedTribeFiles.Clear; 1304 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*.tribe.txt', 1311 procedure TMainScreen.SoundPreload(Check: integer); 1312 const 1313 nStartBlock = 27; 1314 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 'TURNEND', 1315 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 'WARNING_FAMINE', 1316 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 'MOVE_MOUNTAIN', 'MOVE_LOAD', 1317 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 'NOMOVE_DOMAIN', 1318 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 'CITY_BUYPROJECT', 1319 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 'AGE_0', 'REVOLUTION', 1320 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1321 1322 nWonderBlock = 6; 1323 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1324 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1325 'NEWADVANCE_GRLIB'); 1326 1327 nScienceBlock = 17; 1328 ScienceBlock: array [0 .. nScienceBlock - 1] of string = ('MOVE_PARACHUTE', 1329 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 'MOVE_COVERT', 'NEWMODEL_1', 1330 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 'NEWADVANCE_2', 1331 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 'SHIP_TRADED', 1332 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1333 1334 nContactBlock = 20; 1335 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1336 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1337 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1338 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1339 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1340 'NOMOVE_STEALTH'); 1341 1342 var 1343 i, cix, mix: integer; 1344 need: boolean; 1345 mi: TModelInfo; 1346 begin 1347 if Check and sbStart and not SoundPreloadDone <> 0 then 1348 begin 1349 for i := 0 to nStartBlock - 1 do 1350 PreparePlay(StartBlock[i]); 1351 SoundPreloadDone := SoundPreloadDone or sbStart; 1352 end; 1353 if Check and sbWonder and not SoundPreloadDone <> 0 then 1354 begin 1355 need := false; 1356 for i := 0 to 27 do 1357 if MyRO.Wonder[i].CityID <> -1 then 1358 need := true; 1359 if need then 1360 begin 1361 for i := 0 to nWonderBlock - 1 do 1362 PreparePlay(WonderBlock[i]); 1363 SoundPreloadDone := SoundPreloadDone or sbWonder; 1364 end; 1365 end; 1366 if (Check and sbScience and not SoundPreloadDone <> 0) and 1367 (MyRO.Tech[adScience] >= tsApplicable) then 1368 begin 1369 for i := 0 to nScienceBlock - 1 do 1370 PreparePlay(ScienceBlock[i]); 1371 SoundPreloadDone := SoundPreloadDone or sbScience; 1372 end; 1373 if (Check and sbContact and not SoundPreloadDone <> 0) and 1374 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1375 begin 1376 for i := 0 to nContactBlock - 1 do 1377 PreparePlay(ContactBlock[i]); 1378 SoundPreloadDone := SoundPreloadDone or sbContact; 1379 end; 1380 if Check and sbTurn <> 0 then 1381 begin 1382 if MyRO.Happened and phShipComplete <> 0 then 1383 PreparePlay('MSG_YOUWIN'); 1384 if MyData.ToldAlive <> MyRO.Alive then 1385 PreparePlay('MSG_EXTINCT'); 1386 for cix := 0 to MyRO.nCity - 1 do 1387 with MyCity[cix] do 1388 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1389 for i := 0 to 12 do 1390 if 1 shl i and Flags and CityRepMask <> 0 then 1391 PreparePlay(CityEventSoundItem[i]); 1392 for mix := 0 to MyRO.nModel - 1 do 1393 with MyModel[mix] do 1394 if Attack > 0 then 1395 begin 1396 MakeModelInfo(me, mix, MyModel[mix], mi); 1397 PreparePlay(AttackSound(ModelCode(mi))); 1398 end; 1399 end; 1400 end; 1401 1402 procedure TMainScreen.GetTribeList; 1403 var 1404 SearchRec: TSearchRec; 1405 Color: TColor; 1406 Name: string; 1407 ok: boolean; 1408 begin 1409 UnusedTribeFiles.Clear; 1410 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*.tribe.txt', 1411 faArchive + faReadOnly, SearchRec) = 0; 1412 if not ok then 1413 begin 1414 FindClose(SearchRec); 1415 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*.tribe.txt'), 1305 1416 faArchive + faReadOnly, SearchRec) = 0; 1306 if not ok then 1307 begin 1308 FindClose(SearchRec); 1309 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*.tribe.txt'), 1310 faArchive + faReadOnly, SearchRec) = 0; 1417 end; 1418 if ok then 1419 repeat 1420 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10); 1421 if GetTribeInfo(SearchRec.Name, Name, Color) then 1422 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1423 until FindNext(SearchRec) <> 0; 1424 FindClose(SearchRec); 1425 end; 1426 1427 function TMainScreen.ChooseUnusedTribe: integer; 1428 var 1429 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1430 CountBest: integer; 1431 begin 1432 assert(UnusedTribeFiles.Count > 0); 1433 result := -1; 1434 BestColorDistance := -1; 1435 for j := 0 to UnusedTribeFiles.Count - 1 do 1436 begin 1437 ColorDistance := 250; // consider differences more than this infinite 1438 for i := 0 to nPl - 1 do 1439 if Tribe[i] <> nil then 1440 begin 1441 TestColorDistance := abs(integer(UnusedTribeFiles.Objects[j]) 1442 shr 16 and $FF - Tribe[i].Color shr 16 and $FF) + 1443 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1444 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1445 abs(integer(UnusedTribeFiles.Objects[j]) and 1446 $FF - Tribe[i].Color and $FF) * 2; 1447 if TestColorDistance < ColorDistance then 1448 ColorDistance := TestColorDistance 1449 end; 1450 if ColorDistance > BestColorDistance then 1451 begin 1452 CountBest := 0; 1453 BestColorDistance := ColorDistance 1311 1454 end; 1312 if ok then 1313 repeat 1314 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10); 1315 if GetTribeInfo(SearchRec.Name, Name, Color) then 1316 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1317 until FindNext(SearchRec) <> 0; 1318 FindClose(SearchRec); 1319 end; 1320 1321 function ChooseUnusedTribe: integer; 1322 var 1323 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1324 CountBest: integer; 1325 begin 1326 assert(UnusedTribeFiles.Count > 0); 1327 result := -1; 1328 BestColorDistance := -1; 1329 for j := 0 to UnusedTribeFiles.Count - 1 do 1330 begin 1331 ColorDistance := 250; // consider differences more than this infinite 1332 for i := 0 to nPl - 1 do 1333 if Tribe[i] <> nil then 1334 begin 1335 TestColorDistance := abs(integer(UnusedTribeFiles.Objects[j]) 1336 shr 16 and $FF - Tribe[i].Color shr 16 and $FF) + 1337 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1338 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1339 abs(integer(UnusedTribeFiles.Objects[j]) and 1340 $FF - Tribe[i].Color and $FF) * 2; 1341 if TestColorDistance < ColorDistance then 1342 ColorDistance := TestColorDistance 1455 if ColorDistance = BestColorDistance then 1456 begin 1457 inc(CountBest); 1458 if DelphiRandom(CountBest) = 0 then 1459 result := j 1460 end 1461 end; 1462 end; 1463 1464 procedure TMainScreen.ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1465 var 1466 i, TestCost, MostCost: integer; 1467 Ship1Plus, Ship2Plus: boolean; 1468 begin 1469 with ShowShipChange, MessgExDlg do 1470 begin 1471 case Reason of 1472 scrProduction: 1473 begin 1474 OpenSound := 'SHIP_BUILT'; 1475 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1476 IconKind := mikShip; 1477 IconIndex := Ship1Owner; 1343 1478 end; 1344 if ColorDistance > BestColorDistance then 1345 begin 1346 CountBest := 0; 1347 BestColorDistance := ColorDistance 1479 1480 scrDestruction: 1481 begin 1482 OpenSound := 'SHIP_DESTROYED'; 1483 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1484 IconKind := mikImp; 1485 end; 1486 1487 scrTrade: 1488 begin 1489 OpenSound := 'SHIP_TRADED'; 1490 Ship1Plus := false; 1491 Ship2Plus := false; 1492 for i := 0 to nShipPart - 1 do 1493 begin 1494 if Ship1Change[i] > 0 then 1495 Ship1Plus := true; 1496 if Ship2Change[i] > 0 then 1497 Ship2Plus := true; 1498 end; 1499 if Ship1Plus and Ship2Plus then 1500 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1501 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1502 else if Ship1Plus then 1503 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1504 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1505 else // if Ship2Plus then 1506 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1507 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1508 IconKind := mikImp; 1509 end; 1510 1511 scrCapture: 1512 begin 1513 OpenSound := 'SHIP_CAPTURED'; 1514 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1515 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1516 IconKind := mikShip; 1517 IconIndex := Ship2Owner; 1518 end 1519 end; 1520 1521 if IconKind = mikImp then 1522 begin 1523 MostCost := 0; 1524 for i := 0 to nShipPart - 1 do 1525 begin 1526 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1527 if TestCost > MostCost then 1528 begin 1529 MostCost := TestCost; 1530 IconIndex := imShipComp + i 1531 end 1348 1532 end; 1349 if ColorDistance = BestColorDistance then1350 begin1351 inc(CountBest);1352 if DelphiRandom(CountBest) = 0 then1353 result := j1354 end1355 1533 end; 1356 end; 1357 1358 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1359 var 1360 i, TestCost, MostCost: integer; 1361 Ship1Plus, Ship2Plus: boolean; 1362 begin 1363 with ShowShipChange, MessgExDlg do 1364 begin 1365 case Reason of 1366 scrProduction: 1367 begin 1368 OpenSound := 'SHIP_BUILT'; 1369 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1370 IconKind := mikShip; 1371 IconIndex := Ship1Owner; 1372 end; 1373 1374 scrDestruction: 1375 begin 1376 OpenSound := 'SHIP_DESTROYED'; 1377 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1378 IconKind := mikImp; 1379 end; 1380 1381 scrTrade: 1382 begin 1383 OpenSound := 'SHIP_TRADED'; 1384 Ship1Plus := false; 1385 Ship2Plus := false; 1386 for i := 0 to nShipPart - 1 do 1387 begin 1388 if Ship1Change[i] > 0 then 1389 Ship1Plus := true; 1390 if Ship2Change[i] > 0 then 1391 Ship2Plus := true; 1392 end; 1393 if Ship1Plus and Ship2Plus then 1394 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1395 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1396 else if Ship1Plus then 1397 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1398 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1399 else // if Ship2Plus then 1400 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1401 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1402 IconKind := mikImp; 1403 end; 1404 1405 scrCapture: 1406 begin 1407 OpenSound := 'SHIP_CAPTURED'; 1408 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1409 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1410 IconKind := mikShip; 1411 IconIndex := Ship2Owner; 1412 end 1413 end; 1414 1415 if IconKind = mikImp then 1416 begin 1417 MostCost := 0; 1418 for i := 0 to nShipPart - 1 do 1419 begin 1420 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1421 if TestCost > MostCost then 1422 begin 1423 MostCost := TestCost; 1424 IconIndex := imShipComp + i 1425 end 1426 end; 1427 end; 1428 1429 Kind := mkOk; 1430 ShowModal; 1431 end; 1432 end; 1433 1434 procedure InitModule; 1435 var 1436 x, y, i, j, Domain: integer; 1437 begin 1438 { search icons for advances: } 1439 for i := 0 to nAdv - 1 do 1440 if i in FutureTech then 1441 AdvIcon[i] := 96 + i - futResearchTechnology 1442 else 1443 begin 1444 AdvIcon[i] := -1; 1445 for Domain := 0 to nDomains - 1 do 1446 for j := 0 to nUpgrade - 1 do 1447 if upgrade[Domain, j].Preq = i then 1448 if AdvIcon[i] >= 0 then 1534 1535 Kind := mkOk; 1536 ShowModal; 1537 end; 1538 end; 1539 1540 procedure TMainScreen.InitModule; 1541 var 1542 x, y, i, j, Domain: integer; 1543 begin 1544 { search icons for advances: } 1545 for i := 0 to nAdv - 1 do 1546 if i in FutureTech then 1547 AdvIcon[i] := 96 + i - futResearchTechnology 1548 else 1549 begin 1550 AdvIcon[i] := -1; 1551 for Domain := 0 to nDomains - 1 do 1552 for j := 0 to nUpgrade - 1 do 1553 if upgrade[Domain, j].Preq = i then 1554 if AdvIcon[i] >= 0 then 1555 AdvIcon[i] := 85 1556 else 1557 AdvIcon[i] := 86 + Domain; 1558 for j := 0 to nFeature - 1 do 1559 if Feature[j].Preq = i then 1560 for Domain := 0 to nDomains - 1 do 1561 if 1 shl Domain and Feature[j].Domains <> 0 then 1562 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1449 1563 AdvIcon[i] := 85 1450 1564 else 1451 1565 AdvIcon[i] := 86 + Domain; 1452 for j := 0 to nFeature - 1 do 1453 if Feature[j].Preq = i then 1454 for Domain := 0 to nDomains - 1 do 1455 if 1 shl Domain and Feature[j].Domains <> 0 then 1456 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1457 AdvIcon[i] := 85 1458 else 1459 AdvIcon[i] := 86 + Domain; 1460 for j := 28 to nImp - 1 do 1461 if Imp[j].Preq = i then 1462 AdvIcon[i] := j; 1463 for j := 28 to nImp - 1 do 1464 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1465 AdvIcon[i] := j; 1466 for j := 0 to nJob - 1 do 1467 if i = JobPreq[j] then 1468 AdvIcon[i] := 84; 1469 for j := 0 to 27 do 1470 if Imp[j].Preq = i then 1471 AdvIcon[i] := j; 1472 if AdvIcon[i] < 0 then 1473 if AdvValue[i] < 1000 then 1474 AdvIcon[i] := -7 1475 else 1476 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1477 for j := 2 to nGov - 1 do 1478 if GovPreq[j] = i then 1479 AdvIcon[i] := j - 8; 1480 end; 1481 AdvIcon[adConscription] := 86 + dGround; 1482 1483 UnusedTribeFiles := tstringlist.Create; 1484 UnusedTribeFiles.Sorted := true; 1485 TribeNames := tstringlist.Create; 1486 1487 for x := 0 to 11 do 1488 for y := 0 to 1 do 1489 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 1490 IsoEngine.Init(InitEnemyModel); 1491 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24)) 1492 then 1493 ApplyTileSize(48, 24); 1494 // non-default tile size is missing a file, switch to default 1495 MainMap := TIsoMap.Create; 1496 MainMap.SetOutput(offscreen); 1497 1498 HGrStdUnits := LoadGraphicSet('StdUnits.png'); 1499 SmallImp := TDpiBitmap.Create; 1500 SmallImp.PixelFormat := pf24bit; 1501 InitSmallImp; 1502 SoundPreloadDone := 0; 1503 StartRunning := false; 1504 StayOnTop_Ensured := false; 1505 1506 sb := TPVScrollbar.Create(Self); 1507 sb.OnUpdate := ScrollBarUpdate; 1508 end; { InitModule } 1509 1510 // sound blocks for preload 1566 for j := 28 to nImp - 1 do 1567 if Imp[j].Preq = i then 1568 AdvIcon[i] := j; 1569 for j := 28 to nImp - 1 do 1570 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1571 AdvIcon[i] := j; 1572 for j := 0 to nJob - 1 do 1573 if i = JobPreq[j] then 1574 AdvIcon[i] := 84; 1575 for j := 0 to 27 do 1576 if Imp[j].Preq = i then 1577 AdvIcon[i] := j; 1578 if AdvIcon[i] < 0 then 1579 if AdvValue[i] < 1000 then 1580 AdvIcon[i] := -7 1581 else 1582 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1583 for j := 2 to nGov - 1 do 1584 if GovPreq[j] = i then 1585 AdvIcon[i] := j - 8; 1586 end; 1587 AdvIcon[adConscription] := 86 + dGround; 1588 1589 UnusedTribeFiles := tstringlist.Create; 1590 UnusedTribeFiles.Sorted := true; 1591 TribeNames := tstringlist.Create; 1592 1593 for x := 0 to 11 do 1594 for y := 0 to 1 do 1595 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 1596 IsoEngine.Init(InitEnemyModel); 1597 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24) or (xxt <> 72)) 1598 then 1599 ApplyTileSize(48, 24); 1600 // non-default tile size is missing a file, switch to default 1601 MainMap := TIsoMap.Create; 1602 MainMap.SetOutput(offscreen); 1603 1604 HGrStdUnits := LoadGraphicSet('StdUnits.png'); 1605 SmallImp := TDpiBitmap.Create; 1606 SmallImp.PixelFormat := pf24bit; 1607 InitSmallImp; 1608 SoundPreloadDone := 0; 1609 StartRunning := false; 1610 StayOnTop_Ensured := false; 1611 1612 sb := TPVScrollbar.Create(Self); 1613 sb.OnUpdate := ScrollBarUpdate; 1614 end; { InitModule } 1615 1616 procedure TMainScreen.InitTurn(NewPlayer: integer); 1511 1617 const 1512 sbStart = $01; 1513 sbWonder = $02; 1514 sbScience = $04; 1515 sbContact = $08; 1516 sbTurn = $10; 1517 sbAll = $FF; 1518 1519 procedure SoundPreload(Check: integer); 1520 const 1521 nStartBlock = 27; 1522 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 'TURNEND', 1523 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 'WARNING_FAMINE', 1524 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 'MOVE_MOUNTAIN', 'MOVE_LOAD', 1525 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 'NOMOVE_DOMAIN', 1526 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 'CITY_BUYPROJECT', 1527 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 'AGE_0', 'REVOLUTION', 1528 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1529 1530 nWonderBlock = 6; 1531 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1532 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1533 'NEWADVANCE_GRLIB'); 1534 1535 nScienceBlock = 17; 1536 ScienceBlock: array [0 .. nScienceBlock - 1] of string = ('MOVE_PARACHUTE', 1537 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 'MOVE_COVERT', 'NEWMODEL_1', 1538 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 'NEWADVANCE_2', 1539 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 'SHIP_TRADED', 1540 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1541 1542 nContactBlock = 20; 1543 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1544 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1545 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1546 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1547 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1548 'NOMOVE_STEALTH'); 1549 1550 var 1551 i, cix, mix: integer; 1552 need: boolean; 1553 mi: TModelInfo; 1554 begin 1555 if Check and sbStart and not SoundPreloadDone <> 0 then 1556 begin 1557 for i := 0 to nStartBlock - 1 do 1558 PreparePlay(StartBlock[i]); 1559 SoundPreloadDone := SoundPreloadDone or sbStart; 1560 end; 1561 if Check and sbWonder and not SoundPreloadDone <> 0 then 1562 begin 1563 need := false; 1564 for i := 0 to 27 do 1565 if MyRO.Wonder[i].CityID <> -1 then 1566 need := true; 1567 if need then 1568 begin 1569 for i := 0 to nWonderBlock - 1 do 1570 PreparePlay(WonderBlock[i]); 1571 SoundPreloadDone := SoundPreloadDone or sbWonder; 1572 end; 1573 end; 1574 if (Check and sbScience and not SoundPreloadDone <> 0) and 1575 (MyRO.Tech[adScience] >= tsApplicable) then 1576 begin 1577 for i := 0 to nScienceBlock - 1 do 1578 PreparePlay(ScienceBlock[i]); 1579 SoundPreloadDone := SoundPreloadDone or sbScience; 1580 end; 1581 if (Check and sbContact and not SoundPreloadDone <> 0) and 1582 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1583 begin 1584 for i := 0 to nContactBlock - 1 do 1585 PreparePlay(ContactBlock[i]); 1586 SoundPreloadDone := SoundPreloadDone or sbContact; 1587 end; 1588 if Check and sbTurn <> 0 then 1589 begin 1590 if MyRO.Happened and phShipComplete <> 0 then 1591 PreparePlay('MSG_YOUWIN'); 1592 if MyData.ToldAlive <> MyRO.Alive then 1593 PreparePlay('MSG_EXTINCT'); 1594 for cix := 0 to MyRO.nCity - 1 do 1595 with MyCity[cix] do 1596 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1597 for i := 0 to 12 do 1598 if 1 shl i and Flags and CityRepMask <> 0 then 1599 PreparePlay(CityEventSoundItem[i]); 1600 for mix := 0 to MyRO.nModel - 1 do 1601 with MyModel[mix] do 1602 if Attack > 0 then 1603 begin 1604 MakeModelInfo(me, mix, MyModel[mix], mi); 1605 PreparePlay(AttackSound(ModelCode(mi))); 1606 end 1607 end 1608 end; 1609 1610 procedure InitTurn(p: integer); 1611 const 1612 nAdvBookIcon = 16; 1613 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1614 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1615 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1616 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), (Adv: adMonotheism; 1617 Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), (Adv: adTheoryOfGravity; 1618 Icon: woNewton), (Adv: adSteel; Icon: woEiffel), (Adv: adDemocracy; 1619 Icon: woLiberty), (Adv: adAutomobile; Icon: imHighways), 1620 (Adv: adSanitation; Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1621 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1622 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1623 (Adv: adSpaceFlight; Icon: woMIR)); 1624 var 1625 Domain, p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, Dist, 1626 NewAgeCenterTo, Bankrupt, ShipMore, Winners, NewGovAvailable, dx, 1627 dy: integer; 1628 MoveAdviceData: TMoveAdviceData; 1629 Picture: TModelPictureInfo; 1630 s, Item, Item2: string; 1631 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1632 AllowCityScreen: boolean; 1633 begin 1634 if IsMultiPlayerGame and (p <> me) then 1635 begin 1636 UnitInfoBtn.Visible := false; 1637 UnitBtn.Visible := false; 1638 TerrainBtn.Visible := false; 1639 EOT.Visible := false; 1640 end; 1641 if IsMultiPlayerGame and (p <> me) and 1642 (G.RO[0].Happened and phShipComplete = 0) then 1643 begin // inter player screen 1644 for i := 0 to ControlCount - 1 do 1645 if Controls[i] is TButtonC then 1646 Controls[i].Visible := false; 1647 me := -1; 1648 SetMainTextureByAge(-1); 1649 with Panel.Canvas do 1650 begin 1651 Brush.Color := $000000; 1652 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1653 Brush.Style := bsClear; 1654 end; 1655 with TopBar.Canvas do 1656 begin 1657 Brush.Color := $000000; 1658 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1659 Brush.Style := bsClear; 1660 end; 1661 Invalidate; 1662 1663 s := TurnToString(G.RO[0].Turn); 1664 if supervising then 1665 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1666 else 1667 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1668 end; 1618 nAdvBookIcon = 16; 1619 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1620 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1621 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1622 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), (Adv: adMonotheism; 1623 Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), (Adv: adTheoryOfGravity; 1624 Icon: woNewton), (Adv: adSteel; Icon: woEiffel), (Adv: adDemocracy; 1625 Icon: woLiberty), (Adv: adAutomobile; Icon: imHighways), 1626 (Adv: adSanitation; Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1627 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1628 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1629 (Adv: adSpaceFlight; Icon: woMIR)); 1630 var 1631 p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, 1632 NewAgeCenterTo, Winners, NewGovAvailable, dx, 1633 dy: integer; 1634 MoveAdviceData: TMoveAdviceData; 1635 Picture: TModelPictureInfo; 1636 s, Item, Item2: string; 1637 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1638 AllowCityScreen: boolean; 1639 begin 1640 if IsMultiPlayerGame and (NewPlayer <> me) then 1641 begin 1642 UnitInfoBtn.Visible := false; 1643 UnitBtn.Visible := false; 1644 TerrainBtn.Visible := false; 1645 EOT.Visible := false; 1646 end; 1647 if IsMultiPlayerGame and (NewPlayer <> me) and 1648 (G.RO[0].Happened and phShipComplete = 0) then 1649 begin // inter player screen 1669 1650 for i := 0 to ControlCount - 1 do 1670 1651 if Controls[i] is TButtonC then 1671 Controls[i].Visible := true; 1672 1673 ItsMeAgain(p); 1674 MyData := G.RO[p].Data; 1675 if not supervising then 1676 SoundPreload(sbAll); 1677 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1678 Invalidate; // colorize empty space 1679 1680 if not supervising then 1681 begin 1682 1683 { if MyRO.Happened and phGameEnd<>0 then 1684 begin 1685 Age:=3; 1686 SetMainTextureByAge(-1); 1652 Controls[i].Visible := false; 1653 me := -1; 1654 SetMainTextureByAge(-1); 1655 with Panel.Canvas do 1656 begin 1657 Brush.Color := $000000; 1658 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1659 Brush.Style := bsClear; 1660 end; 1661 with TopBar.Canvas do 1662 begin 1663 Brush.Color := $000000; 1664 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1665 Brush.Style := bsClear; 1666 end; 1667 Invalidate; 1668 1669 s := TurnToString(G.RO[0].Turn); 1670 if supervising then 1671 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1672 else 1673 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1674 end; 1675 for i := 0 to ControlCount - 1 do 1676 if Controls[i] is TButtonC then 1677 Controls[i].Visible := true; 1678 1679 ItsMeAgain(NewPlayer); 1680 MyData := G.RO[NewPlayer].Data; 1681 if not supervising then 1682 SoundPreload(sbAll); 1683 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1684 Invalidate; // colorize empty space 1685 1686 if not supervising then 1687 begin 1688 1689 { if MyRO.Happened and phGameEnd<>0 then 1690 begin 1691 Age:=3; 1692 SetMainTextureByAge(-1); 1693 end 1694 else } 1695 begin 1696 Age := GetAge(me); 1697 if SetMainTextureByAge(Age) then 1698 EOT.Invalidate; // has visible background parts in its bounds 1699 end; 1700 // age:=MyRO.Turn mod 4; //!!! 1701 if ClientMode = cMovieTurn then 1702 EOT.ButtonIndex := eotCancel 1703 else if ClientMode < scContact then 1704 EOT.ButtonIndex := eotGray 1705 else 1706 EOT.ButtonIndex := eotBackToNego; 1707 end 1708 else 1709 begin 1710 Age := 0; 1711 SetMainTextureByAge(-1); 1712 if ClientMode = cMovieTurn then 1713 EOT.ButtonIndex := eotCancel 1714 else 1715 EOT.ButtonIndex := eotBlinkOn; 1716 end; 1717 InitCityMark(MainTexture); 1718 CityDlg.CheckAge; 1719 NatStatDlg.CheckAge; 1720 UnitStatDlg.CheckAge; 1721 HelpDlg.Difficulty := G.Difficulty[me]; 1722 1723 UnFocus := -1; 1724 MarkCityLoc := -1; 1725 BlinkON := false; 1726 BlinkTime := -1; 1727 Tracking := false; 1728 TurnComplete := false; 1729 1730 if (ToldSlavery < 0) or 1731 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) then 1732 begin 1733 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1734 ToldSlavery := 1 1735 else 1736 ToldSlavery := 0; 1737 for p1 := 0 to nPl - 1 do 1738 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1739 with Picture do 1740 begin // replace unit picture 1741 mix := Tribe[p1].mixSlaves; 1742 if ToldSlavery = 1 then 1743 pix := pixSlaves 1744 else 1745 pix := pixNoSlaves; 1746 Hash := 0; 1747 GrName := 'StdUnits.png'; 1748 Tribe[p1].SetModelPicture(Picture, true); 1687 1749 end 1688 else } 1689 begin 1690 Age := GetAge(me); 1691 if SetMainTextureByAge(Age) then 1692 EOT.Invalidate; // has visible background parts in its bounds 1750 end; 1751 1752 if not supervising and (ClientMode = cTurn) then 1753 begin 1754 for cix := 0 to MyRO.nCity - 1 do 1755 if (MyCity[cix].Loc >= 0) and 1756 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1757 MyCity[cix].Status := MyCity[cix].Status and 1758 not csResourceWeightsMask or (3 shl 4); 1759 // new city, set to maximum growth 1760 end; 1761 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1762 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1763 SumCities(TaxSum, ScienceSum); 1764 1765 if ClientMode = cMovieTurn then 1766 begin 1767 UnitInfoBtn.Visible := false; 1768 UnitBtn.Visible := false; 1769 TerrainBtn.Visible := false; 1770 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1771 EOT.Visible := true; 1772 end 1773 else if ClientMode < scContact then 1774 begin 1775 UnitInfoBtn.Visible := UnFocus >= 0; 1776 UnitBtn.Visible := UnFocus >= 0; 1777 CheckTerrainBtnVisible; 1778 TurnComplete := supervising; 1779 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1780 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1781 end 1782 else 1783 begin 1784 UnitInfoBtn.Visible := false; 1785 UnitBtn.Visible := false; 1786 TerrainBtn.Visible := false; 1787 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1788 EOT.Visible := true; 1789 end; 1790 SetTroopLoc(-1); 1791 MapValid := false; 1792 NewAgeCenterTo := 0; 1793 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1794 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1795 begin 1796 Loc1 := MyCity[0].Loc; 1797 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1798 begin // move city out of center to not be covered by welcome screen 1799 dx := MapWidth div (xxt * 5); 1800 if dx > 5 then 1801 dx := 5; 1802 dy := MapHeight div (yyt * 5); 1803 if dy > 5 then 1804 dy := 5; 1805 if Loc1 >= G.lx * G.ly div 2 then 1806 begin 1807 NewAgeCenterTo := -1; 1808 Loc1 := dLoc(Loc1, -dx, -dy) 1809 end 1810 else 1811 begin 1812 NewAgeCenterTo := 1; 1813 Loc1 := dLoc(Loc1, -dx, dy); 1814 end 1815 end; 1816 Centre(Loc1) 1817 end; 1818 1819 for i := 0 to DpiScreen.FormCount - 1 do 1820 if DpiScreen.Forms[i] is TBufferedDrawDlg then 1821 DpiScreen.Forms[i].Enabled := true; 1822 1823 if ClientMode <> cResume then 1824 begin 1825 PaintAll; 1826 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1827 then 1828 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1829 gAnarchy { , GameMode<>cMovie } ); 1830 // first turn after anarchy -- don't show despotism palace! 1831 Update; 1832 for i := 0 to DpiScreen.FormCount - 1 do 1833 if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1834 then 1835 begin 1836 if @DpiScreen.Forms[i].OnShow <> nil then 1837 DpiScreen.Forms[i].OnShow(nil); 1838 DpiScreen.Forms[i].Invalidate; 1839 DpiScreen.Forms[i].Update; 1693 1840 end; 1694 // age:=MyRO.Turn mod 4; //!!! 1695 if ClientMode = cMovieTurn then 1696 EOT.ButtonIndex := eotCancel 1697 else if ClientMode < scContact then 1698 EOT.ButtonIndex := eotGray 1699 else 1700 EOT.ButtonIndex := eotBackToNego; 1701 end 1702 else 1703 begin 1704 Age := 0; 1705 SetMainTextureByAge(-1); 1706 if ClientMode = cMovieTurn then 1707 EOT.ButtonIndex := eotCancel 1708 else 1709 EOT.ButtonIndex := eotBlinkOn; 1710 end; 1711 InitCityMark(MainTexture); 1712 CityDlg.CheckAge; 1713 NatStatDlg.CheckAge; 1714 UnitStatDlg.CheckAge; 1715 HelpDlg.Difficulty := G.Difficulty[me]; 1716 1717 UnFocus := -1; 1718 MarkCityLoc := -1; 1719 BlinkON := false; 1720 BlinkTime := -1; 1721 Tracking := false; 1722 TurnComplete := false; 1723 1724 if (ToldSlavery < 0) or 1725 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) then 1726 begin 1727 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1728 ToldSlavery := 1 1729 else 1730 ToldSlavery := 0; 1731 for p1 := 0 to nPl - 1 do 1732 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1733 with Picture do 1734 begin // replace unit picture 1735 mix := Tribe[p1].mixSlaves; 1736 if ToldSlavery = 1 then 1737 pix := pixSlaves 1738 else 1739 pix := pixNoSlaves; 1740 Hash := 0; 1741 GrName := 'StdUnits.png'; 1742 Tribe[p1].SetModelPicture(Picture, true); 1841 1842 if MyRO.Happened and phGameEnd <> 0 then 1843 with MessgExDlg do 1844 begin // game ended 1845 if MyRO.Happened and phExtinct <> 0 then 1846 begin 1847 OpenSound := 'MSG_GAMEOVER'; 1848 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1849 IconKind := mikBigIcon; 1850 IconIndex := 8; 1851 end 1852 else if MyRO.Happened and phShipComplete <> 0 then 1853 begin 1854 Winners := 0; 1855 for p1 := 0 to nPl - 1 do 1856 if 1 shl p1 and MyRO.Alive <> 0 then 1857 begin 1858 Winners := Winners or 1 shl p1; 1859 for i := 0 to nShipPart - 1 do 1860 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1861 Winners := Winners and not(1 shl p1); 1862 end; 1863 assert(Winners <> 0); 1864 if Winners and (1 shl me) <> 0 then 1865 begin 1866 s := ''; 1867 for p1 := 0 to nPl - 1 do 1868 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1869 if s = '' then 1870 s := Tribe[p1].TPhrase('SHORTNAME') 1871 else 1872 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1873 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1874 1875 OpenSound := 'MSG_YOUWIN'; 1876 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1877 if s <> '' then 1878 MessgText := MessgText + '\' + 1879 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1880 IconKind := mikBigIcon; 1881 IconIndex := 9; 1743 1882 end 1744 end; 1745 1746 if not supervising and (ClientMode = cTurn) then 1747 begin 1748 for cix := 0 to MyRO.nCity - 1 do 1749 if (MyCity[cix].Loc >= 0) and 1750 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1751 MyCity[cix].Status := MyCity[cix].Status and 1752 not csResourceWeightsMask or (3 shl 4); 1753 // new city, set to maximum growth 1754 end; 1755 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1756 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1757 SumCities(TaxSum, ScienceSum); 1758 1759 if ClientMode = cMovieTurn then 1760 begin 1761 UnitInfoBtn.Visible := false; 1762 UnitBtn.Visible := false; 1763 TerrainBtn.Visible := false; 1764 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1765 EOT.Visible := true; 1766 end 1767 else if ClientMode < scContact then 1768 begin 1769 UnitInfoBtn.Visible := UnFocus >= 0; 1770 UnitBtn.Visible := UnFocus >= 0; 1771 CheckTerrainBtnVisible; 1772 TurnComplete := supervising; 1773 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1774 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1775 end 1776 else 1777 begin 1778 UnitInfoBtn.Visible := false; 1779 UnitBtn.Visible := false; 1780 TerrainBtn.Visible := false; 1781 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1782 EOT.Visible := true; 1783 end; 1784 SetTroopLoc(-1); 1785 MapValid := false; 1786 NewAgeCenterTo := 0; 1787 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1788 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1789 begin 1790 Loc1 := MyCity[0].Loc; 1791 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1792 begin // move city out of center to not be covered by welcome screen 1793 dx := MapWidth div (xxt * 5); 1794 if dx > 5 then 1795 dx := 5; 1796 dy := MapHeight div (yyt * 5); 1797 if dy > 5 then 1798 dy := 5; 1799 if Loc1 >= G.lx * G.ly div 2 then 1800 begin 1801 NewAgeCenterTo := -1; 1802 Loc1 := dLoc(Loc1, -dx, -dy) 1803 end 1804 else 1805 begin 1806 NewAgeCenterTo := 1; 1807 Loc1 := dLoc(Loc1, -dx, dy); 1808 end 1809 end; 1810 Centre(Loc1) 1811 end; 1812 1813 for i := 0 to DpiScreen.FormCount - 1 do 1814 if DpiScreen.Forms[i] is TBufferedDrawDlg then 1815 DpiScreen.Forms[i].Enabled := true; 1816 1817 if ClientMode <> cResume then 1818 begin 1819 PaintAll; 1820 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1821 then 1822 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1823 gAnarchy { , GameMode<>cMovie } ); 1824 // first turn after anarchy -- don't show despotism palace! 1825 Update; 1826 for i := 0 to DpiScreen.FormCount - 1 do 1827 if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1828 then 1829 begin 1830 if @DpiScreen.Forms[i].OnShow <> nil then 1831 DpiScreen.Forms[i].OnShow(nil); 1832 DpiScreen.Forms[i].Invalidate; 1833 DpiScreen.Forms[i].Update; 1834 end; 1835 1836 if MyRO.Happened and phGameEnd <> 0 then 1837 with MessgExDlg do 1838 begin // game ended 1839 if MyRO.Happened and phExtinct <> 0 then 1840 begin 1841 OpenSound := 'MSG_GAMEOVER'; 1842 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1843 IconKind := mikBigIcon; 1844 IconIndex := 8; 1845 end 1846 else if MyRO.Happened and phShipComplete <> 0 then 1847 begin 1848 Winners := 0; 1849 for p1 := 0 to nPl - 1 do 1850 if 1 shl p1 and MyRO.Alive <> 0 then 1851 begin 1852 Winners := Winners or 1 shl p1; 1853 for i := 0 to nShipPart - 1 do 1854 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1855 Winners := Winners and not(1 shl p1); 1856 end; 1857 assert(Winners <> 0); 1858 if Winners and (1 shl me) <> 0 then 1859 begin 1860 s := ''; 1861 for p1 := 0 to nPl - 1 do 1862 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1863 if s = '' then 1864 s := Tribe[p1].TPhrase('SHORTNAME') 1865 else 1866 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1867 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1868 1869 OpenSound := 'MSG_YOUWIN'; 1870 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1871 if s <> '' then 1872 MessgText := MessgText + '\' + 1873 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1874 IconKind := mikBigIcon; 1875 IconIndex := 9; 1876 end 1877 else 1878 begin 1879 assert(me = 0); 1880 OpenSound := 'MSG_GAMEOVER'; 1881 MessgText := ''; 1882 for p1 := 0 to nPl - 1 do 1883 if Winners and (1 shl p1) <> 0 then 1884 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1885 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1886 IconKind := mikEnemyShipComplete; 1887 end 1888 end 1889 else { if MyRO.Happened and fTimeUp<>0 then } 1883 else 1890 1884 begin 1891 1885 assert(me = 0); 1892 1886 OpenSound := 'MSG_GAMEOVER'; 1893 if not supervising then 1894 MessgText := Tribe[me].TPhrase('TIMEUP') 1895 else 1896 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1897 IconKind := mikImp; 1898 IconIndex := 22; 1899 end; 1900 Kind := mkOk; 1901 ShowModal; 1902 if MyRO.Happened and phExtinct = 0 then 1903 begin 1904 p1 := 0; 1905 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1906 inc(p1); 1907 if MyRO.Happened and phShipComplete = 0 then 1908 DiaDlg.ShowNewContent_Charts(wmModal); 1909 end; 1910 TurnComplete := true; 1911 exit; 1887 MessgText := ''; 1888 for p1 := 0 to nPl - 1 do 1889 if Winners and (1 shl p1) <> 0 then 1890 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1891 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1892 IconKind := mikEnemyShipComplete; 1893 end 1894 end 1895 else { if MyRO.Happened and fTimeUp<>0 then } 1896 begin 1897 assert(me = 0); 1898 OpenSound := 'MSG_GAMEOVER'; 1899 if not supervising then 1900 MessgText := Tribe[me].TPhrase('TIMEUP') 1901 else 1902 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1903 IconKind := mikImp; 1904 IconIndex := 22; 1912 1905 end; 1913 if not supervising and (1 shl me and MyRO.Alive = 0) then 1914 begin 1906 Kind := mkOk; 1907 ShowModal; 1908 if MyRO.Happened and phExtinct = 0 then 1909 begin 1910 p1 := 0; 1911 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1912 inc(p1); 1913 if MyRO.Happened and phShipComplete = 0 then 1914 DiaDlg.ShowNewContent_Charts(wmModal); 1915 end; 1915 1916 TurnComplete := true; 1916 1917 exit; 1917 1918 end; 1918 1919 if (ClientMode = cContinue) and 1920 (DipMem[me].SentCommand and $FF0F = scContact) then 1921 // contact was refused 1922 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1923 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1924 else 1925 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1926 'NEGO_REJECTED'); 1927 1928 if not supervising and (Age > MyData.ToldAge) and 1929 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1930 with MessgExDlg do 1931 begin 1932 if Age = 0 then 1919 if not supervising and (1 shl me and MyRO.Alive = 0) then 1920 begin 1921 TurnComplete := true; 1922 exit; 1923 end; 1924 1925 if (ClientMode = cContinue) and 1926 (DipMem[me].SentCommand and $FF0F = scContact) then 1927 // contact was refused 1928 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1929 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1930 else 1931 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1932 'NEGO_REJECTED'); 1933 1934 if not supervising and (Age > MyData.ToldAge) and 1935 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1936 with MessgExDlg do 1937 begin 1938 if Age = 0 then 1939 begin 1940 if Phrases2FallenBackToEnglish then 1933 1941 begin 1934 if Phrases2FallenBackToEnglish then 1935 begin 1936 s := Tribe[me].TPhrase('AGE0'); 1937 MessgText := 1938 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1939 end 1940 else 1941 begin 1942 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1943 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1944 end 1942 s := Tribe[me].TPhrase('AGE0'); 1943 MessgText := 1944 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1945 1945 end 1946 1946 else 1947 1947 begin 1948 s := Tribe[me].T Phrase('AGE' + char(48 + Age));1948 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1949 1949 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1950 end;1951 IconKind := mikAge;1952 IconIndex := Age;1953 { if age=0 then } Kind := mkOk1954 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end };1955 CenterTo := NewAgeCenterTo;1956 OpenSound := 'AGE_' + char(48 + Age);1957 ShowModal;1958 MyData.ToldAge := Age;1959 if Age > 0 then1960 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]];1961 end;1962 1963 if MyData.ToldAlive <> MyRO.Alive then1964 begin1965 for p1 := 0 to nPl - 1 do1966 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then1967 with MessgExDlg do1968 begin1969 OpenSound := 'MSG_EXTINCT';1970 s := Tribe[p1].TPhrase('EXTINCT');1971 MessgText := Format(s, [TurnToString(MyRO.Turn)]);1972 if MyRO.Alive = 1 shl me then1973 MessgText := MessgText + Phrases.Lookup('EXTINCTALL');1974 Kind := mkOk;1975 IconKind := mikImp;1976 IconIndex := 21;1977 ShowModal;1978 end;1979 if (ClientMode <> cMovieTurn) and not supervising then1980 DiaDlg.ShowNewContent_Charts(wmModal);1981 end;1982 1983 // tell changes of own credibility1984 if not supervising then1985 begin1986 if RoughCredibility(MyRO.Credibility) <>1987 RoughCredibility(MyData.ToldOwnCredibility) then1988 begin1989 if RoughCredibility(MyRO.Credibility) >1990 RoughCredibility(MyData.ToldOwnCredibility) then1991 s := Phrases.Lookup('CREDUP')1992 else1993 s := Phrases.Lookup('CREDDOWN');1994 TribeMessage(me, Format(s, [Phrases.Lookup('CREDIBILITY',1995 RoughCredibility(MyRO.Credibility))]), '');1996 end;1997 MyData.ToldOwnCredibility := MyRO.Credibility;1998 end;1999 2000 for i := 0 to 27 do2001 begin2002 OwnWonder := false;2003 for cix := 0 to MyRO.nCity - 1 do2004 if (MyCity[cix].Loc >= 0) and (MyCity[cix].ID = MyRO.Wonder[i].CityID)2005 then2006 OwnWonder := true;2007 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then2008 begin2009 if MyRO.Wonder[i].CityID = -2 then2010 with MessgExDlg do2011 begin { tell about destroyed wonders }2012 OpenSound := 'WONDER_DESTROYED';2013 MessgText := Format(Phrases.Lookup('WONDERDEST'),2014 [Phrases.Lookup('IMPROVEMENTS', i)]);2015 Kind := mkOkHelp;2016 HelpKind := hkImp;2017 HelpNo := i;2018 IconKind := mikImp;2019 IconIndex := i;2020 ShowModal;2021 end2022 else2023 begin2024 if i = woManhattan then2025 if MyRO.Wonder[i].EffectiveOwner > me then2026 MyData.ColdWarStart := MyRO.Turn - 12027 else2028 MyData.ColdWarStart := MyRO.Turn;2029 if not OwnWonder then2030 with MessgExDlg do2031 begin { tell about newly built wonders }2032 if i = woManhattan then2033 begin2034 OpenSound := 'MSG_COLDWAR';2035 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR')2036 end2037 else if MyRO.Wonder[i].EffectiveOwner >= 0 then2038 begin2039 OpenSound := 'WONDER_BUILT';2040 s := Tribe[MyRO.Wonder[i].EffectiveOwner]2041 .TPhrase('WONDERBUILT')2042 end2043 else2044 begin2045 OpenSound := 'MSG_DEFAULT';2046 s := Phrases.Lookup('WONDERBUILTEXP');2047 // already expired when built2048 end;2049 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i),2050 CityName(MyRO.Wonder[i].CityID)]);2051 Kind := mkOkHelp;2052 HelpKind := hkImp;2053 HelpNo := i;2054 IconKind := mikImp;2055 IconIndex := i;2056 ShowModal;2057 end2058 1950 end 2059 1951 end 2060 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2061 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2062 if MyRO.Wonder[i].EffectiveOwner < 0 then 1952 else 1953 begin 1954 s := Tribe[me].TPhrase('AGE' + char(48 + Age)); 1955 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1956 end; 1957 IconKind := mikAge; 1958 IconIndex := Age; 1959 { if age=0 then } Kind := mkOk 1960 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end }; 1961 CenterTo := NewAgeCenterTo; 1962 OpenSound := 'AGE_' + char(48 + Age); 1963 ShowModal; 1964 MyData.ToldAge := Age; 1965 if Age > 0 then 1966 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]]; 1967 end; 1968 1969 if MyData.ToldAlive <> MyRO.Alive then 1970 begin 1971 for p1 := 0 to nPl - 1 do 1972 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then 1973 with MessgExDlg do 2063 1974 begin 2064 if i <> woMIR then 2065 with MessgExDlg do 2066 begin { tell about expired wonders } 2067 OpenSound := 'WONDER_EXPIRED'; 2068 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2069 [Phrases.Lookup('IMPROVEMENTS', i), 2070 CityName(MyRO.Wonder[i].CityID)]); 2071 Kind := mkOkHelp; 2072 HelpKind := hkImp; 2073 HelpNo := i; 2074 IconKind := mikImp; 2075 IconIndex := i; 2076 ShowModal; 1975 OpenSound := 'MSG_EXTINCT'; 1976 s := Tribe[p1].TPhrase('EXTINCT'); 1977 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1978 if MyRO.Alive = 1 shl me then 1979 MessgText := MessgText + Phrases.Lookup('EXTINCTALL'); 1980 Kind := mkOk; 1981 IconKind := mikImp; 1982 IconIndex := 21; 1983 ShowModal; 1984 end; 1985 if (ClientMode <> cMovieTurn) and not supervising then 1986 DiaDlg.ShowNewContent_Charts(wmModal); 1987 end; 1988 1989 // tell changes of own credibility 1990 if not supervising then 1991 begin 1992 if RoughCredibility(MyRO.Credibility) <> 1993 RoughCredibility(MyData.ToldOwnCredibility) then 1994 begin 1995 if RoughCredibility(MyRO.Credibility) > 1996 RoughCredibility(MyData.ToldOwnCredibility) then 1997 s := Phrases.Lookup('CREDUP') 1998 else 1999 s := Phrases.Lookup('CREDDOWN'); 2000 TribeMessage(me, Format(s, [Phrases.Lookup('CREDIBILITY', 2001 RoughCredibility(MyRO.Credibility))]), ''); 2002 end; 2003 MyData.ToldOwnCredibility := MyRO.Credibility; 2004 end; 2005 2006 for i := 0 to 27 do 2007 begin 2008 OwnWonder := false; 2009 for cix := 0 to MyRO.nCity - 1 do 2010 if (MyCity[cix].Loc >= 0) and (MyCity[cix].ID = MyRO.Wonder[i].CityID) 2011 then 2012 OwnWonder := true; 2013 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then 2014 begin 2015 if MyRO.Wonder[i].CityID = -2 then 2016 with MessgExDlg do 2017 begin { tell about destroyed wonders } 2018 OpenSound := 'WONDER_DESTROYED'; 2019 MessgText := Format(Phrases.Lookup('WONDERDEST'), 2020 [Phrases.Lookup('IMPROVEMENTS', i)]); 2021 Kind := mkOkHelp; 2022 HelpKind := hkImp; 2023 HelpNo := i; 2024 IconKind := mikImp; 2025 IconIndex := i; 2026 ShowModal; 2027 end 2028 else 2029 begin 2030 if i = woManhattan then 2031 if MyRO.Wonder[i].EffectiveOwner > me then 2032 MyData.ColdWarStart := MyRO.Turn - 1 2033 else 2034 MyData.ColdWarStart := MyRO.Turn; 2035 if not OwnWonder then 2036 with MessgExDlg do 2037 begin { tell about newly built wonders } 2038 if i = woManhattan then 2039 begin 2040 OpenSound := 'MSG_COLDWAR'; 2041 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 2077 2042 end 2078 end 2079 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2080 then 2081 with MessgExDlg do 2082 begin { tell about capture of wonders } 2083 OpenSound := 'WONDER_CAPTURED'; 2084 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2043 else if MyRO.Wonder[i].EffectiveOwner >= 0 then 2044 begin 2045 OpenSound := 'WONDER_BUILT'; 2046 s := Tribe[MyRO.Wonder[i].EffectiveOwner] 2047 .TPhrase('WONDERBUILT') 2048 end 2049 else 2050 begin 2051 OpenSound := 'MSG_DEFAULT'; 2052 s := Phrases.Lookup('WONDERBUILTEXP'); 2053 // already expired when built 2054 end; 2085 2055 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2086 2056 CityName(MyRO.Wonder[i].CityID)]); … … 2091 2061 IconIndex := i; 2092 2062 ShowModal; 2093 end; 2094 end; 2095 2096 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2097 begin 2098 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2099 MyData.ColdWarStart := -ColdWarTurns - 1 2100 end; 2101 2102 TellNewModels; 2103 end; // ClientMode<>cResume 2104 MyData.ToldAlive := MyRO.Alive; 2105 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2106 2107 NewGovAvailable := -1; 2108 if ClientMode <> cResume then 2109 begin // tell about new techs 2110 for ad := 0 to nAdv - 1 do 2111 if (MyRO.TestFlags and tfAllTechs = 0) and 2112 ((MyRO.Tech[ad] >= tsApplicable) <> (MyData.ToldTech[ad] >= 2113 tsApplicable)) or (ad in FutureTech) and 2114 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2063 end 2064 end 2065 end 2066 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2067 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2068 if MyRO.Wonder[i].EffectiveOwner < 0 then 2069 begin 2070 if i <> woMIR then 2071 with MessgExDlg do 2072 begin { tell about expired wonders } 2073 OpenSound := 'WONDER_EXPIRED'; 2074 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2075 [Phrases.Lookup('IMPROVEMENTS', i), 2076 CityName(MyRO.Wonder[i].CityID)]); 2077 Kind := mkOkHelp; 2078 HelpKind := hkImp; 2079 HelpNo := i; 2080 IconKind := mikImp; 2081 IconIndex := i; 2082 ShowModal; 2083 end 2084 end 2085 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2086 then 2115 2087 with MessgExDlg do 2116 begin 2117 Item := 'RESEARCH_GENERAL'; 2118 if GameMode <> cMovie then 2119 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2120 Item2 := Phrases.Lookup('ADVANCES', ad); 2121 if ad in FutureTech then 2122 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2123 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2088 begin { tell about capture of wonders } 2089 OpenSound := 'WONDER_CAPTURED'; 2090 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2091 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2092 CityName(MyRO.Wonder[i].CityID)]); 2124 2093 Kind := mkOkHelp; 2125 HelpKind := hkAdv; 2126 HelpNo := ad; 2127 IconKind := mikBook; 2128 IconIndex := -1; 2129 for i := 0 to nAdvBookIcon - 1 do 2130 if AdvBookIcon[i].Adv = ad then 2131 IconIndex := AdvBookIcon[i].Icon; 2094 HelpKind := hkImp; 2095 HelpNo := i; 2096 IconKind := mikImp; 2097 IconIndex := i; 2132 2098 ShowModal; 2133 MyData.ToldTech[ad] := MyRO.Tech[ad];2134 for i := gMonarchy to nGov - 1 do2135 if GovPreq[i] = ad then2136 NewGovAvailable := i;2137 2099 end; 2138 2100 end; 2139 2101 2140 ShowCityList := false; 2141 if ClientMode = cTurn then 2142 begin 2143 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2144 ChooseResearch; 2145 2146 UpdatePanel := false; 2147 if MyRO.Happened and phChangeGov <> 0 then 2148 begin 2149 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2150 Play('NEWGOV'); 2151 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2152 CityOptimizer_BeginOfTurn; 2153 UpdatePanel := true; 2154 end; 2155 end; // ClientMode=cTurn 2156 2157 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2158 then 2102 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2103 begin 2104 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2105 MyData.ColdWarStart := -ColdWarTurns - 1 2106 end; 2107 2108 TellNewModels; 2109 end; // ClientMode<>cResume 2110 MyData.ToldAlive := MyRO.Alive; 2111 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2112 2113 NewGovAvailable := -1; 2114 if ClientMode <> cResume then 2115 begin // tell about new techs 2116 for ad := 0 to nAdv - 1 do 2117 if (MyRO.TestFlags and tfAllTechs = 0) and 2118 ((MyRO.Tech[ad] >= tsApplicable) <> (MyData.ToldTech[ad] >= 2119 tsApplicable)) or (ad in FutureTech) and 2120 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2121 with MessgExDlg do 2122 begin 2123 Item := 'RESEARCH_GENERAL'; 2124 if GameMode <> cMovie then 2125 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2126 Item2 := Phrases.Lookup('ADVANCES', ad); 2127 if ad in FutureTech then 2128 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2129 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2130 Kind := mkOkHelp; 2131 HelpKind := hkAdv; 2132 HelpNo := ad; 2133 IconKind := mikBook; 2134 IconIndex := -1; 2135 for i := 0 to nAdvBookIcon - 1 do 2136 if AdvBookIcon[i].Adv = ad then 2137 IconIndex := AdvBookIcon[i].Icon; 2138 ShowModal; 2139 MyData.ToldTech[ad] := MyRO.Tech[ad]; 2140 for i := gMonarchy to nGov - 1 do 2141 if GovPreq[i] = ad then 2142 NewGovAvailable := i; 2143 end; 2144 end; 2145 2146 ShowCityList := false; 2147 if ClientMode = cTurn then 2148 begin 2149 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2150 ChooseResearch; 2151 2152 UpdatePanel := false; 2153 if MyRO.Happened and phChangeGov <> 0 then 2154 begin 2155 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2156 Play('NEWGOV'); 2157 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2158 CityOptimizer_BeginOfTurn; 2159 UpdatePanel := true; 2160 end; 2161 end; // ClientMode=cTurn 2162 2163 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2164 then 2165 for cix := 0 to MyRO.nCity - 1 do 2166 with MyCity[cix] do 2167 Status := Status and not csToldBombard; 2168 2169 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2170 (MyRO.Government <> gAnarchy) then 2171 begin 2172 // tell what happened in cities 2173 for WondersOnly := true downto false do 2159 2174 for cix := 0 to MyRO.nCity - 1 do 2160 2175 with MyCity[cix] do 2161 Status := Status and not csToldBombard; 2162 2163 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2164 (MyRO.Government <> gAnarchy) then 2165 begin 2166 // tell what happened in cities 2167 for WondersOnly := true downto false do 2168 for cix := 0 to MyRO.nCity - 1 do 2169 with MyCity[cix] do 2170 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) and 2171 (WondersOnly = (Flags and chProduction <> 0) and 2172 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2176 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) and 2177 (WondersOnly = (Flags and chProduction <> 0) and 2178 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2179 begin 2180 if WondersOnly then 2181 with MessgExDlg do 2182 begin { tell about newly built wonder } 2183 OpenSound := 'WONDER_BUILT'; 2184 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2185 MessgText := 2186 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2187 Project0 and cpIndex), CityName(ID)]); 2188 Kind := mkOkHelp; 2189 HelpKind := hkImp; 2190 HelpNo := Project0 and cpIndex; 2191 IconKind := mikImp; 2192 IconIndex := Project0 and cpIndex; 2193 ShowModal; 2194 end; 2195 if not supervising and (ClientMode = cTurn) then 2173 2196 begin 2174 if WondersOnly then 2175 with MessgExDlg do 2176 begin { tell about newly built wonder } 2177 OpenSound := 'WONDER_BUILT'; 2178 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2179 MessgText := 2180 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2181 Project0 and cpIndex), CityName(ID)]); 2182 Kind := mkOkHelp; 2183 HelpKind := hkImp; 2184 HelpNo := Project0 and cpIndex; 2185 IconKind := mikImp; 2186 IconIndex := Project0 and cpIndex; 2187 ShowModal; 2188 end; 2189 if not supervising and (ClientMode = cTurn) then 2197 AllowCityScreen := true; 2198 if (Status and 7 <> 0) and 2199 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2200 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2201 begin 2202 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2203 AllowCityScreen := false 2204 else if Flags and chProduction <> 0 then 2205 Flags := (Flags and not chProduction) or chAllImpsMade 2206 end 2207 else 2208 Flags := Flags or chTypeDel; 2209 if (Size >= NeedAqueductSize) and 2210 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or 2211 (Size >= NeedSewerSize) and 2212 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then 2213 Flags := Flags and not chNoGrowthWarning; 2214 // don't remind of unknown building 2215 if Flags and chNoSettlerProd = 0 then 2216 Status := Status and not csToldDelay 2217 else if Status and csToldDelay = 0 then 2218 Status := Status or csToldDelay 2219 else 2220 Flags := Flags and not chNoSettlerProd; 2221 if mRepScreens.Checked then 2190 2222 begin 2191 AllowCityScreen := true; 2192 if (Status and 7 <> 0) and 2193 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2194 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2223 if (Flags and CityRepMask <> 0) and AllowCityScreen then 2224 begin { show what happened in cities } 2225 SetTroopLoc(MyCity[cix].Loc); 2226 MarkCityLoc := MyCity[cix].Loc; 2227 PanelPaint; 2228 CityDlg.CloseAction := None; 2229 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, 2230 Flags and CityRepMask); 2231 UpdatePanel := true; 2232 end 2233 end 2234 else { if mRepList.Checked then } 2235 begin 2236 if Flags and CityRepMask <> 0 then 2237 ShowCityList := true 2238 end 2239 end 2240 end; { city loop } 2241 end; // ClientMode=cTurn 2242 2243 if ClientMode = cTurn then 2244 begin 2245 if NewGovAvailable >= 0 then 2246 with MessgExDlg do 2247 begin 2248 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'), 2249 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]); 2250 Kind := mkYesNo; 2251 IconKind := mikPureIcon; 2252 IconIndex := 6 + NewGovAvailable; 2253 ShowModal; 2254 if ModalResult = mrOK then 2255 begin 2256 Play('REVOLUTION'); 2257 Server(sRevolution, me, 0, nil^); 2258 end 2259 end; 2260 end; // ClientMode=cTurn 2261 2262 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then 2263 begin 2264 if MyRO.Happened and phGliderLost <> 0 then 2265 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', 2266 hkModel, 200); 2267 if MyRO.Happened and phPlaneLost <> 0 then 2268 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', 2269 hkFeature, mcFuel); 2270 if MyRO.Happened and phPeaceEvacuation <> 0 then 2271 for p1 := 0 to nPl - 1 do 2272 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then 2273 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 2274 if MyRO.Happened and phPeaceViolation <> 0 then 2275 for p1 := 0 to nPl - 1 do 2276 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn) 2277 then 2278 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2279 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2280 TellNewContacts; 2281 end; 2282 2283 if ClientMode = cMovieTurn then 2284 Update 2285 else if ClientMode = cTurn then 2286 begin 2287 if UpdatePanel then 2288 UpdateViews; 2289 DpiApplication.ProcessMessages; 2290 2291 if not supervising then 2292 for uix := 0 to MyRO.nUn - 1 do 2293 with MyUn[uix] do 2294 if Loc >= 0 then 2295 begin 2296 if Flags and unWithdrawn <> 0 then 2297 Status := 0; 2298 if Health = 100 then 2299 Status := Status and not usRecover; 2300 if (Master >= 0) or UnitExhausted(uix) then 2301 Status := Status and not usWaiting 2302 else 2303 Status := Status or usWaiting; 2304 CheckToldNoReturn(uix); 2305 if Status and usGoto <> 0 then 2306 begin { continue multi-turn goto } 2307 SetUnFocus(uix); 2308 SetTroopLoc(Loc); 2309 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate); 2310 if Status shr 16 = $7FFF then 2311 MoveResult := GetMoveAdvice(UnFocus, maNextCity, 2312 MoveAdviceData) 2313 else 2314 MoveResult := GetMoveAdvice(UnFocus, Status shr 16, 2315 MoveAdviceData); 2316 if MoveResult >= rExecuted then 2317 begin // !!! Shinkansen 2318 MoveResult := eOK; 2319 ok := true; 2320 for i := 0 to MoveAdviceData.nStep - 1 do 2321 begin 2322 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2323 MoveAdviceData.dy[i]); 2324 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2325 // don't capture cities during auto move 2326 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2327 // don't attack during auto move 2195 2328 begin 2196 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2197 AllowCityScreen := false 2198 else if Flags and chProduction <> 0 then 2199 Flags := (Flags and not chProduction) or chAllImpsMade 2329 ok := false; 2330 Break 2200 2331 end 2201 2332 else 2202 Flags := Flags or chTypeDel;2203 if (Size >= NeedAqueductSize) and2204 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or2205 (Size >= NeedSewerSize) and2206 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then2207 Flags := Flags and not chNoGrowthWarning;2208 // don't remind of unknown building2209 if Flags and chNoSettlerProd = 0 then2210 Status := Status and not csToldDelay2211 else if Status and csToldDelay = 0 then2212 Status := Status or csToldDelay2213 else2214 Flags := Flags and not chNoSettlerProd;2215 if mRepScreens.Checked then2216 begin2217 if (Flags and CityRepMask <> 0) and AllowCityScreen then2218 begin { show what happened in cities }2219 SetTroopLoc(MyCity[cix].Loc);2220 MarkCityLoc := MyCity[cix].Loc;2221 PanelPaint;2222 CityDlg.CloseAction := None;2223 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc,2224 Flags and CityRepMask);2225 UpdatePanel := true;2226 end2227 end2228 else { if mRepList.Checked then }2229 begin2230 if Flags and CityRepMask <> 0 then2231 ShowCityList := true2232 end2233 end2234 end; { city loop }2235 end; // ClientMode=cTurn2236 2237 if ClientMode = cTurn then2238 begin2239 if NewGovAvailable >= 0 then2240 with MessgExDlg do2241 begin2242 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'),2243 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]);2244 Kind := mkYesNo;2245 IconKind := mikPureIcon;2246 IconIndex := 6 + NewGovAvailable;2247 ShowModal;2248 if ModalResult = mrOK then2249 begin2250 Play('REVOLUTION');2251 Server(sRevolution, me, 0, nil^);2252 end2253 end;2254 end; // ClientMode=cTurn2255 2256 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then2257 begin2258 if MyRO.Happened and phGliderLost <> 0 then2259 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT',2260 hkModel, 200);2261 if MyRO.Happened and phPlaneLost <> 0 then2262 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT',2263 hkFeature, mcFuel);2264 if MyRO.Happened and phPeaceEvacuation <> 0 then2265 for p1 := 0 to nPl - 1 do2266 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then2267 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT');2268 if MyRO.Happened and phPeaceViolation <> 0 then2269 for p1 := 0 to nPl - 1 do2270 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn)2271 then2272 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'),2273 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW');2274 TellNewContacts;2275 end;2276 2277 if ClientMode = cMovieTurn then2278 Update2279 else if ClientMode = cTurn then2280 begin2281 if UpdatePanel then2282 UpdateViews;2283 Application.ProcessMessages;2284 2285 if not supervising then2286 for uix := 0 to MyRO.nUn - 1 do2287 with MyUn[uix] do2288 if Loc >= 0 then2289 begin2290 if Flags and unWithdrawn <> 0 then2291 Status := 0;2292 if Health = 100 then2293 Status := Status and not usRecover;2294 if (Master >= 0) or UnitExhausted(uix) then2295 Status := Status and not usWaiting2296 else2297 Status := Status or usWaiting;2298 CheckToldNoReturn(uix);2299 if Status and usGoto <> 0 then2300 begin { continue multi-turn goto }2301 SetUnFocus(uix);2302 SetTroopLoc(Loc);2303 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate);2304 if Status shr 16 = $7FFF then2305 MoveResult := GetMoveAdvice(UnFocus, maNextCity,2306 MoveAdviceData)2307 else2308 MoveResult := GetMoveAdvice(UnFocus, Status shr 16,2309 MoveAdviceData);2310 if MoveResult >= rExecuted then2311 begin // !!! Shinkansen2312 MoveResult := eOK;2313 ok := true;2314 for i := 0 to MoveAdviceData.nStep - 1 do2315 2333 begin 2316 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2317 MoveAdviceData.dy[i]); 2318 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2319 // don't capture cities during auto move 2320 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2321 // don't attack during auto move 2334 if (Loc1 = MoveAdviceData.ToLoc) or 2335 (MoveAdviceData.ToLoc = maNextCity) and 2336 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2337 MoveAdviceData.dy[i])] and fCity <> 0) then 2338 MoveOptions := muAutoNoWait 2339 else 2340 MoveOptions := 0; 2341 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2342 MoveAdviceData.dy[i], MoveOptions); 2343 if (MoveResult < rExecuted) or (MoveResult = eEnemySpotted) 2344 then 2322 2345 begin 2323 2346 ok := false; 2324 2347 Break 2325 end 2326 else 2327 begin 2328 if (Loc1 = MoveAdviceData.ToLoc) or 2329 (MoveAdviceData.ToLoc = maNextCity) and 2330 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2331 MoveAdviceData.dy[i])] and fCity <> 0) then 2332 MoveOptions := muAutoNoWait 2333 else 2334 MoveOptions := 0; 2335 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2336 MoveAdviceData.dy[i], MoveOptions); 2337 if (MoveResult < rExecuted) or (MoveResult = eEnemySpotted) 2338 then 2339 begin 2340 ok := false; 2341 Break 2342 end; 2343 end 2344 end; 2345 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2346 (MoveAdviceData.ToLoc = maNextCity) and 2347 (MyMap[Loc] and fCity <> 0) 2348 end 2348 end; 2349 end 2350 end; 2351 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2352 (MoveAdviceData.ToLoc = maNextCity) and 2353 (MyMap[Loc] and fCity <> 0) 2354 end 2355 else 2356 begin 2357 MoveResult := eOK; 2358 Stop := true; 2359 end; 2360 2361 if MoveResult <> eDied then 2362 if Stop then 2363 Status := Status and ($FFFF - usGoto) 2349 2364 else 2350 begin 2351 MoveResult := eOK; 2352 Stop := true; 2353 end; 2354 2355 if MoveResult <> eDied then 2356 if Stop then 2357 Status := Status and ($FFFF - usGoto) 2358 else 2359 Status := Status and not usWaiting; 2360 end; 2361 2362 if Status and (usEnhance or usGoto) = usEnhance then 2363 // continue terrain enhancement 2364 begin 2365 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2366 if MoveResult <> eDied then 2367 if MoveResult = eJobDone then 2368 Status := Status and not usEnhance 2369 else 2370 Status := Status and not usWaiting; 2371 end 2365 Status := Status and not usWaiting; 2372 2366 end; 2373 end; // ClientMode=cTurn 2374 2375 HaveStrategyAdvice := false; 2376 // (GameMode<>cMovie) and not supervising 2377 // and AdvisorDlg.HaveStrategyAdvice; 2378 GoOnPhase := true; 2379 if supervising or (GameMode = cMovie) then 2380 begin 2367 2368 if Status and (usEnhance or usGoto) = usEnhance then 2369 // continue terrain enhancement 2370 begin 2371 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2372 if MoveResult <> eDied then 2373 if MoveResult = eJobDone then 2374 Status := Status and not usEnhance 2375 else 2376 Status := Status and not usWaiting; 2377 end 2378 end; 2379 end; // ClientMode=cTurn 2380 2381 HaveStrategyAdvice := false; 2382 // (GameMode<>cMovie) and not supervising 2383 // and AdvisorDlg.HaveStrategyAdvice; 2384 GoOnPhase := true; 2385 if supervising or (GameMode = cMovie) then 2386 begin 2387 SetTroopLoc(-1); 2388 PaintAll 2389 end { supervisor } 2390 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2391 begin 2392 SetUnFocus(0); 2393 ZoomToCity(MyCity[0].Loc) 2394 end } 2395 else 2396 begin 2397 if ClientMode >= scContact then 2398 SetUnFocus(-1) 2399 else 2400 NextUnit(-1, false); 2401 if UnFocus < 0 then 2402 begin 2403 UnStartLoc := -1; 2404 if IsMultiPlayerGame or (ClientMode = cResume) then 2405 if MyRO.nCity > 0 then 2406 FocusOnLoc(MyCity[0].Loc) 2407 else 2408 FocusOnLoc(G.lx * G.ly div 2); 2381 2409 SetTroopLoc(-1); 2382 PaintAll 2383 end { supervisor } 2384 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2385 begin 2386 SetUnFocus(0); 2387 ZoomToCity(MyCity[0].Loc) 2388 end } 2389 else 2390 begin 2391 if ClientMode >= scContact then 2392 SetUnFocus(-1) 2393 else 2394 NextUnit(-1, false); 2395 if UnFocus < 0 then 2396 begin 2397 UnStartLoc := -1; 2398 if IsMultiPlayerGame or (ClientMode = cResume) then 2399 if MyRO.nCity > 0 then 2400 FocusOnLoc(MyCity[0].Loc) 2401 else 2402 FocusOnLoc(G.lx * G.ly div 2); 2403 SetTroopLoc(-1); 2404 PanelPaint 2405 end; 2406 if ShowCityList then 2407 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2410 PanelPaint 2408 2411 end; 2409 end; { InitTurn } 2410 2412 if ShowCityList then 2413 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2414 end; 2415 end; 2416 2417 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 2411 2418 var 2412 2419 i, j, p1, mix, ToLoc, AnimationSpeed, ShowMoveDomain, cix, ecix: integer; … … 2416 2423 mi: TModelInfo; 2417 2424 SkipTurn, IsAlpine, IsTreatyDeal: boolean; 2418 2419 begin { >>>client } 2425 begin 2420 2426 case Command of 2421 2427 cTurn, cResume, cContinue, cMovieTurn, scContact, scDipStart .. scDipBreak: … … 2629 2635 assert(TribeNames.Count > 0); 2630 2636 ModalSelectDlg.ShowNewContent(wmModal, kTribe); 2631 Application.ProcessMessages;2637 DpiApplication.ProcessMessages; 2632 2638 TribeInfo.FileName := UnusedTribeFiles[ModalSelectDlg.result]; 2633 2639 UnusedTribeFiles.Delete(ModalSelectDlg.result); … … 2746 2752 begin 2747 2753 if AILogo[pLogo] <> nil then 2748 DpiBit Blt(Canvas.Handle, (xRightPanel + 10) - (16 + 64),2749 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas .Handle,2750 0, 0 , SRCCOPY);2754 DpiBitCanvas(Canvas, (xRightPanel + 10) - (16 + 64), 2755 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas, 2756 0, 0); 2751 2757 end 2752 2758 end … … 2776 2782 2777 2783 if Jump[pTurn] > 0 then 2778 Application.ProcessMessages;2784 DpiApplication.ProcessMessages; 2779 2785 if Jump[pTurn] > 0 then 2780 2786 if G.RO[NewPlayer].Happened and phGameEnd <> 0 then … … 2825 2831 end; 2826 2832 InitTurn(NewPlayer); 2827 Application.ProcessMessages;2833 DpiApplication.ProcessMessages; 2828 2834 if MovieSpeed = 4 then 2829 2835 begin 2830 2836 Sleep(75); 2831 2837 // this break will ensure speed of fast forward does not depend on cpu speed 2832 Application.ProcessMessages;2838 DpiApplication.ProcessMessages; 2833 2839 end 2834 2840 end; … … 2991 2997 assert(NewPlayer = me); 2992 2998 if not idle or (GameMode = cMovie) then 2993 Application.ProcessMessages;2999 DpiApplication.ProcessMessages; 2994 3000 if Command = cShowCityChanged then 2995 3001 begin … … 3055 3061 assert(NewPlayer = me); 3056 3062 if not idle or (GameMode = cMovie) then 3057 Application.ProcessMessages;3063 DpiApplication.ProcessMessages; 3058 3064 with TShowMove(Data) do 3059 3065 begin … … 3236 3242 assert(NewPlayer = me); 3237 3243 if not idle or (GameMode = cMovie) then 3238 Application.ProcessMessages;3244 DpiApplication.ProcessMessages; 3239 3245 with TShowMove(Data) do 3240 3246 begin … … 3389 3395 end 3390 3396 end 3391 end; { <<<client }3397 end; 3392 3398 3393 3399 { *** main part *** } … … 3405 3411 procedure TMainScreen.FormCreate(Sender: TObject); 3406 3412 var 3407 DefaultOptionChecked: integer;3408 Reg: TRegistry;3409 3413 i, j: integer; 3410 3414 begin 3415 MainFormKeyDown := FormKeyDown; 3411 3416 BaseWin.CreateOffscreen(Offscreen); 3412 3417 … … 3434 3439 SaveOption[20] := mAlFastMoves.Tag; 3435 3440 SaveOption[21] := mAlNoMoves.Tag; 3436 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 3437 1 shl 18 + 1 shl 19; 3438 3439 Reg := TRegistry.Create; 3440 with Reg do 3441 try 3442 OpenKey(AppRegistryKey, false); 3443 if ValueExists('TileWidth') then xxt := ReadInteger('TileWidth') div 2 3444 else xxt := 48; 3445 if ValueExists('TileHeight') then yyt := ReadInteger('TileHeight') div 2 3446 else yyt := 24; 3447 if ValueExists('OptionChecked') then OptionChecked := ReadInteger('OptionChecked') 3448 else OptionChecked := DefaultOptionChecked; 3449 if ValueExists('MapOptionChecked') then MapOptionChecked := ReadInteger('MapOptionChecked') 3450 else MapOptionChecked := 1 shl moCityNames; 3451 if ValueExists('CityReport') then CityRepMask := Cardinal(ReadInteger('CityReport')) 3452 else CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 3453 not chCaptured); 3454 if OptionChecked and (7 shl 16) = 0 then 3455 OptionChecked := OptionChecked or (1 shl 16); 3456 // old regver with no scrolling 3457 finally 3458 Free; 3459 end; 3460 3461 if 1 shl 13 and OptionChecked <> 0 then 3462 SoundMode := smOff 3463 else if 1 shl 15 and OptionChecked <> 0 then 3464 SoundMode := smOnAlt 3465 else 3466 SoundMode := smOn; 3467 3468 Screen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3469 Screen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3441 3442 LoadSettings; 3443 3444 DpiScreen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3445 DpiScreen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3470 3446 3471 3447 // tag-controlled language … … 3537 3513 procedure TMainScreen.FormDestroy(Sender: TObject); 3538 3514 var 3539 i: integer; 3540 begin 3515 I: Integer; 3516 begin 3517 MainFormKeyDown := nil; 3541 3518 FreeAndNil(sb); 3542 3519 FreeAndNil(TopBar); … … 3544 3521 FreeAndNil(Buffer); 3545 3522 FreeAndNil(Panel); 3546 for i:= 0 to nPl - 1 do3523 for I := 0 to nPl - 1 do 3547 3524 if AILogo[i] <> nil then 3548 FreeAndNil(AILogo[ i]);3525 FreeAndNil(AILogo[I]); 3549 3526 FreeAndNil(Offscreen); 3550 3527 end; … … 4034 4011 exit; 4035 4012 4036 NoMap.BitBlt (Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, xMidPanel,4013 NoMap.BitBltBitmap(Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, xMidPanel, 4037 4014 overlap, 0, 0, SRCCOPY); 4038 NoMap.BitBlt (Panel, -xMap - MapOffset + xRightPanel,4015 NoMap.BitBltBitmap(Panel, -xMap - MapOffset + xRightPanel, 4039 4016 -yMap + MapHeight - overlap, Panel.width - xRightPanel, overlap, 4040 4017 xRightPanel, 0, SRCCOPY); … … 4042 4019 begin 4043 4020 if xMap < 0 then 4044 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight, width + xMap,4045 height + yMap, Buffer.Canvas .Handle, -xMap, -yMap, SRCCOPY)4021 DpiBitCanvas(Canvas, MapOffset, TopBarHeight, width + xMap, 4022 height + yMap, Buffer.Canvas, -xMap, -yMap) 4046 4023 else 4047 DpiBit Blt(Canvas.Handle, xMap + MapOffset, TopBarHeight, width,4048 height + yMap, Buffer.Canvas .Handle, 0, -yMap, SRCCOPY)4024 DpiBitCanvas(Canvas, xMap + MapOffset, TopBarHeight, width, 4025 height + yMap, Buffer.Canvas, 0, -yMap) 4049 4026 end 4050 4027 else 4051 4028 begin 4052 4029 if xMap < 0 then 4053 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight + yMap, width + xMap,4054 height, Buffer.Canvas .Handle, -xMap, 0, SRCCOPY)4030 DpiBitCanvas(Canvas, MapOffset, TopBarHeight + yMap, width + xMap, 4031 height, Buffer.Canvas, -xMap, 0) 4055 4032 else 4056 DpiBit Blt(Canvas.Handle, xMap + MapOffset, TopBarHeight + yMap, width,4057 height, Buffer.Canvas .Handle, 0, 0, SRCCOPY);4033 DpiBitCanvas(Canvas, xMap + MapOffset, TopBarHeight + yMap, width, 4034 height, Buffer.Canvas, 0, 0); 4058 4035 end 4059 4036 end; … … 4098 4075 end; 4099 4076 Mini.BeginUpdate; 4100 MiniPixel .Init(Mini);4101 PrevMiniPixel .Init(Mini);4077 MiniPixel := PixelPointer(Mini); 4078 PrevMiniPixel := PixelPointer(Mini); 4102 4079 for y := 0 to G.ly - 1 do 4103 4080 begin … … 4179 4156 function ScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean; 4180 4157 begin 4181 BitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,4182 Canvas, lprcScroll.Left, lprcScroll.Top , SRCCOPY);4158 Result := DpiBitCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top, 4159 Canvas, lprcScroll.Left, lprcScroll.Top); 4183 4160 end; 4184 4161 {$ENDIF} … … 4325 4302 procedure TMainScreen.CopyMiniToPanel; 4326 4303 begin 4327 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,4328 Mini.Canvas .Handle, 0, 0, SRCCOPY);4304 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 4305 Mini.Canvas, 0, 0); 4329 4306 if MarkCityLoc >= 0 then 4330 4307 Sprite(Panel, HGrSystem, xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) … … 4414 4391 ClientWidth - xPalace + xSizeBig + 1, yPalace + ySizeBig + 1, 4415 4392 $FFFFFF, $B0B0B0); 4416 DpiBit Blt(Panel.Canvas.Handle, ClientWidth - xPalace, yPalace, xSizeBig,4417 ySizeBig, GrExt[HGrSystem2].Data.Canvas .Handle, 70, 123, SRCCOPY);4393 DpiBitCanvas(Panel.Canvas, ClientWidth - xPalace, yPalace, xSizeBig, 4394 ySizeBig, GrExt[HGrSystem2].Data.Canvas, 70, 123); 4418 4395 end 4419 4396 else if MyRO.NatBuilt[imPalace] > 0 then … … 5094 5071 else 5095 5072 begin 5096 if Application.Active and not mScrollOff.Checked then5073 if DpiApplication.Active and not mScrollOff.Checked then 5097 5074 begin 5098 5075 if mScrollFast.Checked then … … 5272 5249 PaintLoc(MouseLoc, 2); 5273 5250 MiniPaint; 5274 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,5275 Mini.Canvas .Handle, 0, 0, SRCCOPY);5251 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 5252 Mini.Canvas, 0, 0); 5276 5253 if ywmax <= 0 then 5277 5254 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), … … 6031 6008 var 6032 6009 ToLoc, xFromLoc, yFromLoc, xToLoc, yToLoc, xFrom, yFrom, xTo, yTo, xMin, yMin, 6033 xRange, yRange, xw1, Step, xMoving, yMoving, yl,SliceCount: integer;6010 xRange, yRange, xw1, Step, xMoving, yMoving, SliceCount: integer; 6034 6011 UnitInfo: TUnitInfo; 6035 6012 Ticks0, Ticks: TDateTime; … … 6096 6073 for Step := 0 to abs(Step1 - Step0) do 6097 6074 begin 6098 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, xRange, yRange,6099 offscreen.Canvas .Handle, xMin, yMin, SRCCOPY);6075 DpiBitCanvas(Buffer.Canvas, 0, 0, xRange, yRange, 6076 offscreen.Canvas, xMin, yMin); 6100 6077 if Step1 <> Step0 then 6101 6078 begin … … 6123 6100 begin 6124 6101 if not idle or (GameMode = cMovie) then 6125 Application.ProcessMessages;6102 DpiApplication.ProcessMessages; 6126 6103 {$IFDEF LINUX} 6127 6104 // TODO: Force animation under linux 6128 Application.ProcessMessages;6105 DpiApplication.ProcessMessages; 6129 6106 {$ENDIF} 6130 6107 Sleep(1); … … 6138 6115 if Restore then 6139 6116 begin 6140 DpiBitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, offscreen.Canvas.Handle, 6141 xMin, yMin, SRCCOPY); 6117 DpiBitCanvas(Buffer.Canvas, 0, 0, xRange, yRange, offscreen.Canvas, xMin, yMin); 6142 6118 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6143 6119 end; … … 6884 6860 end 6885 6861 else if Sender = mWebsite then 6886 OpenURL( 'http://c-evo.org')6862 OpenURL(CevoHomepage) 6887 6863 else if Sender = mRandomMap then 6888 6864 begin … … 7322 7298 mSmallTiles.Checked := xxt = 33; 7323 7299 mNormalTiles.Checked := xxt = 48; 7300 mBigTiles.Checked := xxt = 72; 7324 7301 end 7325 7302 else if Popup = StatPopup then … … 7489 7466 InitPopup(Popup); 7490 7467 if FullScreen then 7491 Popup.Popup(Left + T DpiControl(Sender).Left, Top + TDpiControl(Sender).Top)7468 Popup.Popup(Left + TControl(Sender).Left, Top + TControl(Sender).Top) 7492 7469 else 7493 Popup.Popup(Left + T DpiControl(Sender).Left + 4, Top + TDpiControl(Sender).Top +7470 Popup.Popup(Left + TControl(Sender).Left + 4, Top + TControl(Sender).Top + 7494 7471 GetSystemMetrics(SM_CYCAPTION) + 4); 7495 7472 end; … … 7553 7530 yw := ywmax; 7554 7531 end; 7555 DpiBitBlt(Buffer.Canvas.Handle, 0, 0, G.lx * 2, G.ly, Mini.Canvas.Handle, 0, 7556 0, SRCCOPY); 7532 DpiBitCanvas(Buffer.Canvas, 0, 0, G.lx * 2, G.ly, Mini.Canvas, 0, 0); 7557 7533 if ywmax <= 0 then 7558 7534 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0, … … 7563 7539 x - xMini - 2 + MapWidth div (xxt * 2) - 1, yw + MapHeight div yyt - 7564 7540 2, MainTexture.clMark, MainTexture.clMark); 7565 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,7566 Buffer.Canvas .Handle, 0, 0, SRCCOPY);7541 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 7542 Buffer.Canvas, 0, 0); 7567 7543 MainOffscreenPaint; 7568 7544 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, … … 7573 7549 end 7574 7550 else 7575 Tracking := false 7551 Tracking := false; 7576 7552 end; 7577 7553 … … 7715 7691 Brush.Style := bsClear; 7716 7692 end; 7717 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight, MapWidth, MapHeight - overlap,7718 offscreen.Canvas .Handle, 0, 0, SRCCOPY);7719 DpiBit Blt(Canvas.Handle, 0, 0, ClientWidth, TopBarHeight, TopBar.Canvas.Handle,7720 0, 0 , SRCCOPY);7693 DpiBitCanvas(Canvas, MapOffset, TopBarHeight, MapWidth, MapHeight - overlap, 7694 offscreen.Canvas, 0, 0); 7695 DpiBitCanvas(Canvas, 0, 0, ClientWidth, TopBarHeight, TopBar.Canvas, 7696 0, 0); 7721 7697 if xMidPanel > MapOffset then 7722 DpiBit Blt(Canvas.Handle, xMidPanel, TopBarHeight + MapHeight - overlap,7723 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas .Handle,7724 xMidPanel - MapOffset, MapHeight - overlap , SRCCOPY)7698 DpiBitCanvas(Canvas, xMidPanel, TopBarHeight + MapHeight - overlap, 7699 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas, 7700 xMidPanel - MapOffset, MapHeight - overlap) 7725 7701 else 7726 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight + MapHeight - overlap,7727 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas .Handle, 0,7728 MapHeight - overlap , SRCCOPY);7702 DpiBitCanvas(Canvas, MapOffset, TopBarHeight + MapHeight - overlap, 7703 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas, 0, 7704 MapHeight - overlap); 7729 7705 if xRightPanel < MapOffset + MapWidth then 7730 DpiBit Blt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - overlap,7731 xRightPanel - ClientWidth div 2, overlap, offscreen.Canvas .Handle,7732 ClientWidth div 2 - MapOffset, MapHeight - overlap , SRCCOPY)7706 DpiBitCanvas(Canvas, ClientWidth div 2, TopBarHeight + MapHeight - overlap, 7707 xRightPanel - ClientWidth div 2, overlap, offscreen.Canvas, 7708 ClientWidth div 2 - MapOffset, MapHeight - overlap) 7733 7709 else 7734 DpiBit Blt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - overlap,7710 DpiBitCanvas(Canvas, ClientWidth div 2, TopBarHeight + MapHeight - overlap, 7735 7711 MapOffset + MapWidth - ClientWidth div 2, overlap, 7736 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7737 MapHeight - overlap, SRCCOPY); 7738 DpiBitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7739 overlap, Panel.Canvas.Handle, 0, 0, SRCCOPY); 7740 DpiBitBlt(Canvas.Handle, xRightPanel, TopBarHeight + MapHeight - overlap, 7741 Panel.width - xRightPanel, overlap, Panel.Canvas.Handle, xRightPanel, 7742 0, SRCCOPY); 7743 DpiBitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight, Panel.width, 7744 PanelHeight - overlap, Panel.Canvas.Handle, 0, overlap, SRCCOPY); 7712 offscreen.Canvas, ClientWidth div 2 - MapOffset, 7713 MapHeight - overlap); 7714 DpiBitCanvas(Canvas, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7715 overlap, Panel.Canvas, 0, 0); 7716 DpiBitCanvas(Canvas, xRightPanel, TopBarHeight + MapHeight - overlap, 7717 Panel.width - xRightPanel, overlap, Panel.Canvas, xRightPanel, 0); 7718 DpiBitCanvas(Canvas, 0, TopBarHeight + MapHeight, Panel.width, 7719 PanelHeight - overlap, Panel.Canvas, 0, overlap); 7745 7720 if (pLogo >= 0) and (G.RO[pLogo] = nil) and (AILogo[pLogo] <> nil) then 7746 DpiBitBlt(Canvas.Handle, xRightPanel + 10 - (16 + 64), 7747 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas.Handle, 0, 7748 0, SRCCOPY); 7721 DpiBitCanvas(Canvas, xRightPanel + 10 - (16 + 64), 7722 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas, 0, 0); 7749 7723 end; 7750 7724 … … 7774 7748 InvalidateRgn(Handle, r0, false); 7775 7749 DeleteObject(r0); 7750 end; 7751 7752 procedure TMainScreen.LoadSettings; 7753 var 7754 Reg: TRegistry; 7755 DefaultOptionChecked: Integer; 7756 begin 7757 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 7758 1 shl 18 + 1 shl 19; 7759 Reg := TRegistry.Create; 7760 with Reg do try 7761 OpenKey(AppRegistryKey, False); 7762 if ValueExists('TileWidth') then xxt := ReadInteger('TileWidth') div 2 7763 else xxt := 48; 7764 if ValueExists('TileHeight') then yyt := ReadInteger('TileHeight') div 2 7765 else yyt := 24; 7766 if ValueExists('OptionChecked') then OptionChecked := ReadInteger('OptionChecked') 7767 else OptionChecked := DefaultOptionChecked; 7768 if ValueExists('MapOptionChecked') then MapOptionChecked := ReadInteger('MapOptionChecked') 7769 else MapOptionChecked := 1 shl moCityNames; 7770 if ValueExists('CityReport') then CityRepMask := Cardinal(ReadInteger('CityReport')) 7771 else CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 7772 not chCaptured); 7773 if OptionChecked and (7 shl 16) = 0 then 7774 OptionChecked := OptionChecked or (1 shl 16); 7775 // old regver with no scrolling 7776 finally 7777 Free; 7778 end; 7779 7780 if 1 shl 13 and OptionChecked <> 0 then 7781 SoundMode := smOff 7782 else if 1 shl 15 and OptionChecked <> 0 then 7783 SoundMode := smOnAlt 7784 else 7785 SoundMode := smOn; 7776 7786 end; 7777 7787 … … 7989 7999 begin 7990 8000 SetTileSize(48, 24); 8001 end; 8002 8003 procedure TMainScreen.mBigTilesClick(Sender: TObject); 8004 begin 8005 SetTileSize(72, 36); 7991 8006 end; 7992 8007 -
branches/highdpi/LocalPlayer/UnitStat.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls,7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 9 9 ButtonB, ButtonC; … … 83 83 Template := TDpiBitmap.Create; 84 84 Template.PixelFormat := pf24bit; 85 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'Unit.png', gfNoGamma);85 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Unit.png', gfNoGamma); 86 86 end; 87 87 … … 97 97 begin 98 98 AgePrepared := MainTextureAge; 99 Dpi bitblt(Back.Canvas.Handle, 0, 0, wCommon, hOwnModel,100 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,101 (hMainTexture - hOwnModel) div 2 , SRCCOPY);102 Dpi bitblt(Back.Canvas.Handle, wCommon, 0, wCommon, hEnemyModel,103 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,104 (hMainTexture - hEnemyModel) div 2 , SRCCOPY);105 Dpi bitblt(Back.Canvas.Handle, 2 * wCommon, 0, wCommon, hEnemyUnit,106 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,107 (hMainTexture - hEnemyUnit) div 2 , SRCCOPY);108 Dpi bitblt(Back.Canvas.Handle, 3 * wCommon, 0, wCommon, hEnemyCityDefense,109 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,110 (hMainTexture - hEnemyCityDefense) div 2 , SRCCOPY);111 Dpi bitblt(Back.Canvas.Handle, 4 * wCommon, 0, wCommon, hEnemyCity,112 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,113 (hMainTexture - hEnemyCity) div 2 , SRCCOPY);99 DpiBitCanvas(Back.Canvas, 0, 0, wCommon, hOwnModel, 100 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 101 (hMainTexture - hOwnModel) div 2); 102 DpiBitCanvas(Back.Canvas, wCommon, 0, wCommon, hEnemyModel, 103 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 104 (hMainTexture - hEnemyModel) div 2); 105 DpiBitCanvas(Back.Canvas, 2 * wCommon, 0, wCommon, hEnemyUnit, 106 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 107 (hMainTexture - hEnemyUnit) div 2); 108 DpiBitCanvas(Back.Canvas, 3 * wCommon, 0, wCommon, hEnemyCityDefense, 109 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 110 (hMainTexture - hEnemyCityDefense) div 2); 111 DpiBitCanvas(Back.Canvas, 4 * wCommon, 0, wCommon, hEnemyCity, 112 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 113 (hMainTexture - hEnemyCity) div 2); 114 114 ImageOp_B(Back, Template, 0, 0, 0, 0, 5 * wCommon, hMax); 115 115 end … … 387 387 dkOwnModel: 388 388 begin 389 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hOwnModel,390 Back.Canvas .Handle, 0, 0, SRCCOPY);389 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hOwnModel, 390 Back.Canvas, 0, 0); 391 391 yView := 13; 392 392 yTotal := 92; … … 394 394 dkEnemyModel: 395 395 begin 396 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyModel,397 Back.Canvas .Handle, wCommon, 0, SRCCOPY);396 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyModel, 397 Back.Canvas, wCommon, 0); 398 398 yView := 13; 399 399 yTotal := 92; … … 401 401 dkEnemyUnit, dkOwnUnit: 402 402 begin 403 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyUnit,404 Back.Canvas .Handle, 2 * wCommon, 0, SRCCOPY);403 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyUnit, 404 Back.Canvas, 2 * wCommon, 0); 405 405 yView := 13; 406 406 yTotal := 123; … … 408 408 dkEnemyCityDefense: 409 409 begin 410 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCityDefense,411 Back.Canvas .Handle, 3 * wCommon, 0, SRCCOPY);410 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyCityDefense, 411 Back.Canvas, 3 * wCommon, 0); 412 412 yView := 171; 413 413 yTotal := 231; … … 415 415 dkEnemyCity: 416 416 begin 417 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCity,418 Back.Canvas .Handle, 4 * wCommon, 0, SRCCOPY);417 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyCity, 418 Back.Canvas, 4 * wCommon, 0); 419 419 end; 420 420 end; … … 445 445 yImp + ySizeSmall, MainTexture.clBevelLight, 446 446 MainTexture.clBevelShade); 447 Dpi bitblt(offscreen.Canvas.Handle, x, yImp, xSizeSmall, ySizeSmall,448 SmallImp.Canvas .Handle, j mod 7 * xSizeSmall,449 (j + SystemIconLines * 7) div 7 * ySizeSmall , SRCCOPY);447 DpiBitCanvas(offscreen.Canvas, x, yImp, xSizeSmall, ySizeSmall, 448 SmallImp.Canvas, j mod 7 * xSizeSmall, 449 (j + SystemIconLines * 7) div 7 * ySizeSmall); 450 450 inc(x, xSizeSmall + 4) 451 451 end; … … 564 564 * (yyt * 3 + 1)); 565 565 end; 566 Dpi bitblt(offscreen.Canvas.Handle, xView, yView + 16, 64, 32,567 Buffer.Canvas .Handle, 1, 0, SRCCOPY);566 DpiBitCanvas(offscreen.Canvas, xView, yView + 16, 64, 32, 567 Buffer.Canvas, 1, 0); 568 568 569 569 // show unit, experience and health -
branches/highdpi/LocalPlayer/Wonders.pas
r179 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics,7 UDpiControls, ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 8 Controls, Forms, ButtonB; 9 9 … … 38 38 39 39 uses 40 Term, ClientTools, Help, Tribes, U DpiControls;40 Term, ClientTools, Help, Tribes, UPixelPointer; 41 41 42 42 {$R *.lfm} … … 104 104 Ch: Integer; 105 105 Line: array [0..1] of TPixelPointer; 106 begin 106 Width: Integer; 107 Height: Integer; 108 CenterNative: TPoint; 109 begin 110 Width := ScaleToVcl(180); 111 Height := ScaleToVcl(128); 112 CenterNative := ScalePointtoVcl(Center); 107 113 Offscreen.BeginUpdate; 108 Line[0] .Init(Offscreen);109 Line[1] .Init(Offscreen);110 for Y := 0 to 127do begin111 for X := 0 to 179do begin112 r := X * X * ( 32 * 32) + Y * Y * (45 * 45);113 ax := ((1 shl 16 div 32) * 45) * Y;114 if (r < 8 * 128 * 180 * 180) and115 ((r >= 32 * 64 * 90 * 90) and (ax < amax2 * X) and114 Line[0] := PixelPointer(Offscreen); 115 Line[1] := PixelPointer(Offscreen); 116 for Y := 0 to Height - 1 do begin 117 for X := 0 to Width - 1 do begin 118 r := X * X * ((Height div 4) * (Height div 4)) + Y * Y * ((Width div 4) * (Width div 4)); 119 ax := ((1 shl 16 div (Height div 4)) * (Width div 4)) * Y; 120 if (r < ScaleToVcl(8) * Height * Width * Width) and 121 ((r >= (Height div 4) * (Height div 2) * (Width div 2) * (Width div 2)) and (ax < amax2 * X) and 116 122 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and 117 123 ((ax < amax1 * X) or (ax > amin3 * X))) then 118 124 for i := 0 to 1 do 119 125 for ch := 0 to 2 do begin 120 Line[0].SetXY(Center .X + X, Center.Y + Y);121 Line[1].SetXY(Center .X + X, Center.Y - 1 - Y);126 Line[0].SetXY(CenterNative.X + X, CenterNative.Y + Y); 127 Line[1].SetXY(CenterNative.X + X, CenterNative.Y - 1 - Y); 122 128 c := Line[i].Pixel^.Planes[ch] - darken; 123 129 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 124 130 else Line[i].Pixel^.Planes[ch] := c; 125 Line[0].SetXY(Center .X - 1 - X, Center.Y + Y);126 Line[1].SetXY(Center .X - 1 - X, Center.Y - 1 - Y);131 Line[0].SetXY(CenterNative.X - 1 - X, CenterNative.Y + Y); 132 Line[1].SetXY(CenterNative.X - 1 - X, CenterNative.Y - 1 - Y); 127 133 c := Line[i].Pixel^.Planes[ch] - darken; 128 134 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 … … 144 150 x0Src := (i mod 7) * xSizeBig; 145 151 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 146 Src.Init(BigImp, x0Src, y0Src); 147 Dst.Init(Offscreen, x0Dst, y0Dst); 148 for Y := 0 to ySizeBig - 1 do begin 149 for X := 0 to xSizeBig - 1 do begin 152 153 Src := PixelPointer(BigImp, ScaleToVcl(x0Src), ScaleToVcl(y0Src)); 154 Dst := PixelPointer(Offscreen, ScaleToVcl(x0Dst), ScaleToVcl(y0Dst)); 155 for Y := 0 to ScaleToVcl(ySizeBig) - 1 do begin 156 for X := 0 to ScaleToVcl(xSizeBig) - 1 do begin 150 157 Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) * 151 158 15 + (255 - Src.Pixel^.R) * 9) div 128; … … 238 245 begin 239 246 case MyRO.Wonder[I].CityID of 240 - 247 -1: // not built yet 241 248 begin 242 249 Fill(Offscreen.Canvas, Center.X - xSizeBig div 2 + RingPosition[I].X - 3, … … 249 256 begin 250 257 HaveWonder := True; 251 DpiBit Blt(Offscreen.Canvas.Handle,258 DpiBitCanvas(Offscreen.Canvas, 252 259 Center.X - xSizeBig div 2 + RingPosition[I].X, 253 260 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, 254 ySizeBig, BigImp.Canvas .Handle, 0, (SystemIconLines + 3) *255 ySizeBig , SRCCOPY);261 ySizeBig, BigImp.Canvas, 0, (SystemIconLines + 3) * 262 ySizeBig); 256 263 end; 257 264 else 258 265 begin 259 266 HaveWonder := True; 260 DpiBit Blt(Offscreen.Canvas.Handle,267 DpiBitCanvas(Offscreen.Canvas, 261 268 Center.X - xSizeBig div 2 + RingPosition[I].X, 262 269 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, ySizeBig, 263 BigImp.Canvas .Handle, (I mod 7) * xSizeBig,264 (I div 7 + SystemIconLines) * ySizeBig , SRCCOPY);270 BigImp.Canvas, (I mod 7) * xSizeBig, 271 (I div 7 + SystemIconLines) * ySizeBig); 265 272 end; 266 273 end;
Note:
See TracChangeset
for help on using the changeset viewer.