Changeset 178
- Timestamp:
- Jun 23, 2019, 3:15:29 PM (5 years ago)
- Location:
- branches/highdpi
- Files:
-
- 4 added
- 50 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Back.lfm
r10 r178 1 1 object Background: TBackground 2 2 Left = 581 3 Height = 1723 Height = 258 4 4 Top = 638 5 Width = 2025 Width = 303 6 6 BorderIcons = [] 7 7 BorderStyle = bsNone 8 8 Caption = 'C-evo' 9 9 Color = clBlack 10 DesignTimePPI = 144 10 11 Font.Color = clWindowText 11 Font.Height = - 1312 Font.Height = -20 12 13 Font.Name = 'MS Sans Serif' 13 14 OnClose = FormClose … … 16 17 OnPaint = FormPaint 17 18 OnShow = FormShow 18 LCLVersion = ' 1.6.2.0'19 LCLVersion = '2.0.2.0' 19 20 WindowState = wsMaximized 20 21 end -
branches/highdpi/Back.pas
r105 r178 5 5 6 6 uses 7 LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls ;7 LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls, UDpiControls; 8 8 9 9 type … … 18 18 procedure FormClose(Sender: TObject; var Action: TCloseAction); 19 19 private 20 Img: T Bitmap;20 Img: TDpiBitmap; 21 21 end; 22 22 … … 44 44 FileName := HomeDir + 'Graphics' + DirectorySeparator + 'Background.png'; 45 45 if FileExists(FileName) then begin 46 Img := T Bitmap.Create;46 Img := TDpiBitmap.Create; 47 47 LoadGraphicFile(img, FileName); 48 48 end; -
branches/highdpi/GameServer.pas
r169 r178 7 7 8 8 uses 9 Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics; 9 Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics, 10 UDpiControls; 10 11 11 12 const … … 71 72 Initialized: Boolean; 72 73 Kind: TBrainType; 73 Picture: T Bitmap;74 Picture: TDpiBitmap; 74 75 procedure LoadFromFile(AIFileName: string); 75 76 constructor Create; … … 556 557 s: string[255]; 557 558 begin 558 MapFile := TFileStream.Create( GetMapsDir+ DirectorySeparator + FileName,559 MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName, 559 560 fmCreate or fmShareExclusive); 560 561 MapFile.Position := 0; … … 579 580 MapFile := nil; 580 581 try 581 MapFile := TFileStream.Create( GetMapsDir+ DirectorySeparator + FileName,582 MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName, 582 583 fmOpenRead or fmShareExclusive); 583 584 MapFile.Position := 0; -
branches/highdpi/Install/deb/debian/control
r173 r178 8 8 Package: c-evo 9 9 Architecture: any 10 Depends: ${shlibs:Depends}, ${misc:Depends}, sox, libsox-fmt-mp310 Depends: ${shlibs:Depends}, ${misc:Depends}, 11 11 Description: Empire building game 12 12 HomePage: https://app.zdechov.net/c-evo -
branches/highdpi/Integrated.lpi
r166 r178 86 86 </Modes> 87 87 </RunParams> 88 <RequiredPackages Count=" 2">88 <RequiredPackages Count="3"> 89 89 <Item1> 90 <PackageName Value="DpiControls"/> 91 <DefaultFilename Value="Packages\DpiControls\DpiControls.lpk" Prefer="True"/> 92 </Item1> 93 <Item2> 90 94 <PackageName Value="CevoComponents"/> 91 95 <DefaultFilename Value="Packages\CevoComponents\CevoComponents.lpk" Prefer="True"/> 92 </Item 1>93 <Item 2>96 </Item2> 97 <Item3> 94 98 <PackageName Value="LCL"/> 95 </Item 2>99 </Item3> 96 100 </RequiredPackages> 97 <Units Count="4 0">101 <Units Count="41"> 98 102 <Unit0> 99 103 <Filename Value="Integrated.lpr"/> … … 129 133 <ComponentName Value="DirectDlg"/> 130 134 <HasResources Value="True"/> 131 <ResourceBaseClass Value="Form"/>132 135 </Unit7> 133 136 <Unit8> … … 136 139 <ComponentName Value="StartDlg"/> 137 140 <HasResources Value="True"/> 138 <ResourceBaseClass Value="Form"/>139 141 </Unit8> 140 142 <Unit9> … … 205 207 </Unit20> 206 208 <Unit21> 207 <Filename Value="LocalPlayer\Help.pas"/> 208 <IsPartOfProject Value="True"/> 209 <ComponentName Value="HelpDlg"/> 210 <HasResources Value="True"/> 211 <ResourceBaseClass Value="Form"/> 209 <Filename Value="LocalPlayer\BaseWin.pas"/> 210 <IsPartOfProject Value="True"/> 212 211 </Unit21> 213 212 <Unit22> 214 <Filename Value="LocalPlayer\ Select.pas"/>215 <IsPartOfProject Value="True"/> 216 <ComponentName Value=" ListDlg"/>213 <Filename Value="LocalPlayer\Help.pas"/> 214 <IsPartOfProject Value="True"/> 215 <ComponentName Value="HelpDlg"/> 217 216 <HasResources Value="True"/> 218 217 <ResourceBaseClass Value="Form"/> 219 218 </Unit22> 220 219 <Unit23> 221 <Filename Value="LocalPlayer\ CityScreen.pas"/>222 <IsPartOfProject Value="True"/> 223 <ComponentName Value=" CityDlg"/>220 <Filename Value="LocalPlayer\Select.pas"/> 221 <IsPartOfProject Value="True"/> 222 <ComponentName Value="ListDlg"/> 224 223 <HasResources Value="True"/> 225 224 <ResourceBaseClass Value="Form"/> 226 225 </Unit23> 227 226 <Unit24> 228 <Filename Value="LocalPlayer\ UnitStat.pas"/>229 <IsPartOfProject Value="True"/> 230 <ComponentName Value=" UnitStatDlg"/>227 <Filename Value="LocalPlayer\CityScreen.pas"/> 228 <IsPartOfProject Value="True"/> 229 <ComponentName Value="CityDlg"/> 231 230 <HasResources Value="True"/> 232 231 <ResourceBaseClass Value="Form"/> 233 232 </Unit24> 234 233 <Unit25> 235 <Filename Value="LocalPlayer\ Draft.pas"/>236 <IsPartOfProject Value="True"/> 237 <ComponentName Value=" DraftDlg"/>234 <Filename Value="LocalPlayer\UnitStat.pas"/> 235 <IsPartOfProject Value="True"/> 236 <ComponentName Value="UnitStatDlg"/> 238 237 <HasResources Value="True"/> 239 238 <ResourceBaseClass Value="Form"/> 240 239 </Unit25> 241 240 <Unit26> 242 <Filename Value="LocalPlayer\ NatStat.pas"/>243 <IsPartOfProject Value="True"/> 244 <ComponentName Value=" NatStatDlg"/>241 <Filename Value="LocalPlayer\Draft.pas"/> 242 <IsPartOfProject Value="True"/> 243 <ComponentName Value="DraftDlg"/> 245 244 <HasResources Value="True"/> 246 245 <ResourceBaseClass Value="Form"/> 247 246 </Unit26> 248 247 <Unit27> 249 <Filename Value="LocalPlayer\ Diagram.pas"/>250 <IsPartOfProject Value="True"/> 251 <ComponentName Value=" DiaDlg"/>248 <Filename Value="LocalPlayer\NatStat.pas"/> 249 <IsPartOfProject Value="True"/> 250 <ComponentName Value="NatStatDlg"/> 252 251 <HasResources Value="True"/> 253 252 <ResourceBaseClass Value="Form"/> 254 253 </Unit27> 255 254 <Unit28> 256 <Filename Value="LocalPlayer\ Wonders.pas"/>257 <IsPartOfProject Value="True"/> 258 <ComponentName Value=" WondersDlg"/>255 <Filename Value="LocalPlayer\Diagram.pas"/> 256 <IsPartOfProject Value="True"/> 257 <ComponentName Value="DiaDlg"/> 259 258 <HasResources Value="True"/> 260 259 <ResourceBaseClass Value="Form"/> 261 260 </Unit28> 262 261 <Unit29> 263 <Filename Value="LocalPlayer\ Nego.pas"/>264 <IsPartOfProject Value="True"/> 265 <ComponentName Value=" NegoDlg"/>262 <Filename Value="LocalPlayer\Wonders.pas"/> 263 <IsPartOfProject Value="True"/> 264 <ComponentName Value="WondersDlg"/> 266 265 <HasResources Value="True"/> 267 266 <ResourceBaseClass Value="Form"/> 268 267 </Unit29> 269 268 <Unit30> 270 <Filename Value="LocalPlayer\ CityType.pas"/>271 <IsPartOfProject Value="True"/> 272 <ComponentName Value=" CityTypeDlg"/>269 <Filename Value="LocalPlayer\Nego.pas"/> 270 <IsPartOfProject Value="True"/> 271 <ComponentName Value="NegoDlg"/> 273 272 <HasResources Value="True"/> 274 273 <ResourceBaseClass Value="Form"/> 275 274 </Unit30> 276 275 <Unit31> 277 <Filename Value="LocalPlayer\ Enhance.pas"/>278 <IsPartOfProject Value="True"/> 279 <ComponentName Value=" EnhanceDlg"/>276 <Filename Value="LocalPlayer\CityType.pas"/> 277 <IsPartOfProject Value="True"/> 278 <ComponentName Value="CityTypeDlg"/> 280 279 <HasResources Value="True"/> 281 280 <ResourceBaseClass Value="Form"/> 282 281 </Unit31> 283 282 <Unit32> 284 <Filename Value=" NoTerm.pas"/>285 <IsPartOfProject Value="True"/> 286 <ComponentName Value=" NoTermDlg"/>283 <Filename Value="LocalPlayer\Enhance.pas"/> 284 <IsPartOfProject Value="True"/> 285 <ComponentName Value="EnhanceDlg"/> 287 286 <HasResources Value="True"/> 288 287 <ResourceBaseClass Value="Form"/> 289 288 </Unit32> 290 289 <Unit33> 291 <Filename Value=" LocalPlayer\Battle.pas"/>292 <IsPartOfProject Value="True"/> 293 <ComponentName Value=" BattleDlg"/>290 <Filename Value="NoTerm.pas"/> 291 <IsPartOfProject Value="True"/> 292 <ComponentName Value="NoTermDlg"/> 294 293 <HasResources Value="True"/> 295 294 <ResourceBaseClass Value="Form"/> 296 295 </Unit33> 297 296 <Unit34> 298 <Filename Value="LocalPlayer\ Rates.pas"/>299 <IsPartOfProject Value="True"/> 300 <ComponentName Value=" RatesDlg"/>297 <Filename Value="LocalPlayer\Battle.pas"/> 298 <IsPartOfProject Value="True"/> 299 <ComponentName Value="BattleDlg"/> 301 300 <HasResources Value="True"/> 302 301 <ResourceBaseClass Value="Form"/> 303 302 </Unit34> 304 303 <Unit35> 305 <Filename Value="LocalPlayer\ TechTree.pas"/>306 <IsPartOfProject Value="True"/> 307 <ComponentName Value=" TechTreeDlg"/>304 <Filename Value="LocalPlayer\Rates.pas"/> 305 <IsPartOfProject Value="True"/> 306 <ComponentName Value="RatesDlg"/> 308 307 <HasResources Value="True"/> 309 308 <ResourceBaseClass Value="Form"/> 310 309 </Unit35> 311 310 <Unit36> 312 <Filename Value="Platform.pas"/> 313 <IsPartOfProject Value="True"/> 311 <Filename Value="LocalPlayer\TechTree.pas"/> 312 <IsPartOfProject Value="True"/> 313 <ComponentName Value="TechTreeDlg"/> 314 <HasResources Value="True"/> 315 <ResourceBaseClass Value="Form"/> 314 316 </Unit36> 315 317 <Unit37> 316 <Filename Value=" Switches.inc"/>318 <Filename Value="Platform.pas"/> 317 319 <IsPartOfProject Value="True"/> 318 320 </Unit37> 319 321 <Unit38> 320 <Filename Value="Locale.pas"/> 321 <IsPartOfProject Value="True"/> 322 <ComponentName Value="LocaleDlg"/> 323 <HasResources Value="True"/> 324 <ResourceBaseClass Value="Form"/> 322 <Filename Value="Switches.inc"/> 323 <IsPartOfProject Value="True"/> 325 324 </Unit38> 326 325 <Unit39> 326 <Filename Value="Locale.pas"/> 327 <IsPartOfProject Value="True"/> 328 <ComponentName Value="LocaleDlg"/> 329 <HasResources Value="True"/> 330 </Unit39> 331 <Unit40> 327 332 <Filename Value="IPQ.pas"/> 328 333 <IsPartOfProject Value="True"/> 329 </Unit 39>334 </Unit40> 330 335 </Units> 331 336 </ProjectOptions> … … 361 366 <Linking> 362 367 <Debugging> 363 <UseHeaptrc Value="True"/>364 368 <UseExternalDbgSyms Value="True"/> 365 369 </Debugging> … … 378 382 </CompilerOptions> 379 383 <Debugging> 380 <Exceptions Count=" 3">384 <Exceptions Count="4"> 381 385 <Item1> 382 386 <Name Value="EAbort"/> … … 388 392 <Name Value="EFOpenError"/> 389 393 </Item3> 394 <Item4> 395 <Name Value="EReadError"/> 396 </Item4> 390 397 </Exceptions> 391 398 </Debugging> -
branches/highdpi/Integrated.lpr
r166 r178 24 24 Term in 'LocalPlayer\Term.pas' {MainScreen} , 25 25 MessgEx in 'LocalPlayer\MessgEx.pas' {MessgExDlg} , 26 BaseWin in 'LocalPlayer\BaseWin.pas', 26 27 Help in 'LocalPlayer\Help.pas' {HelpDlg} , 27 28 Select in 'LocalPlayer\Select.pas' {ListDlg} , … … 39 40 Rates in 'LocalPlayer\Rates.pas' {RatesDlg} , 40 41 TechTree in 'LocalPlayer\TechTree.pas' {TechTreeDlg}, 41 ScreenTools, Directories ;42 ScreenTools, Directories, UDpiControls; 42 43 43 44 {$if declared(UseHeapTrace)} … … 56 57 57 58 DotNetClient := nil; 58 Application.Initialize;59 Application.Title := 'c-evo';59 DpiApplication.Initialize; 60 DpiApplication.Title := 'c-evo'; 60 61 Directories.InitUnit; 61 62 ScreenTools.UnitInit; 62 Application.CreateForm(TDirectDlg, DirectDlg);63 Application.CreateForm(TStartDlg, StartDlg);64 Application.CreateForm(TMessgDlg, MessgDlg);65 Application.CreateForm(TInputDlg, InputDlg);66 Application.CreateForm(TBackground, Background);67 Application.CreateForm(TLogDlg, LogDlg);68 Application.Run;63 DpiApplication.CreateForm(TDirectDlg, DirectDlg); 64 DpiApplication.CreateForm(TStartDlg, StartDlg); 65 DpiApplication.CreateForm(TMessgDlg, MessgDlg); 66 DpiApplication.CreateForm(TInputDlg, InputDlg); 67 DpiApplication.CreateForm(TBackground, Background); 68 DpiApplication.CreateForm(TLogDlg, LogDlg); 69 DpiApplication.Run; 69 70 ScreenTools.UnitDone; 70 71 end. -
branches/highdpi/Language.txt
r167 r178 942 942 Hurry\Production 943 943 Maximize\Production 944 945 #SETTINGS946 Full screen -
branches/highdpi/LocalPlayer/Battle.pas
r111 r178 6 6 uses 7 7 ScreenTools, Protocol, Messg, ButtonBase, ButtonA, Types, LCLIntf, LCLType, 8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg ;8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg, UDpiControls; 9 9 10 10 type … … 30 30 BattleDlg: TBattleDlg; 31 31 32 procedure PaintBattleOutcome(ca: T Canvas; xm, ym, uix, ToLoc: Integer;32 procedure PaintBattleOutcome(ca: TDpiCanvas; xm, ym, uix, ToLoc: Integer; 33 33 Forecast: TBattleForecastEx); 34 34 … … 48 48 FirstStrikeColor = $A0A0A0; 49 49 50 procedure PaintBattleOutcome(ca: T Canvas; xm, ym, uix, ToLoc: Integer;50 procedure PaintBattleOutcome(ca: TDpiCanvas; xm, ym, uix, ToLoc: Integer; 51 51 Forecast: TBattleForecastEx); 52 52 var -
branches/highdpi/LocalPlayer/CityScreen.pas
r173 r178 8 8 LMessages, 9 9 {$ENDIF} 10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, 10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, UDpiControls, 11 11 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 12 12 ButtonA, ButtonC, Area, GraphType; … … 74 74 AreaMap: TIsoMap; 75 75 CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap, 76 Template: T Bitmap;76 Template: TDpiBitmap; 77 77 IsPort, ProdHint, AllowChange: boolean; 78 78 procedure InitSmallCityMap; … … 90 90 91 91 uses 92 Select, Messg, MessgEx, Help, Tribes, Directories, Math , PixelPointer, Sound;92 Select, Messg, MessgEx, Help, Tribes, Directories, Math; 93 93 94 94 {$R *.lfm} … … 210 210 end; 211 211 212 Back := T Bitmap.Create;212 Back := TDpiBitmap.Create; 213 213 Back.PixelFormat := pf24bit; 214 214 Back.SetSize(Width, Height); 215 215 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height); 216 Template := T Bitmap.Create;216 Template := TDpiBitmap.Create; 217 217 Template.PixelFormat := pf24bit; 218 218 LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'City.png', gfNoGamma); 219 CityMapTemplate := T Bitmap.Create;219 CityMapTemplate := TDpiBitmap.Create; 220 220 CityMapTemplate.PixelFormat := pf24bit; 221 221 LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics' + DirectorySeparator + 'BigCityMap.png', gfNoGamma); 222 SmallCityMapTemplate := T Bitmap.Create;222 SmallCityMapTemplate := TDpiBitmap.Create; 223 223 SmallCityMapTemplate.PixelFormat := pf24bit; 224 224 LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics' + DirectorySeparator + 'SmallCityMap.png', 225 225 gfNoGamma); 226 SmallCityMap := T Bitmap.Create;226 SmallCityMap := TDpiBitmap.Create; 227 227 SmallCityMap.PixelFormat := pf24bit; 228 228 SmallCityMap.SetSize(98, 74); 229 229 SmallCityMap.Canvas.FillRect(0, 0, SmallCityMap.Width, SmallCityMap.Height); 230 ZoomCityMap := T Bitmap.Create;230 ZoomCityMap := TDpiBitmap.Create; 231 231 ZoomCityMap.PixelFormat := pf24bit; 232 232 ZoomCityMap.SetSize(228, 124); -
branches/highdpi/LocalPlayer/Diagram.pas
r135 r178 6 6 uses 7 7 BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 8 ButtonB, Menus ;8 ButtonB, Menus, UDpiControls; 9 9 10 10 type … … 34 34 DiaDlg: TDiaDlg; 35 35 36 procedure PaintColonyShip(canvas: T Canvas; Player, Left, Width, Top: integer);36 procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer); 37 37 38 38 implementation … … 55 55 yHab: array [0 .. 1] of integer = (-81, 1); 56 56 57 procedure PaintColonyShip(canvas: T Canvas; Player, Left, Width, Top: integer);57 procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer); 58 58 var 59 59 i, x, r, nComp, nPow, nHab: integer; -
branches/highdpi/LocalPlayer/Draft.pas
r104 r178 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 9 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 9 ButtonA, … … 35 34 IncCap, DecCap: integer; 36 35 code: array [0 .. nFeature - 1] of integer; 37 Template, Back: T Bitmap;36 Template, Back: TDpiBitmap; 38 37 function IsFeatureInList(d, i: integer): boolean; 39 38 procedure SetDomain(d: integer); … … 86 85 end; 87 86 88 Back := T Bitmap.Create;87 Back := TDpiBitmap.Create; 89 88 Back.PixelFormat := pf24bit; 90 89 Back.SetSize(Width, Height); 91 90 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height); 92 Template := T Bitmap.Create;91 Template := TDpiBitmap.Create; 93 92 Template.PixelFormat := pf24bit; 94 93 LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'MiliRes.png', gfNoGamma); -
branches/highdpi/LocalPlayer/Help.pas
r172 r178 5 5 6 6 uses 7 Protocol, ScreenTools, BaseWin, StringTables, Math, 7 Protocol, ScreenTools, BaseWin, StringTables, Math, UDpiControls, 8 8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 9 ExtCtrls, ButtonB, PVSB, Types , fgl;9 ExtCtrls, ButtonB, PVSB, Types; 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 LineFeed; 46 procedure AppendList(Source: THyperText); 45 procedure LF; 47 46 destructor Destroy; override; 48 end;49 50 { THistItem }51 52 THistItem = class53 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;64 47 end; 65 48 … … 89 72 procedure OffscreenPaint; override; 90 73 private 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; 98 CaptionFont: TFont; 99 MainText: THyperText; 100 SearchResult: THyperText; 74 Kind, no, Sel, nHist, CaptionColor: integer; 75 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, 76 hJOBHELP: integer; 77 SearchContent, NewSearchContent: string; 78 CaptionFont: TDpiFont; 79 MainText, SearchResult: THyperText; 101 80 HelpText: TStringTable; 102 ExtPic, TerrIcon: TBitmap; 103 ScrollBar: TPVScrollbar; 104 x0: array [-2..180] of Integer; 105 procedure PaintTerrIcon(x, y, xSrc, ySrc: Integer); 81 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; 106 88 procedure ScrollBarUpdate(Sender: TObject); 107 procedure Line(ca: TCanvas; i: Integer; lit: Boolean); 108 procedure Prepare(sbPos: Integer = 0); 109 procedure ShowNewContentProcExecute(NewMode: Integer; HelpContext: string); 110 procedure WaterSign(x0, y0, iix: Integer); 89 procedure line(ca: TDpiCanvas; i: integer; lit: boolean); 90 procedure Prepare(sbPos: integer = 0); 91 procedure WaterSign(x0, y0, iix: integer); 111 92 procedure Search(SearchString: string); 112 93 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 113 94 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 114 95 public 115 HistItems: THistItems;116 Difficulty: Integer;96 Difficulty: integer; 97 procedure ShowNewContent(NewMode, Category, Index: integer); 117 98 procedure ClearHistory; 118 procedure ShowNewContent(NewMode, Category, Index: Integer); 119 function TextIndex(Item: string): Integer; 99 function TextIndex(Item: string): integer; 120 100 end; 121 101 … … 126 106 127 107 uses 128 Directories, ClientTools, Term, Tribes, Inp, Messg , PixelPointer;108 Directories, ClientTools, Term, Tribes, Inp, Messg; 129 109 130 110 {$R *.lfm} 131 111 132 112 type 133 134 { THelpLineInfo }135 136 113 THelpLineInfo = class 137 Format: Byte; 138 Picpix: Byte; 114 Format, Picpix: Byte; 139 115 Link: Word; 140 procedure Assign(Source: THelpLineInfo); 141 end; 142 143 { THelpLineInfo } 144 145 procedure THelpLineInfo.Assign(Source: THelpLineInfo); 146 begin 147 Format := Source.Format; 148 PicPix := Source.PicPix; 149 Link := Source.Link; 150 end; 151 152 { THistItem } 153 154 procedure THistItem.Assign(Source: THistItem); 155 begin 156 Kind := Source.Kind; 157 No := Source.No; 158 Pos := Source.Pos; 159 SearchContent := Source.SearchContent; 160 end; 161 162 { THistItems } 163 164 function THistItems.AddNew(Kind, No, Pos: Integer; SearchContent: string 165 ): THistItem; 166 begin 167 Result := THistItem.Create; 168 Result.Kind := Kind; 169 Result.No := No; 170 Result.Pos := Pos; 171 Result.SearchContent := SearchContent; 172 Add(Result); 173 end; 116 end; 174 117 175 118 procedure THyperText.AddLine(s: String; Format: integer; Picpix: integer; … … 187 130 end; 188 131 189 procedure THyperText.L ineFeed;132 procedure THyperText.LF; 190 133 begin 191 134 AddLine; 192 end;193 194 procedure THyperText.AppendList(Source: THyperText);195 var196 I: Integer;197 HelpLineInfo: THelpLineInfo;198 begin199 for I := 0 to Source.Count - 1 do begin200 HelpLineInfo := THelpLineInfo.Create;201 HelpLineInfo.Assign(THelpLineInfo(Source.Objects[I]));202 AddObject(Source.Strings[I], HelpLineInfo);203 end;204 135 end; 205 136 … … 267 198 begin 268 199 inherited; 269 HistItems := THistItems.Create;270 271 200 CaptionLeft := BackBtn.Left + BackBtn.Width; 272 201 CaptionRight := SearchBtn.Left; … … 276 205 SearchResult := THyperText.Create; 277 206 SearchResult.OwnsObjects := True; 278 ScrollBar:= TPVScrollbar.Create(Self);279 ScrollBar.SetBorderSpacing(36, 9, 11);280 ScrollBar.OnUpdate := ScrollBarUpdate;207 sb := TPVScrollbar.Create(Self); 208 sb.SetBorderSpacing(36, 9, 11); 209 sb.OnUpdate := ScrollBarUpdate; 281 210 282 211 HelpText := TStringTable.Create; … … 289 218 hJOBHELP := HelpText.Gethandle('JOBHELP'); 290 219 291 CaptionFont := Font.Create;220 CaptionFont := TDpiFont.Create; 292 221 CaptionFont.Assign(UniFont[ftNormal]); 293 222 CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold]; … … 298 227 SearchBtn.Hint := Phrases.Lookup('BTN_SEARCH'); 299 228 300 ExtPic := T Bitmap.Create;301 TerrIcon := T Bitmap.Create;229 ExtPic := TDpiBitmap.Create; 230 TerrIcon := TDpiBitmap.Create; 302 231 TerrIcon.PixelFormat := pf24bit; 303 232 TerrIcon.SetSize(xSizeBig, ySizeBig); 304 233 TerrIcon.Canvas.FillRect(0, 0, TerrIcon.Width, TerrIcon.Height); 305 234 SearchContent := ''; 306 ShowNewContentProc := ShowNewContentProcExecute;235 nHist := -1; 307 236 end; 308 237 309 procedure THelpDlg.ShowNewContentProcExecute(NewMode: Integer; 310 HelpContext: string); 311 begin 312 HelpDlg.ShowNewContent(NewMode, hkText, 313 HelpDlg.TextIndex(HelpContext)) 238 procedure THelpDlg.ClearHistory; 239 begin 240 nHist := -1; 314 241 end; 315 242 316 243 procedure THelpDlg.FormDestroy(Sender: TObject); 317 244 begin 318 ShowNewContentProc := nil; 319 FreeAndNil(ScrollBar); 245 FreeAndNil(sb); 320 246 FreeAndNil(MainText); 321 247 FreeAndNil(SearchResult); … … 324 250 FreeAndNil(HelpText); 325 251 // FreeAndNil(CaptionFont); 326 FreeAndNil(HistItems);327 252 end; 328 253 … … 330 255 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 331 256 begin 332 if ScrollBar.ProcessMouseWheel(WheelDelta) then begin257 if sb.ProcessMouseWheel(WheelDelta) then begin 333 258 PaintBox1MouseMove(nil, [], MousePos.X - Left, 334 259 MousePos.Y - Top); … … 344 269 begin 345 270 { TODO: Handled by MouseWheel event 346 if ScrollBar.Process(m) then begin271 if sb.Process(m) then begin 347 272 Sel := -1; 348 273 SmartUpdateContent(true) … … 354 279 begin 355 280 if Sel <> -1 then begin 356 Line(Canvas, Sel, false);281 line(Canvas, Sel, false); 357 282 Sel := -1 358 283 end 359 284 end; 360 285 361 procedure THelpDlg.ClearHistory;362 begin363 HistItems.Clear;364 end;365 366 286 procedure THelpDlg.FormPaint(Sender: TObject); 367 287 begin … … 370 290 end; 371 291 372 procedure THelpDlg. Line(ca: TCanvas; i: Integer; lit: Boolean);292 procedure THelpDlg.line(ca: TDpiCanvas; i: integer; lit: boolean); 373 293 var 374 TextColor, x, y: Integer;294 TextColor, x, y: integer; 375 295 TextSize: TSize; 376 296 s: string; 377 297 begin 378 s := MainText[ ScrollBar.Position + i];298 s := MainText[sb.Position + i]; 379 299 if s = '' then 380 Exit;300 exit; 381 301 x := x0[i]; 382 302 y := 2 + i * 24; … … 386 306 y := y + WideFrame 387 307 end; 388 if THelpLineInfo(MainText.Objects[ ScrollBar.Position + i]).Format308 if THelpLineInfo(MainText.Objects[sb.Position + i]).Format 389 309 in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then 390 310 begin … … 402 322 ca.Font.Assign(UniFont[ftNormal]); 403 323 end 404 else if THelpLineInfo(MainText.Objects[ ScrollBar.Position + i]).Format = pkSection324 else if THelpLineInfo(MainText.Objects[sb.Position + i]).Format = pkSection 405 325 then 406 326 begin … … 421 341 TextSize.cy := WideFrame + InnerHeight - y; 422 342 FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame, 423 ScrollBar.Position * 24 - WideFrame, Paper);343 sb.Position * 24 - WideFrame, Paper); 424 344 end; 425 345 BiColorTextOut(ca, TextColor, $7F007F, x, y, s); … … 427 347 with ca do 428 348 begin 429 Assert(ca = Canvas);430 Pen.Color := TextColor;431 MoveTo(x + 1, y + TextSize.cy - 2);432 LineTo(x + TextSize.cx, y + TextSize.cy - 2);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); 433 353 end; 434 354 if (Kind = hkMisc) and (no = miscMain) then … … 443 363 var 444 364 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 445 Heaven: array [0 ..nHeaven] of integer;365 Heaven: array [0 .. nHeaven] of integer; 446 366 PaintPtr, CoalPtr: TPixelPointer; 447 ImpPtr: array [-1 ..1] of TPixelPointer;367 ImpPtr: array [-1 .. 1] of TPixelPointer; 448 368 begin 449 369 // assume eiffel tower has free common heaven … … 494 414 end; 495 415 496 procedure THelpDlg.PaintTerrIcon(x, y, xSrc, ySrc: integer); 497 begin 498 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 499 $000000, $000000); 500 if 2 * yyt < 40 then begin 501 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 502 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 416 procedure THelpDlg.OffscreenPaint; 417 418 procedure PaintTerrIcon(x, y, xSrc, ySrc: integer); 419 begin 420 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 421 $000000, $000000); 422 if 2 * yyt < 40 then 423 begin 424 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 425 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 426 xSrc, ySrc); 427 end 428 else 429 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 430 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 431 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 432 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 433 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 503 434 xSrc, ySrc); 504 end else 505 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 506 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 507 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 508 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 509 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 510 xSrc, ySrc); 511 end; 512 513 procedure THelpDlg.OffscreenPaint; 435 end; 436 514 437 var 515 i, j, yl, srcno, ofs, cnt, y: Integer;438 i, j, yl, srcno, ofs, cnt, y: integer; 516 439 s: string; 517 440 HelpLineInfo: THelpLineInfo; … … 520 443 CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption]; 521 444 FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0, 522 ScrollBar.Position * 24, Paper);445 sb.Position * 24, Paper); 523 446 with OffScreen.Canvas do 524 447 begin 525 448 Font.Assign(UniFont[ftNormal]); 526 for i := - ScrollBar.Position to InnerHeight div 24 do527 if ScrollBar.Position + i < MainText.Count then449 for i := -sb.Position to InnerHeight div 24 do 450 if sb.Position + i < MainText.Count then 528 451 begin 529 HelpLineInfo := THelpLineInfo(MainText.Objects[ ScrollBar.Position + i]);452 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.Position + i]); 530 453 if HelpLineInfo.Format = pkExternal then 531 454 begin … … 538 461 end; 539 462 for i := -2 to InnerHeight div 24 do 540 if ( ScrollBar.Position + i >= 0) and (ScrollBar.Position + i < MainText.Count) then463 if (sb.Position + i >= 0) and (sb.Position + i < MainText.Count) then 541 464 begin 542 HelpLineInfo := THelpLineInfo(MainText.Objects[ ScrollBar.Position + i]);465 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.Position + i]); 543 466 if HelpLineInfo.Link <> 0 then 544 467 begin … … 844 767 x0[i] := 64 + 8 + 8; 845 768 else 846 x0[i] := x0[i] + 8 ;769 x0[i] := x0[i] + 8 847 770 end; 848 Self. Line(OffScreen.Canvas, i, False)771 Self.line(OffScreen.Canvas, i, false) 849 772 end; 850 773 end; 851 774 MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48); 852 end; 775 end; { OffscreenPaint } 853 776 854 777 procedure THelpDlg.ScrollBarUpdate(Sender: TObject); … … 860 783 procedure THelpDlg.Prepare(sbPos: integer = 0); 861 784 var 862 i, j, Special, Domain, Headline, TerrType, TerrSubType: integer;785 i, j, special, Domain, Headline, TerrType, TerrSubType: integer; 863 786 s: string; 864 787 ps: pchar; 865 788 List: THyperText; 866 CheckSeeAlso: Boolean;867 868 procedure AddAdv ance(i: integer);789 CheckSeeAlso: boolean; 790 791 procedure AddAdv(i: integer); 869 792 begin 870 793 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, … … 878 801 end; 879 802 880 procedure AddImp rovement(i: integer);803 procedure AddImp(i: integer); 881 804 begin 882 805 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, … … 890 813 end; 891 814 892 procedure AddTer rain(i: integer);815 procedure AddTer(i: integer); 893 816 begin 894 817 if MainText.Count > 1 then 895 818 begin 896 MainText.L ineFeed;819 MainText.LF; 897 820 end; 898 821 MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i); … … 911 834 begin 912 835 if MainText.Count > 1 then 913 MainText.L ineFeed;836 MainText.LF; 914 837 FindStdModelPicture(SpecialModelPictureCode[i], pix, Name); 915 838 MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i) … … 925 848 begin 926 849 AddLine('', pkLogo); 927 L ineFeed;850 LF; 928 851 end 929 852 else if Item = 'TECHFORMULA' then … … 941 864 for i := 1 to 3 do 942 865 begin 943 L ineFeed;866 LF; 944 867 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i); 945 868 end … … 952 875 end; 953 876 954 procedure DecodeItem(s: string; var Category, Index: Integer);877 procedure DecodeItem(s: string; var Category, Index: integer); 955 878 var 956 i: Integer; 957 begin 958 if (Length(s) > 0) and (s[1] = ':') then begin 879 i: integer; 880 begin 881 if (length(s) > 0) and (s[1] = ':') then 882 begin 959 883 Category := hkMisc; 960 884 Index := 0; 961 885 for i := 3 to length(s) do 962 Index := Index * 10 + Ord(s[i]) - 48;886 Index := Index * 10 + ord(s[i]) - 48; 963 887 case s[2] of 964 'A': Category := hkAdv; 965 'B': Category := hkImp; 966 'T': Category := hkTer; 967 'F': Category := hkFeature; 968 'E': Category := hkInternet; 969 'S': Category := hkModel; 970 'C': Index := miscCredits; 971 'J': Index := miscJobList; 972 'G': Index := miscGovList; 888 'A': 889 Category := hkAdv; 890 'B': 891 Category := hkImp; 892 'T': 893 Category := hkTer; 894 'F': 895 Category := hkFeature; 896 'E': 897 Category := hkInternet; 898 'S': 899 Category := hkModel; 900 'C': 901 Index := miscCredits; 902 'J': 903 Index := miscJobList; 904 'G': 905 Index := miscGovList; 973 906 end; 974 907 if (Category <> hkMisc) and (Index = 0) then 975 908 Index := 200; 976 end else begin 909 end 910 else 911 begin 977 912 Category := hkText; 978 Index := HelpText.Gethandle( Copy(s, 1, 255));913 Index := HelpText.Gethandle(copy(s, 1, 255)); 979 914 end; 980 915 end; … … 998 933 repeat 999 934 inc(p) 1000 until (p > Length(s)) or (s[p] = '\');1001 Caption := Copy(s, 2, p - 2);935 until (p > length(s)) or (s[p] = '\'); 936 Caption := copy(s, 2, p - 2); 1002 937 Delete(s, 1, p); 1003 938 end … … 1007 942 repeat 1008 943 inc(p) 1009 until (p > Length(s)) or (s[p] = '\');1010 AddStandardBlock( Copy(s, 2, p - 2));944 until (p > length(s)) or (s[p] = '\'); 945 AddStandardBlock(copy(s, 2, p - 2)); 1011 946 Delete(s, 1, p); 1012 947 end 1013 948 else if s[1] = '@' then 1014 949 begin // image 1015 if ( Length(s) >= 2) and (s[2] = '@') then950 if (length(s) >= 2) and (s[2] = '@') then 1016 951 begin // generate from icon 1017 952 Picpix := 0; 1018 953 p := 3; 1019 while (p <= Length(s)) and (s[p] <> '\') do954 while (p <= length(s)) and (s[p] <> '\') do 1020 955 begin 1021 Picpix := Picpix * 10 + Ord(s[p]) - 48;956 Picpix := Picpix * 10 + ord(s[p]) - 48; 1022 957 inc(p) 1023 958 end; … … 1025 960 Picpix := 0; 1026 961 MainText.AddLine('', pkIllu, Picpix); 1027 MainText.L ineFeed;1028 MainText.L ineFeed;962 MainText.LF; 963 MainText.LF; 1029 964 end 1030 965 else … … 1032 967 p := 1; 1033 968 repeat 1034 Inc(p)1035 until (p > Length(s)) or (s[p] = '\');969 inc(p) 970 until (p > length(s)) or (s[p] = '\'); 1036 971 if LoadGraphicFile(ExtPic, LocalizedFilePath('Help' + 1037 DirectorySeparator + Copy(s, 2, p - 2)) + '.png') then972 DirectorySeparator + copy(s, 2, p - 2)) + '.png') then 1038 973 begin 1039 974 MainText.AddLine('', pkExternal); 1040 975 for i := 0 to (ExtPic.Height - 12) div 24 do 1041 MainText.L ineFeed;976 MainText.LF; 1042 977 end; 1043 978 end; … … 1052 987 repeat 1053 988 inc(p) 1054 until (p > Length(s)) or (s[p] = '\') or (s[p] = ' ');1055 DecodeItem( Copy(s, 2, p - 2), LinkCategory, LinkIndex);989 until (p > length(s)) or (s[p] = '\') or (s[p] = ' '); 990 DecodeItem(copy(s, 2, p - 2), LinkCategory, LinkIndex); 1056 991 CurrentFormat := 0; 1057 992 if (LinkCategory <> hkText) and (LinkIndex < 200) then … … 1071 1006 begin 1072 1007 CurrentFormat := pkTer; 1073 Picpix := LinkIndex ;1008 Picpix := LinkIndex 1074 1009 end; 1075 1010 hkFeature: … … 1087 1022 if s[1] = ':' then 1088 1023 LinkCategory := LinkCategory + hkCrossLink; 1089 if (p > Length(s)) or (s[p] = ' ') then1024 if (p > length(s)) or (s[p] = ' ') then 1090 1025 Delete(s, 1, p) 1091 1026 else … … 1093 1028 end; 1094 1029 '!': // highlited 1095 if ( Length(s) >= 2) and (s[2] = '!') then1030 if (length(s) >= 2) and (s[2] = '!') then 1096 1031 begin 1097 1032 if MainText.Count > 1 then 1098 MainText.L ineFeed;1033 MainText.LF; 1099 1034 FollowFormat := pkCaption; 1100 1035 CurrentFormat := pkCaption; … … 1123 1058 repeat 1124 1059 repeat 1125 Inc(p)1126 until (p > Length(s)) or (s[p] = ' ') or (s[p] = '\');1127 if (BiColorTextWidth(OffScreen.Canvas, Copy(s, 1, p - 1)) <=1060 inc(p) 1061 until (p > length(s)) or (s[p] = ' ') or (s[p] = '\'); 1062 if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <= 1128 1063 RightMargin - ofs) then 1129 1064 l := p - 1 1130 1065 else 1131 1066 Break; 1132 until (p >= Length(s)) or (s[l + 1] = '\');1133 MainText.AddLine( Copy(s, 1, l), CurrentFormat, Picpix, LinkCategory,1067 until (p >= length(s)) or (s[l + 1] = '\'); 1068 MainText.AddLine(copy(s, 1, l), CurrentFormat, Picpix, LinkCategory, 1134 1069 LinkIndex); 1135 if (l < Length(s)) and (s[l + 1] = '\') then1070 if (l < length(s)) and (s[l + 1] = '\') then 1136 1071 FollowFormat := pkNormal; 1137 1072 Delete(s, 1, l + 1); … … 1145 1080 end; 1146 1081 1147 procedure AddModelText(i: Integer);1082 procedure AddModelText(i: integer); 1148 1083 var 1149 pix: Integer;1084 pix: integer; 1150 1085 s: string; 1151 1086 begin 1152 with MainText do begin 1153 if Count > 1 then begin 1154 LineFeed; 1155 LineFeed; 1087 with MainText do 1088 begin 1089 if Count > 1 then 1090 begin 1091 LF; 1092 LF; 1156 1093 end; 1157 1094 FindStdModelPicture(SpecialModelPictureCode[i], pix, s); … … 1187 1124 procedure AddJobList; 1188 1125 var 1189 i, JobCost: Integer; 1190 begin 1191 with MainText do begin 1192 for i := 0 to nJobHelp - 1 do begin 1193 if i > 0 then begin 1194 LineFeed; 1195 LineFeed; 1126 i, JobCost: integer; 1127 begin 1128 with MainText do 1129 begin 1130 for i := 0 to nJobHelp - 1 do 1131 begin 1132 if i > 0 then 1133 begin 1134 LF; 1135 LF 1196 1136 end; 1197 1137 AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection); … … 1202 1142 JobCost := -1; 1203 1143 case JobHelp[i] of 1204 jCanal: JobCost := CanalWork; 1205 jFort: JobCost := FortWork; 1206 jBase: JobCost := BaseWork; 1144 jCanal: 1145 JobCost := CanalWork; 1146 jFort: 1147 JobCost := FortWork; 1148 jBase: 1149 JobCost := BaseWork; 1207 1150 end; 1208 1151 if JobCost >= 0 then … … 1211 1154 else 1212 1155 AddTextual(HelpText.Lookup('JOBCOSTVAR')); 1213 if JobPreq[JobHelp[i]] <> preNone then begin 1156 if JobPreq[JobHelp[i]] <> preNone then 1157 begin 1214 1158 AddPreqAdv(JobPreq[JobHelp[i]]); 1215 1159 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), … … 1222 1166 procedure AddGraphicCredits; 1223 1167 var 1224 i: Integer;1168 i: integer; 1225 1169 s: string; 1226 1170 sr: TSearchRec; 1227 List, Plus: TStringList;1171 List, plus: TStringList; 1228 1172 begin 1229 1173 List := TStringList.Create; 1230 Plus := TStringList.Create;1174 plus := TStringList.Create; 1231 1175 if FindFirst(HomeDir + 'Graphics' + DirectorySeparator + '*.credits.txt', $27, sr) = 0 then 1232 1176 repeat 1233 Plus.LoadFromFile(HomeDir + 'Graphics' + DirectorySeparator + sr.Name);1234 List.AddStrings( Plus);1177 plus.LoadFromFile(HomeDir + 'Graphics' + DirectorySeparator + sr.Name); 1178 List.AddStrings(plus); 1235 1179 until FindNext(sr) <> 0; 1236 1180 FindClose(sr); 1237 Plus.Free;1181 plus.Free; 1238 1182 1239 1183 List.Sort; … … 1243 1187 List.Delete(i) 1244 1188 else 1245 Inc(i); 1246 1247 for i := 0 to List.Count - 1 do begin 1189 inc(i); 1190 1191 for i := 0 to List.Count - 1 do 1192 begin 1248 1193 s := List[i]; 1249 1194 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1257 1202 procedure AddSoundCredits; 1258 1203 var 1259 i: Integer;1204 i: integer; 1260 1205 s: string; 1261 1206 List: TStringList; … … 1263 1208 List := TStringList.Create; 1264 1209 List.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.credits.txt'); 1265 for i := 0 to List.Count - 1 do begin 1210 for i := 0 to List.Count - 1 do 1211 begin 1266 1212 s := List[i]; 1267 1213 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1279 1225 MainText.Delete(Headline) 1280 1226 else 1281 MainText.L ineFeed;1227 MainText.LF; 1282 1228 MainText.AddLine(HelpText.Lookup(Item), pkSection); 1283 1229 Headline := MainText.Count - 1; … … 1285 1231 1286 1232 begin { Prepare } 1287 with MainText do begin 1233 with MainText do 1234 begin 1288 1235 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 1289 CheckSeeAlso := False;1236 CheckSeeAlso := false; 1290 1237 Clear; 1291 1238 Headline := -1; 1292 1239 if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then 1293 L ineFeed;1240 LF; 1294 1241 case Kind of 1295 1242 hkText: … … 1303 1250 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon, 1304 1251 0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK')); 1305 L ineFeed;1252 LF; 1306 1253 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6, 1307 1254 hkText, HelpText.Gethandle('CONCEPTS')); 1308 L ineFeed;1255 LF; 1309 1256 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1, 1310 1257 hkTer, 200); 1311 L ineFeed;1258 LF; 1312 1259 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2, 1313 1260 hkMisc, miscJobList); 1314 L ineFeed;1261 LF; 1315 1262 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39, 1316 1263 hkAdv, 200); 1317 L ineFeed;1264 LF; 1318 1265 FindStdModelPicture(SpecialModelPictureCode[6], i, s); 1319 1266 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i, 1320 1267 hkModel, 0); 1321 L ineFeed;1268 LF; 1322 1269 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28, 1323 1270 hkFeature, 200); 1324 L ineFeed;1271 LF; 1325 1272 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon, 1326 1273 7 * SystemIconLines + imCourt, hkImp, 200); 1327 L ineFeed;1274 LF; 1328 1275 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon, 1329 1276 7 * SystemIconLines + imStockEx, hkImp, 201); 1330 L ineFeed;1277 LF; 1331 1278 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon, 1332 1279 7 * SystemIconLines, hkImp, 202); 1333 L ineFeed;1280 LF; 1334 1281 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon, 1335 1282 gDemocracy + 6, hkMisc, miscGovList); 1336 L ineFeed;1283 LF; 1337 1284 AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText, 1338 1285 HelpText.Gethandle('HOTKEYS')); 1339 L ineFeed;1286 LF; 1340 1287 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1, 1341 1288 hkText, HelpText.Gethandle('ABOUT')); 1342 L ineFeed;1289 LF; 1343 1290 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22, 1344 1291 hkMisc, miscCredits); … … 1347 1294 begin 1348 1295 AddItem('CREDITS'); 1349 L ineFeed;1296 LF; 1350 1297 AddGraphicCredits; 1351 1298 NextSection('CRED_CAPSOUND'); … … 1361 1308 Caption := HelpText.Lookup('HELPTITLE_JOBLIST'); 1362 1309 AddJobList; 1363 L ineFeed;1310 LF; 1364 1311 AddItem('TERIMPEXCLUDE'); 1365 L ineFeed;1312 LF; 1366 1313 AddItem('TERIMPCITY'); 1367 1314 end; … … 1372 1319 begin 1373 1320 AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection); 1374 L ineFeed;1321 LF; 1375 1322 if i = nGov then 1376 1323 AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace) 1377 1324 else 1378 1325 AddLine('', pkBigIcon, i + 6); 1379 L ineFeed;1326 LF; 1380 1327 AddTextual(HelpText.LookupByHandle(hGOVHELP, i mod nGov)); 1381 1328 if i mod nGov >= 2 then … … 1387 1334 if i < nGov then 1388 1335 begin 1389 L ineFeed;1390 L ineFeed;1336 LF; 1337 LF; 1391 1338 end 1392 1339 end … … 1396 1343 Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1397 1344 AddTextual(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1398 MainText.A ppendList(SearchResult);1399 end ;1345 MainText.AddStrings(SearchResult); 1346 end 1400 1347 end; // case no 1401 1348 end; … … 1406 1353 Caption := HelpText.Lookup('HELPTITLE_TECHLIST'); 1407 1354 List := THyperText.Create; 1408 List.OwnsObjects := True;1409 1355 for j := 0 to 3 do 1410 1356 begin 1411 1357 if j > 0 then 1412 1358 begin 1413 L ineFeed;1414 L ineFeed;1359 LF; 1360 LF; 1415 1361 end; 1416 1362 AddLine(HelpText.Lookup('TECHAGE', j), pkSection); … … 1430 1376 hkAdv, i); 1431 1377 List.Sort; 1432 A ppendList(List);1378 AddStrings(List); 1433 1379 end; 1434 List.Free ;1380 List.Free 1435 1381 end 1436 1382 else // single advance 1437 1383 begin 1438 1384 Caption := Phrases.Lookup('ADVANCES', no); 1439 L ineFeed;1385 LF; 1440 1386 AddLine(Phrases.Lookup('ADVANCES', no), pkCaption); 1441 1387 if no in FutureTech then 1442 1388 begin 1443 1389 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1444 L ineFeed;1390 LF; 1445 1391 if no = futResearchTechnology then 1446 1392 AddItem('FUTURETECHHELP100') … … 1465 1411 for i := 0 to 27 do 1466 1412 if Imp[i].Preq = no then 1467 AddImp rovement(i);1413 AddImp(i); 1468 1414 for i := 28 to nImp - 1 do 1469 1415 if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then 1470 AddImp rovement(i);1416 AddImp(i); 1471 1417 for i := 28 to nImp - 1 do 1472 1418 if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then 1473 AddImp rovement(i);1419 AddImp(i); 1474 1420 NextSection('MODELALLOW'); 1475 1421 for i := 0 to nSpecialModel - 1 do … … 1484 1430 if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or 1485 1431 (AdvPreq[i, 2] = no) then 1486 AddAdv ance(i);1432 AddAdv(i); 1487 1433 NextSection('UPGRADEALLOW'); 1488 1434 for Domain := 0 to nDomains - 1 do … … 1508 1454 for i := 0 to 27 do 1509 1455 if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then 1510 AddImp rovement(i);1456 AddImp(i); 1511 1457 NextSection('ADVEFFECT'); 1512 1458 s := HelpText.LookupByHandle(hADVHELP, no); … … 1523 1469 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1524 1470 List := THyperText.Create; 1525 List.OwnsObjects := True;1526 1471 for i := 28 to nImp - 1 do 1527 1472 if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and … … 1530 1475 i, hkImp, i); 1531 1476 List.Sort; 1532 A ppendList(List);1533 List.Free ;1477 AddStrings(List); 1478 List.Free 1534 1479 end 1535 1480 else if no = 201 then … … 1542 1487 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1543 1488 hkImp, i); 1544 { L ineFeed;1545 L ineFeed;1489 { LF; 1490 LF; 1546 1491 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1547 1492 for i:=28 to nImp-1 do … … 1561 1506 begin // single building 1562 1507 Caption := Phrases.Lookup('IMPROVEMENTS', no); 1563 L ineFeed;1508 LF; 1564 1509 AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no); 1565 1510 case Imp[no].Kind of 1566 ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1567 ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1568 ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1511 ikWonder: 1512 AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1513 ikCommon: 1514 AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1515 ikShipPart: 1516 AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1569 1517 else 1570 1518 AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1571 1519 end; 1572 if Imp[no].Kind <> ikShipPart then begin 1520 if Imp[no].Kind <> ikShipPart then 1521 begin 1573 1522 NextSection('EFFECT'); 1574 1523 AddTextual(HelpText.LookupByHandle(hIMPHELP, no)); 1575 1524 end; 1576 if no = woSun then begin 1525 if no = woSun then 1526 begin 1577 1527 AddFeature(mcFirst); 1578 1528 AddFeature(mcWill); … … 1581 1531 if (no < 28) and not Phrases2FallenBackToEnglish then 1582 1532 begin 1583 L ineFeed;1533 LF; 1584 1534 if Imp[no].Expiration >= 0 then 1585 1535 AddTextual(Phrases2.Lookup('HELP_WONDERMORALE1')) … … 1611 1561 j := 1 1612 1562 end; 1613 AddImp rovement(ImpReplacement[i].OldImp);1563 AddImp(ImpReplacement[i].OldImp); 1614 1564 end; 1615 1565 if Imp[no].Kind = ikShipPart then 1616 1566 begin 1617 L ineFeed;1567 LF; 1618 1568 if no = imShipComp then 1619 1569 i := 1 … … 1636 1586 NextSection('SEEALSO'); 1637 1587 if (no < 28) and (Imp[no].Expiration >= 0) then 1638 AddImp rovement(woEiffel);1588 AddImp(woEiffel); 1639 1589 for i := 0 to nImpReplacement - 1 do 1640 1590 if ImpReplacement[i].OldImp = no then 1641 AddImp rovement(ImpReplacement[i].NewImp);1591 AddImp(ImpReplacement[i].NewImp); 1642 1592 if no = imSupermarket then 1643 1593 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, … … 1652 1602 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1653 1603 for i := 0 to nTerrainHelp - 1 do 1654 AddTer rain(TerrainHelp[i]);1604 AddTer(TerrainHelp[i]); 1655 1605 end 1656 1606 else … … 1668 1618 begin 1669 1619 Caption := Phrases.Lookup('TERRAIN', no); 1670 L ineFeed;1620 LF; 1671 1621 AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no); 1672 1622 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1673 L ineFeed;1623 LF; 1674 1624 if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then 1675 1625 AddLine(Format(HelpText.Lookup('RESPROD'), … … 1697 1647 if no = 3 * 12 then 1698 1648 begin 1699 L ineFeed;1649 LF; 1700 1650 AddTextual(HelpText.Lookup('DEADLANDS')); 1701 1651 end; 1702 1652 if (TerrType = fDesert) and (no <> fDesert + 12) then 1703 1653 begin 1704 L ineFeed;1654 LF; 1705 1655 AddTextual(Format(HelpText.Lookup('HOSTILE'), [DesertThurst])); 1706 1656 end; 1707 1657 if TerrType = fArctic then 1708 1658 begin 1709 L ineFeed;1659 LF; 1710 1660 AddTextual(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst])); 1711 1661 end; 1712 1662 if (no < 3 * 12) and (TransTerrain >= 0) then 1713 1663 begin 1714 L ineFeed;1664 LF; 1715 1665 i := TransTerrain; 1716 1666 if (TerrType <> fGrass) and (i <> fGrass) then 1717 1667 i := i + TerrSubType * 12; 1718 // trafo to same Special resource group1668 // trafo to same special resource group 1719 1669 AddLine(Format(HelpText.Lookup('TRAFO'), 1720 1670 [Phrases.Lookup('TERRAIN', i)]), pkTer, i, … … 1722 1672 if no = fSwamp + 12 then 1723 1673 begin 1724 L ineFeed;1674 LF; 1725 1675 AddLine(Format(HelpText.Lookup('TRAFO'), 1726 1676 [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer, … … 1729 1679 else if i = fGrass then 1730 1680 begin 1731 L ineFeed;1681 LF; 1732 1682 AddLine(Format(HelpText.Lookup('TRAFO'), 1733 1683 [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12, … … 1738 1688 if no = 3 * 12 then 1739 1689 begin 1740 L ineFeed;1741 for Special := 1 to 3 do1690 LF; 1691 for special := 1 to 3 do 1742 1692 begin 1743 if Special > 1 then1744 L ineFeed;1745 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + Special), pkTer,1746 3 * 12 + Special);1693 if special > 1 then 1694 LF; 1695 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer, 1696 3 * 12 + special); 1747 1697 end 1748 1698 end 1749 1699 else if (no < 12) and (no <> fGrass) and (no <> fOcean) then 1750 1700 begin 1751 L ineFeed;1752 for Special := 1 to 2 do1753 if (no <> fArctic) and (no <> fSwamp) or ( Special < 2) then1701 LF; 1702 for special := 1 to 2 do 1703 if (no <> fArctic) and (no <> fSwamp) or (special < 2) then 1754 1704 begin 1755 if Special > 1 then1756 L ineFeed;1757 AddLine(Phrases.Lookup('TERRAIN', no + Special * 12), pkTer,1758 no + Special * 12);1759 i := FoodRes[ Special] - FoodRes[0];1705 if special > 1 then 1706 LF; 1707 AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer, 1708 no + special * 12); 1709 i := FoodRes[special] - FoodRes[0]; 1760 1710 if i <> 0 then 1761 1711 MainText[Count - 1] := MainText[Count - 1] + 1762 1712 Format(HelpText.Lookup('SPECIALFOOD'), [i]); 1763 i := ProdRes[ Special] - ProdRes[0];1713 i := ProdRes[special] - ProdRes[0]; 1764 1714 if i <> 0 then 1765 1715 MainText[Count - 1] := MainText[Count - 1] + 1766 1716 Format(HelpText.Lookup('SPECIALPROD'), [i]); 1767 i := TradeRes[ Special] - TradeRes[0];1717 i := TradeRes[special] - TradeRes[0]; 1768 1718 if i <> 0 then 1769 1719 MainText[Count - 1] := MainText[Count - 1] + … … 1773 1723 if no = 3 * 12 then 1774 1724 begin 1775 L ineFeed;1725 LF; 1776 1726 AddTextual(HelpText.Lookup('RARE')); 1777 1727 end; … … 1779 1729 begin 1780 1730 NextSection('SEEALSO'); 1781 AddImp rovement(woGardens);1731 AddImp(woGardens); 1782 1732 CheckSeeAlso := true 1783 1733 end … … 1790 1740 Caption := HelpText.Lookup('HELPTITLE_FEATURELIST'); 1791 1741 List := THyperText.Create; 1792 List.OwnsObjects := True; 1793 for Special := 0 to 2 do 1742 for special := 0 to 2 do 1794 1743 begin 1795 if Special > 0 then 1796 begin 1797 LineFeed; 1798 LineFeed; 1799 end; 1800 case Special of 1801 0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1802 1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1803 2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1744 if special > 0 then 1745 begin 1746 LF; 1747 LF 1748 end; 1749 case special of 1750 0: 1751 AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1752 1: 1753 AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1754 2: 1755 AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1804 1756 end; 1805 1757 List.Clear; … … 1813 1765 else 1814 1766 j := 1; 1815 if j = Special then1767 if j = special then 1816 1768 List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 1817 1769 hkFeature, i); 1818 1770 end; 1819 1771 List.Sort; 1820 A ppendList(List);1772 AddStrings(List); 1821 1773 end; 1822 List.Free ;1774 List.Free 1823 1775 end 1824 1776 else 1825 1777 begin // single feature 1826 1778 Caption := Phrases.Lookup('FEATURES', no); 1827 L ineFeed;1779 LF; 1828 1780 AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no); 1829 1781 if no < mcFirstNonCap then … … 1853 1805 if Feature[no].Preq <> preNone then 1854 1806 begin 1855 L ineFeed;1807 LF; 1856 1808 if Feature[no].Preq = preSun then 1857 1809 AddPreqImp(woSun) // sun tsu feature … … 1862 1814 end; 1863 1815 NextSection('SEEALSO'); 1864 CheckSeeAlso := True;1816 CheckSeeAlso := true 1865 1817 end; 1866 1818 … … 1871 1823 if i <> 2 then 1872 1824 AddModelText(i); 1873 L ineFeed;1825 LF; 1874 1826 AddItem('MODELNOTE'); 1875 1827 end; … … 1880 1832 if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then 1881 1833 case SeeAlso[i].SeeKind of 1882 hkImp: AddImprovement(SeeAlso[i].SeeNo); 1883 hkAdv: AddAdvance(SeeAlso[i].SeeNo); 1884 hkFeature: AddFeature(SeeAlso[i].SeeNo); 1834 hkImp: 1835 AddImp(SeeAlso[i].SeeNo); 1836 hkAdv: 1837 AddAdv(SeeAlso[i].SeeNo); 1838 hkFeature: 1839 AddFeature(SeeAlso[i].SeeNo); 1885 1840 end; 1886 1841 if (Headline >= 0) and (Count = Headline + 1) then 1887 1842 Delete(Headline) 1888 1843 else 1889 L ineFeed;1844 LF; 1890 1845 1891 1846 //Self.Show; 1892 ScrollBar.Init(Count - 1, InnerHeight div 24);1893 ScrollBar.SetPos(sbPos);1894 BackBtn.Visible := HistItems.Count > 1;1895 TopBtn.Visible := ( HistItems.Count > 1) or (Kind <> hkMisc) or (no <> miscMain);1847 sb.Init(Count - 1, InnerHeight div 24); 1848 sb.SetPos(sbPos); 1849 BackBtn.Visible := nHist > 0; 1850 TopBtn.Visible := (nHist > 0) or (Kind <> hkMisc) or (no <> miscMain); 1896 1851 Sel := -1; 1897 1852 end; // with MainText 1898 end; 1899 1900 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: Integer);1853 end; { Prepare } 1854 1855 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer); 1901 1856 begin 1902 1857 if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and 1903 (Index = miscSearchResult) then begin 1904 if HistItems.Count = MaxHist then HistItems.Delete(0); 1905 if HistItems.Count = 0 then 1906 HistItems.AddNew(Category, Index, ScrollBar.Position, NewSearchContent) 1907 else HistItems.AddNew(Kind, No, ScrollBar.Position, SearchContent); 1858 (Index = miscSearchResult) then 1859 begin 1860 if nHist = MaxHist then 1861 begin 1862 move(HistKind[2], HistKind[1], 4 * (nHist - 2)); 1863 move(HistNo[2], HistNo[1], 4 * (nHist - 2)); 1864 move(HistPos[2], HistPos[1], 4 * (nHist - 2)); 1865 move(HistSearchContent[2], HistSearchContent[1], 1866 sizeof(shortstring) * (nHist - 2)); 1867 end 1868 else 1869 inc(nHist); 1870 if nHist > 0 then 1871 begin 1872 HistKind[nHist - 1] := Kind; 1873 HistNo[nHist - 1] := no; 1874 HistPos[nHist - 1] := sb.Position; 1875 HistSearchContent[nHist - 1] := SearchContent 1876 end 1908 1877 end; 1909 1878 Kind := Category; … … 1918 1887 x, y: integer); 1919 1888 var 1920 i0, Sel0: Integer;1889 i0, Sel0: integer; 1921 1890 begin 1922 1891 y := y - WideFrame; 1923 i0 := ScrollBar.Position;1892 i0 := sb.Position; 1924 1893 Sel0 := Sel; 1925 1894 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and … … 1934 1903 begin 1935 1904 if Sel0 <> -1 then 1936 Line(Canvas, Sel0, False);1905 line(Canvas, Sel0, false); 1937 1906 if Sel <> -1 then 1938 Line(Canvas, Sel, True)1907 line(Canvas, Sel, true) 1939 1908 end 1940 1909 end; … … 1944 1913 begin 1945 1914 if Sel >= 0 then 1946 with THelpLineInfo(MainText.Objects[Sel + ScrollBar.Position]) do1915 with THelpLineInfo(MainText.Objects[Sel + sb.Position]) do 1947 1916 if Link shr 8 and $3F = hkInternet then 1948 1917 case Link and $FF of … … 1963 1932 1964 1933 procedure THelpDlg.BackBtnClick(Sender: TObject); 1965 var 1966 HistItem: THistItem; 1967 begin 1968 if HistItems.Count > 1 then begin 1969 HistItem := THistItem.Create; 1970 HistItem.Assign(HistItems.Last); 1971 HistItems.Delete(HistItems.Count - 1); 1972 if (HistItem.Kind = hkMisc) and (HistItem.No = miscSearchResult) and 1973 (HistItem.SearchContent <> SearchContent) then 1974 begin 1975 SearchContent := HistItem.SearchContent; 1934 begin 1935 if nHist > 0 then 1936 begin 1937 dec(nHist); 1938 if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and 1939 (HistSearchContent[nHist] <> SearchContent) then 1940 begin 1941 SearchContent := HistSearchContent[nHist]; 1976 1942 Search(SearchContent); 1977 1943 end; 1978 Kind := Hist Item.Kind;1979 no := Hist Item.No;1980 Prepare(Hist Item.Pos);1944 Kind := HistKind[nHist]; 1945 no := HistNo[nHist]; 1946 Prepare(HistPos[nHist]); 1981 1947 OffscreenPaint; 1982 1948 Invalidate; 1983 HistItem.Free; 1984 end; 1949 end 1985 1950 end; 1986 1951 1987 1952 procedure THelpDlg.TopBtnClick(Sender: TObject); 1988 1953 begin 1989 while HistItems.Count > 1 do HistItems.Delete(HistItems.Count - 1);1954 nHist := 0; 1990 1955 Kind := hkMisc; 1991 1956 no := miscMain; … … 2001 1966 end; 2002 1967 2003 function THelpDlg.TextIndex(Item: string): Integer;2004 begin 2005 Result := HelpText.Gethandle(Item)1968 function THelpDlg.TextIndex(Item: string): integer; 1969 begin 1970 result := HelpText.Gethandle(Item) 2006 1971 end; 2007 1972 … … 2020 1985 InputDlg.CenterToRect(BoundsRect); 2021 1986 InputDlg.ShowModal; 2022 if (InputDlg.ModalResult = mrOK) and ( Length(InputDlg.EInput.Text) >= 2) then1987 if (InputDlg.ModalResult = mrOK) and (length(InputDlg.EInput.Text) >= 2) then 2023 1988 begin 2024 1989 Search(InputDlg.EInput.Text); … … 2037 2002 NewSearchContent := InputDlg.EInput.Text; 2038 2003 ShowNewContent(FWindowMode, hkMisc, miscSearchResult); 2039 end ;2040 end ;2041 end ;2004 end 2005 end 2006 end 2042 2007 end; 2043 2008 2044 2009 procedure THelpDlg.Search(SearchString: string); 2045 2010 var 2046 h, i, PrevHandle, PrevIndex, p, RightMargin: Integer;2011 h, i, PrevHandle, PrevIndex, p, RightMargin: integer; 2047 2012 s: string; 2048 2013 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255; 2049 bGOVHELP, bSPECIALMODEL, bJOBHELP: Boolean;2014 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean; 2050 2015 begin 2051 2016 SearchResult.Clear; … … 2053 2018 mIMPHELP := []; 2054 2019 mFEATUREHELP := []; 2055 bGOVHELP := False;2056 bSPECIALMODEL := False;2057 bJOBHELP := False;2020 bGOVHELP := false; 2021 bSPECIALMODEL := false; 2022 bJOBHELP := false; 2058 2023 2059 2024 // search in generic reference 2060 2025 SearchString := UpperCase(SearchString); 2061 for i := 0 to 35 + 4 do begin 2026 for i := 0 to 35 + 4 do 2027 begin 2062 2028 s := Phrases.Lookup('TERRAIN', i); 2063 2029 if pos(SearchString, UpperCase(s)) > 0 then … … 2074 2040 imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'), 2075 2041 pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37); 2076 Break ;2077 end ;2042 Break 2043 end 2078 2044 end; 2079 2045 for i := 0 to nJobHelp - 1 do … … 2083 2049 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2084 2050 hkMisc + hkCrossLink, miscJobList); 2085 bJOBHELP := True;2086 Break ;2051 bJOBHELP := true; 2052 Break 2087 2053 end; 2088 2054 for i := 0 to nAdv - 1 do … … 2097 2063 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i); 2098 2064 include(mADVHELP, i); 2099 end ;2065 end 2100 2066 end; 2101 2067 for i := 0 to nSpecialModel - 1 do … … 2106 2072 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0, 2107 2073 hkModel + hkCrossLink, 0); 2108 bSPECIALMODEL := True;2109 Break ;2074 bSPECIALMODEL := true; 2075 Break 2110 2076 end; 2111 2077 end; … … 2113 2079 begin 2114 2080 s := Phrases.Lookup('FEATURES', i); 2115 if Pos(SearchString, UpperCase(s)) > 0 then2081 if pos(SearchString, UpperCase(s)) > 0 then 2116 2082 begin 2117 2083 if i < mcFirstNonCap then … … 2122 2088 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2123 2089 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2124 Include(mFEATUREHELP, i);2125 end ;2090 include(mFEATUREHELP, i); 2091 end 2126 2092 end; 2127 2093 for i := 0 to nImp - 1 do 2128 2094 begin 2129 2095 s := Phrases.Lookup('IMPROVEMENTS', i); 2130 if Pos(SearchString, UpperCase(s)) > 0 then2096 if pos(SearchString, UpperCase(s)) > 0 then 2131 2097 begin 2132 2098 case Imp[i].Kind of … … 2141 2107 end; 2142 2108 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i); 2143 Include(mIMPHELP, i);2109 include(mIMPHELP, i); 2144 2110 end 2145 2111 end; 2146 2112 for i := 0 to nGov - 1 do 2147 if Pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then2113 if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then 2148 2114 begin 2149 2115 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2150 2116 hkMisc + hkCrossLink, miscGovList); 2151 bGOVHELP := True;2152 Break ;2117 bGOVHELP := true; 2118 Break 2153 2119 end; 2154 2120 … … 2171 2137 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2172 2138 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i) 2173 end ;2139 end 2174 2140 end 2175 2141 else if h = hIMPHELP then … … 2190 2156 end; 2191 2157 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i) 2192 end ;2158 end 2193 2159 end 2194 2160 else if h = hFEATUREHELP then … … 2205 2171 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2206 2172 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2207 end ;2173 end 2208 2174 end 2209 2175 else if h = hGOVHELP then … … 2228 2194 begin 2229 2195 s := HelpText.LookupByHandle(h); 2230 p := Pos('$', s);2196 p := pos('$', s); 2231 2197 if p > 0 then 2232 2198 begin 2233 s := Copy(s, p + 1, maxint);2234 p := Pos('\', s);2199 s := copy(s, p + 1, maxint); 2200 p := pos('\', s); 2235 2201 if p > 0 then 2236 s := Copy(s, 1, p - 1);2202 s := copy(s, 1, p - 1); 2237 2203 SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h); 2238 end ;2239 end ;2240 until False;2204 end 2205 end 2206 until false; 2241 2207 2242 2208 // cut lines to fit to window -
branches/highdpi/LocalPlayer/IsoEngine.pas
r170 r178 5 5 6 6 uses 7 Protocol, ClientTools, ScreenTools, Tribes, 7 Protocol, ClientTools, ScreenTools, Tribes, UDpiControls, 8 8 {$IFNDEF SCR}Term, {$ENDIF} 9 LCLIntf, LCLType, SysUtils, Classes, Graphics , PixelPointer;9 LCLIntf, LCLType, SysUtils, Classes, Graphics; 10 10 11 11 type … … 16 16 TIsoMap = class 17 17 constructor Create; 18 procedure SetOutput(Output: T Bitmap);18 procedure SetOutput(Output: TDpiBitmap); 19 19 procedure SetPaintBounds(Left, Top, Right, Bottom: integer); 20 20 procedure Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; … … 24 24 procedure PaintCity(x, y: integer; const CityInfo: TCityInfo; 25 25 accessory: boolean = true); 26 procedure BitBlt(Src: T Bitmap; x, y, Width, Height, xSrc, ySrc,26 procedure BitBlt(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 27 27 Rop: integer); 28 28 … … 37 37 procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer); 38 38 protected 39 FOutput: T Bitmap;39 FOutput: TDpiBitmap; 40 40 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, 41 41 DefHealth, FAdviceLoc: integer; … … 113 113 BordersOK: integer; 114 114 OnInitEnemyModel: TInitEnemyModelEvent; 115 LandPatch, OceanPatch, Borders: T Bitmap;115 LandPatch, OceanPatch, Borders: TDpiBitmap; 116 116 TSpriteSize: array [0 .. TerrainIconLines * 9 - 1] of TRect; 117 117 DebugMap: ^TTileList; … … 136 136 var 137 137 i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer; 138 LandMore, OceanMore, DitherMask, Mask24: T Bitmap;138 LandMore, OceanMore, DitherMask, Mask24: TDpiBitmap; 139 139 MaskLine: array [0 .. 32 * 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt 140 140 Border: boolean; … … 165 165 if LandPatch <> nil then 166 166 LandPatch.Free; 167 LandPatch := T Bitmap.Create;167 LandPatch := TDpiBitmap.Create; 168 168 LandPatch.PixelFormat := pf24bit; 169 169 LandPatch.Canvas.Brush.Color := 0; … … 172 172 if OceanPatch <> nil then 173 173 OceanPatch.Free; 174 OceanPatch := T Bitmap.Create;174 OceanPatch := TDpiBitmap.Create; 175 175 OceanPatch.PixelFormat := pf24bit; 176 176 OceanPatch.Canvas.Brush.Color := 0; 177 177 OceanPatch.SetSize(xxt * 8, yyt * 4); 178 178 OceanPatch.Canvas.FillRect(0, 0, OceanPatch.Width, OceanPatch.Height); 179 LandMore := T Bitmap.Create;179 LandMore := TDpiBitmap.Create; 180 180 LandMore.PixelFormat := pf24bit; 181 181 LandMore.Canvas.Brush.Color := 0; 182 182 LandMore.SetSize(xxt * 18, yyt * 9); 183 183 LandMore.Canvas.FillRect(0, 0, LandMore.Width, LandMore.Height); 184 OceanMore := T Bitmap.Create;184 OceanMore := TDpiBitmap.Create; 185 185 OceanMore.PixelFormat := pf24bit; 186 186 OceanMore.Canvas.Brush.Color := 0; 187 187 OceanMore.SetSize(xxt * 8, yyt * 4); 188 188 OceanMore.Canvas.FillRect(0, 0, OceanMore.Width, OceanMore.Height); 189 DitherMask := T Bitmap.Create;189 DitherMask := TDpiBitmap.Create; 190 190 DitherMask.PixelFormat := pf24bit; 191 191 DitherMask.SetSize(xxt * 2, yyt * 2); … … 366 366 367 367 // reduce size of terrain icons 368 Mask24 := T Bitmap.Create;368 Mask24 := TDpiBitmap.Create; 369 369 Mask24.Assign(GrExt[HGrTerrain].Mask); 370 370 Mask24.PixelFormat := pf24bit; … … 420 420 if Borders <> nil then 421 421 Borders.Free; 422 Borders := T Bitmap.Create;422 Borders := TDpiBitmap.Create; 423 423 Borders.PixelFormat := pf24bit; 424 424 Borders.SetSize(xxt * 2,(yyt * 2) * nPl); … … 452 452 end; 453 453 454 procedure TIsoMap.SetOutput(Output: T Bitmap);454 procedure TIsoMap.SetOutput(Output: TDpiBitmap); 455 455 begin 456 456 FOutput := Output; … … 499 499 end; 500 500 501 procedure TIsoMap.BitBlt(Src: T Bitmap; x, y, Width, Height, xSrc, ySrc,501 procedure TIsoMap.BitBlt(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 502 502 Rop: integer); 503 503 begin -
branches/highdpi/LocalPlayer/MessgEx.pas
r173 r178 5 5 6 6 uses 7 Messg, Protocol, ScreenTools, Platform, DateUtils, 7 Messg, Protocol, ScreenTools, Platform, DateUtils, UDpiControls, 8 8 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 9 9 ButtonB, StdCtrls, DrawDlg; … … 32 32 private 33 33 MovieCancelled: boolean; 34 procedure PaintBook(ca: T Canvas; x, y, clPage, clCover: integer);34 procedure PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer); 35 35 procedure PaintMyArmy; 36 36 procedure PaintEnemyArmy; … … 73 73 74 74 uses 75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, PixelPointer,76 IsoEngine, Diagram , Sound;75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, 76 IsoEngine, Diagram; 77 77 78 78 {$R *.lfm} … … 226 226 end; 227 227 228 procedure TMessgExDlg.PaintBook(ca: T Canvas; x, y, clPage, clCover: integer);228 procedure TMessgExDlg.PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer); 229 229 const 230 230 xScrewed = 77; -
branches/highdpi/LocalPlayer/NatStat.pas
r104 r178 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 9 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 10 9 ButtonB, ButtonC, Menus, EOTButton; … … 45 44 SelfReport, CurrentReport: PEnemyReport; 46 45 ShowContact, ContactEnabled: boolean; 47 Back, Template: T Bitmap;46 Back, Template: TDpiBitmap; 48 47 ReportText: TStringList; 49 48 procedure GenerateReportText; … … 87 86 ContactBtn.Hint := Phrases.Lookup('BTN_DIALOG'); 88 87 89 Back := T Bitmap.Create;88 Back := TDpiBitmap.Create; 90 89 Back.PixelFormat := pf24bit; 91 90 Back.SetSize(Width, Height); 92 91 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height); 93 Template := T Bitmap.Create;92 Template := TDpiBitmap.Create; 94 93 Template.PixelFormat := pf24bit; 95 94 LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'Nation.png', gfNoGamma); -
branches/highdpi/LocalPlayer/Nego.pas
r174 r178 6 6 uses 7 7 ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonA, ButtonB, ButtonN ;8 Controls, Forms, ButtonA, ButtonB, ButtonN, UDpiControls; 9 9 10 10 const … … 15 15 type 16 16 THistory = record 17 n: Integer;18 Text: array [0 .. MaxHistory - 1] of ansistring;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 } … … 83 83 CommandAllowed: set of TCommandAllowedEnum; 84 84 History: array [0 .. nPl - 1] of THistory; 85 RomanFont: T Font;85 RomanFont: TDpiFont; 86 86 Costs, Delivers: array [0 .. 11] of cardinal; 87 87 procedure ResetCurrentOffer; … … 161 161 162 162 fillchar(History, sizeof(History), 0); 163 RomanFont := T Font.Create;163 RomanFont := TDpiFont.Create; 164 164 RomanFont.Name := 'Times New Roman'; 165 165 RomanFont.Size := Round(144 * 72 / RomanFont.PixelsPerInch); -
branches/highdpi/LocalPlayer/PVSB.pas
r172 r178 9 9 {$ENDIF} 10 10 Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils, 11 StdCtrls, Math ;11 StdCtrls, Math, UDpiControls; 12 12 13 13 type … … 18 18 private 19 19 FOnUpdate: TNotifyEvent; 20 ScrollBar: T ScrollBar;20 ScrollBar: TDpiScrollBar; 21 21 FMax: Integer; 22 22 function GetMax: Integer; … … 28 28 procedure SetPosition(AValue: Integer); 29 29 public 30 constructor Create(Parent: T WinControl);30 constructor Create(Parent: TDpiWinControl); 31 31 destructor Destroy; override; 32 32 procedure Init(Max, PageSize: Integer); … … 109 109 if Max < ScrollBar.PageSize then Result := False 110 110 else begin 111 NewPos := ScrollBar.Position - Delta div 30 ;111 NewPos := ScrollBar.Position - Delta div 300; 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, FMax);155 ScrollBar.Max := Math.Max(0, Max{$IFDEF LINUX} - PageSize + 1{$ENDIF}); 156 156 end; 157 157 … … 181 181 end; 182 182 183 constructor TPVScrollBar.Create(Parent: T WinControl);183 constructor TPVScrollBar.Create(Parent: TDpiWinControl); 184 184 begin 185 185 Inc(Count); 186 ScrollBar := T ScrollBar.Create(Parent);186 ScrollBar := TDpiScrollBar.Create(Parent); 187 187 ScrollBar.Kind := sbVertical; 188 188 ScrollBar.Name := 'PVSB' + IntToStr(Count); -
branches/highdpi/LocalPlayer/Select.pas
r89 r178 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, 8 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, UDpiControls, 9 8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 10 9 ExtCtrls, ButtonB, ButtonBase, Menus, Types; … … 53 52 Column: array [0 .. nPl - 1] of integer; 54 53 Closable, MultiPage: boolean; 55 ScienceNationDot: T Bitmap;54 ScienceNationDot: TDpiBitmap; 56 55 procedure ScrollBarUpdate(Sender: TObject); 57 56 procedure InitLines; 58 procedure line(ca: T Canvas; l: integer; NonText, lit: boolean);57 procedure line(ca: TDpiCanvas; l: integer; NonText, lit: boolean); 59 58 function RenameCity(cix: integer): boolean; 60 59 function RenameModel(mix: integer): boolean; … … 110 109 Layer1Btn.Hint := Phrases.Lookup('BTN_WONDERS'); 111 110 Layer2Btn.Hint := Phrases.Lookup('BTN_CLASSES'); 112 ScienceNationDot := T Bitmap.Create;111 ScienceNationDot := TDpiBitmap.Create; 113 112 ScienceNationDot.PixelFormat := pf24bit; 114 113 ScienceNationDot.SetSize(17, 17); … … 181 180 end; 182 181 183 procedure TListDlg.line(ca: T Canvas; l: integer; NonText, lit: boolean);182 procedure TListDlg.line(ca: TDpiCanvas; l: integer; NonText, lit: boolean); 184 183 // paint a line 185 184 -
branches/highdpi/LocalPlayer/TechTree.pas
r170 r178 6 6 uses 7 7 ScreenTools, Messg, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonBase, ButtonB, DrawDlg ;8 Controls, Forms, ButtonBase, ButtonB, DrawDlg, UDpiControls; 9 9 10 10 type … … 23 23 private 24 24 xOffset, yOffset, xDown, yDown: Integer; 25 Image: T Bitmap;25 Image: TDpiBitmap; 26 26 dragging: boolean; 27 27 end; … … 30 30 TechTreeDlg: TTechTreeDlg; 31 31 32 33 32 implementation 34 33 35 34 uses 36 Directories , PixelPointer;35 Directories; 37 36 38 37 {$R *.lfm} … … 126 125 if Image = nil then 127 126 begin 128 Image := T Bitmap.Create;127 Image := TDpiBitmap.Create; 129 128 Image.PixelFormat := pf24bit; 130 129 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma); -
branches/highdpi/LocalPlayer/Term.pas
r173 r178 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; 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area, 16 UDpiControls; 16 17 17 18 const … … 228 229 BrushType: Cardinal; 229 230 trix: array [0 .. 63] of integer; 230 AILogo: array [0 .. nPl - 1] of T Bitmap;231 Mini, Panel, TopBar: T Bitmap;231 AILogo: array [0 .. nPl - 1] of TDpiBitmap; 232 Mini, Panel, TopBar: TDpiBitmap; 232 233 sb: TPVScrollbar; 233 234 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, … … 276 277 public 277 278 UsedOffscreenWidth, UsedOffscreenHeight: integer; 278 Offscreen: T Bitmap;279 OffscreenUser: T Form;279 Offscreen: TDpiBitmap; 280 OffscreenUser: TDpiForm; 280 281 procedure CreateParams(var p: TCreateParams); override; 281 282 procedure Client(Command, NewPlayer: integer; var Data); … … 428 429 CityRepMask: Cardinal; 429 430 ReceivedOffer: TOffer; 430 Buffer: T Bitmap;431 SmallImp: T Bitmap;431 Buffer: TDpiBitmap; 432 SmallImp: TDpiBitmap; 432 433 BlinkON: Boolean; 433 434 DestinationMarkON: Boolean; … … 455 456 procedure InitMyModel(mix: integer; final: boolean); 456 457 457 procedure ImpImage(ca: T Canvas; x, y, iix: integer; Government: integer = -1;458 procedure ImpImage(ca: TDpiCanvas; x, y, iix: integer; Government: integer = -1; 458 459 IsControl: boolean = false); 459 460 procedure HelpOnTerrain(Loc, NewMode: integer); 460 461 461 462 462 implementation 463 463 464 464 uses 465 465 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 466 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, PixelPointer, Sound,466 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, 467 467 Battle, Rates, TechTree, Registry; 468 468 … … 620 620 end; 621 621 622 procedure ImpImage(ca: T Canvas; x, y, iix: integer; Government: integer;622 procedure ImpImage(ca: TDpiCanvas; x, y, iix: integer; Government: integer; 623 623 IsControl: boolean); 624 624 begin … … 859 859 end; 860 860 861 procedure PaintZoomedTile(dst: T Bitmap; x, y, Loc: integer);861 procedure PaintZoomedTile(dst: TDpiBitmap; x, y, Loc: integer); 862 862 863 863 procedure TSprite(xDst, yDst, xSrc, ySrc: integer); … … 1088 1088 if G.RO[DipMem[me].pContact] <> nil then 1089 1089 begin // close windows for next player 1090 for i := 0 to Screen.FormCount - 1 do1091 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)1090 for i := 0 to DpiScreen.FormCount - 1 do 1091 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1092 1092 then 1093 Screen.Forms[i].Close;1093 DpiScreen.Forms[i].Close; 1094 1094 end 1095 1095 else … … 1116 1116 if G.RO[DipMem[me].pContact] <> nil then 1117 1117 begin // close windows for next player 1118 for i := 0 to Screen.FormCount - 1 do1119 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)1118 for i := 0 to DpiScreen.FormCount - 1 do 1119 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1120 1120 then 1121 Screen.Forms[i].Close;1121 DpiScreen.Forms[i].Close; 1122 1122 end 1123 1123 else … … 1231 1231 begin 1232 1232 if AILogo[p] = nil then 1233 AILogo[p] := T Bitmap.Create;1233 AILogo[p] := TDpiBitmap.Create; 1234 1234 if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', gfNoError) then 1235 1235 begin … … 1497 1497 1498 1498 HGrStdUnits := LoadGraphicSet('StdUnits.png'); 1499 SmallImp := T Bitmap.Create;1499 SmallImp := TDpiBitmap.Create; 1500 1500 SmallImp.PixelFormat := pf24bit; 1501 1501 InitSmallImp; … … 1811 1811 end; 1812 1812 1813 for i := 0 to Screen.FormCount - 1 do1814 if Screen.Forms[i] is TBufferedDrawDlg then1815 Screen.Forms[i].Enabled := true;1813 for i := 0 to DpiScreen.FormCount - 1 do 1814 if DpiScreen.Forms[i] is TBufferedDrawDlg then 1815 DpiScreen.Forms[i].Enabled := true; 1816 1816 1817 1817 if ClientMode <> cResume then … … 1824 1824 // first turn after anarchy -- don't show despotism palace! 1825 1825 Update; 1826 for i := 0 to Screen.FormCount - 1 do1827 if ( Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg)1826 for i := 0 to DpiScreen.FormCount - 1 do 1827 if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1828 1828 then 1829 1829 begin 1830 if @ Screen.Forms[i].OnShow <> nil then1831 Screen.Forms[i].OnShow(nil);1832 Screen.Forms[i].Invalidate;1833 Screen.Forms[i].Update;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 1834 end; 1835 1835 … … 2665 2665 SaveSettings; 2666 2666 CityDlg.CloseAction := None; 2667 for i := 0 to Screen.FormCount - 1 do2668 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)2667 for i := 0 to DpiScreen.FormCount - 1 do 2668 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) 2669 2669 then 2670 Screen.Forms[i].Close;2670 DpiScreen.Forms[i].Close; 2671 2671 if LogDlg.Visible then 2672 2672 LogDlg.Close; … … 3409 3409 i, j: integer; 3410 3410 begin 3411 MainFormKeyDown := FormKeyDown;3412 3411 BaseWin.CreateOffscreen(Offscreen); 3413 3412 … … 3508 3507 end; 3509 3508 3510 Mini := T Bitmap.Create;3509 Mini := TDpiBitmap.Create; 3511 3510 Mini.PixelFormat := pf24bit; 3512 Panel := T Bitmap.Create;3511 Panel := TDpiBitmap.Create; 3513 3512 Panel.PixelFormat := pf24bit; 3514 3513 Panel.Canvas.Font.Assign(UniFont[ftSmall]); 3515 3514 Panel.Canvas.Brush.Style := bsClear; 3516 TopBar := T Bitmap.Create;3515 TopBar := TDpiBitmap.Create; 3517 3516 TopBar.PixelFormat := pf24bit; 3518 3517 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 3519 3518 TopBar.Canvas.Brush.Style := bsClear; 3520 Buffer := T Bitmap.Create;3519 Buffer := TDpiBitmap.Create; 3521 3520 Buffer.PixelFormat := pf24bit; 3522 3521 if 2 * lxmax > 3 * xSizeBig then … … 3538 3537 procedure TMainScreen.FormDestroy(Sender: TObject); 3539 3538 var 3540 I: Integer; 3541 begin 3542 MainFormKeyDown := nil; 3539 i: integer; 3540 begin 3543 3541 FreeAndNil(sb); 3544 3542 FreeAndNil(TopBar); … … 3546 3544 FreeAndNil(Buffer); 3547 3545 FreeAndNil(Panel); 3548 for I:= 0 to nPl - 1 do3546 for i := 0 to nPl - 1 do 3549 3547 if AILogo[i] <> nil then 3550 FreeAndNil(AILogo[ I]);3548 FreeAndNil(AILogo[i]); 3551 3549 FreeAndNil(Offscreen); 3552 3550 end; … … 3753 3751 if supervising and (me <> 0) then 3754 3752 begin 3755 for i := 0 to Screen.FormCount - 1 do3756 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then3757 Screen.Forms[i].Close; // close windows3753 for i := 0 to DpiScreen.FormCount - 1 do 3754 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then 3755 DpiScreen.Forms[i].Close; // close windows 3758 3756 ItsMeAgain(0); 3759 3757 end; … … 3899 3897 if IsMultiPlayerGame then 3900 3898 begin // close windows for next player 3901 for i := 0 to Screen.FormCount - 1 do3902 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then3903 Screen.Forms[i].Close;3899 for i := 0 to DpiScreen.FormCount - 1 do 3900 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then 3901 DpiScreen.Forms[i].Close; 3904 3902 end 3905 3903 else … … 3911 3909 end; 3912 3910 for i := 0 to Screen.FormCount - 1 do 3913 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then3914 Screen.Forms[i].Enabled := false;3911 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then 3912 DpiScreen.Forms[i].Enabled := false; 3915 3913 3916 3914 if Server(sTurn, pTurn, 0, nil^) >= rExecuted then … … 4179 4177 {$IFDEF LINUX} 4180 4178 // Can't do scrolling of DC under Linux, then fallback into BitBlt. 4181 function ScrollDC(Canvas: T Canvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;4179 function ScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean; 4182 4180 begin 4183 4181 BitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top, … … 5080 5078 begin 5081 5079 if idle and (me >= 0) and (GameMode <> cMovie) then 5082 if (fsModal in Screen.ActiveForm.FormState) or5083 ( Screen.ActiveForm is TBufferedDrawDlg) and5084 (TBufferedDrawDlg( Screen.ActiveForm).WindowMode <> wmPersistent) then5080 if (fsModal in DpiScreen.ActiveForm.FormState) or 5081 (DpiScreen.ActiveForm is TBufferedDrawDlg) and 5082 (TBufferedDrawDlg(DpiScreen.ActiveForm).WindowMode <> wmPersistent) then 5085 5083 begin 5086 5084 BlinkTime := BlinkOnTime + BlinkOffTime - 1; … … 5117 5115 if (dx <> 0) or (dy <> 0) then 5118 5116 begin 5119 if ( Screen.ActiveForm <> MainScreen) and5120 (@ Screen.ActiveForm.OnDeactivate <> nil) then5121 Screen.ActiveForm.OnDeactivate(nil);5117 if (DpiScreen.ActiveForm <> MainScreen) and 5118 (@DpiScreen.ActiveForm.OnDeactivate <> nil) then 5119 DpiScreen.ActiveForm.OnDeactivate(nil); 5122 5120 Scroll(dx, dy); 5123 5121 end … … 6458 6456 ((p = 0) or (1 shl p and G.RO[0].Alive <> 0)) then 6459 6457 begin 6460 for i := 0 to Screen.FormCount - 1 do6461 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then6462 Screen.Forms[i].Close; // close windows6458 for i := 0 to DpiScreen.FormCount - 1 do 6459 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then 6460 DpiScreen.Forms[i].Close; // close windows 6463 6461 ItsMeAgain(p); 6464 6462 SumCities(TaxSum, ScienceSum); … … 8003 8001 Centre(CenterLoc); 8004 8002 PaintAllMaps; 8005 for i := 0 to Screen.FormCount - 1 do8006 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then8007 TBufferedDrawDlg( Screen.Forms[i]).SmartUpdateContent(false);8003 for i := 0 to DpiScreen.FormCount - 1 do 8004 if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then 8005 TBufferedDrawDlg(DpiScreen.Forms[i]).SmartUpdateContent(false); 8008 8006 end; 8009 8007 -
branches/highdpi/LocalPlayer/UnitStat.pas
r73 r178 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 9 9 ButtonB, ButtonC; … … 41 41 Kind: (dkOwnModel, dkOwnUnit, dkEnemyModel, dkEnemyUnit, dkEnemyCityDefense, 42 42 dkEnemyCity); 43 Back, Template: T Bitmap;43 Back, Template: TDpiBitmap; 44 44 procedure OffscreenPaint; override; 45 45 end; … … 77 77 InitButtons(); 78 78 79 Back := T Bitmap.Create;79 Back := TDpiBitmap.Create; 80 80 Back.PixelFormat := pf24bit; 81 81 Back.SetSize(5 * wCommon, hMax); 82 82 Back.Canvas.FillRect(0, 0, Back.Width,Back.Height); 83 Template := T Bitmap.Create;83 Template := TDpiBitmap.Create; 84 84 Template.PixelFormat := pf24bit; 85 85 LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'Unit.png', gfNoGamma); … … 300 300 end; 301 301 302 procedure FeatureBar(dst: T Bitmap; x, y: integer; const mi: TModelInfo;302 procedure FeatureBar(dst: TDpiBitmap; x, y: integer; const mi: TModelInfo; 303 303 const T: TTexture); 304 304 var … … 367 367 end; { featurebar } 368 368 369 procedure NumberBarS(dst: T Bitmap; x, y: integer; Cap, s: string;369 procedure NumberBarS(dst: TDpiBitmap; x, y: integer; Cap, s: string; 370 370 const T: TTexture); 371 371 begin -
branches/highdpi/LocalPlayer/Wonders.pas
r170 r178 38 38 39 39 uses 40 Term, ClientTools, Help, Tribes , PixelPointer;40 Term, ClientTools, Help, Tribes; 41 41 42 42 {$R *.lfm} -
branches/highdpi/Locale.lfm
r167 r178 1 1 object LocaleDlg: TLocaleDlg 2 Left = 7663 Height = 4482 ClientHeight = 456 3 ClientWidth = 483 4 4 Top = 240 5 Left = 754 5 6 Width = 483 6 BorderStyle = bsNone 7 Height = 456 8 Visible = False 7 9 Caption = 'LocaleDlg' 8 ClientHeight = 448 9 ClientWidth = 483 10 Enabled = True 11 ShowHint = False 12 Font.Color = clDefault 13 Font.PixelsPerInch = 144 14 Align = alNone 15 Color = clDefault 16 OnPaint = FormPaint 17 HorzScrollBar.Visible = False 18 VertScrollBar.Visible = False 10 19 DesignTimePPI = 144 11 20 FormStyle = fsStayOnTop 21 BorderStyle = bsNone 22 BorderIcons = [] 23 LCLVersion = '2.0.2.0' 24 OnShow = FormShow 12 25 OnCreate = FormCreate 13 26 OnDestroy = FormDestroy 14 OnPaint = FormPaint 15 OnShow = FormShow 16 LCLVersion = '2.0.2.0' 17 object List: TListBox 27 object List: TDpiListBox 18 28 Tag = 15360 29 ClientHeight = 360 30 ClientWidth = 424 31 Top = 16 19 32 Left = 24 20 Height = 33621 Top = 1622 33 Width = 424 23 Anchors = [akTop, akLeft, akRight, akBottom]24 BorderStyle = bsNone25 Color = clBlack26 ExtendedSelect = False34 Height = 360 35 Visible = True 36 Enabled = True 37 ShowHint = False 27 38 Font.Color = 4176863 28 Font.Height = -1529 39 Font.Name = 'Times New Roman' 30 40 Font.Style = [fsBold] 31 IntegralHeight = True 32 ItemHeight = 0 33 ParentFont = False 34 ScrollWidth = 424 35 TabOrder = 0 36 TabStop = False 37 TopIndex = -1 41 Font.PixelsPerInch = 144 42 Font.Height = -15 43 Align = alNone 44 Color = clBlack 38 45 end 39 46 object OKBtn: TButtonA 47 ClientHeight = 25 48 ClientWidth = 100 49 Top = 400 40 50 Left = 272 51 Width = 100 41 52 Height = 25 42 Top = 400 43 Width = 100 53 Visible = True 54 Enabled = True 55 ShowHint = False 56 Font.Color = clDefault 57 Font.PixelsPerInch = 144 58 Align = alNone 59 Color = clDefault 60 OnClick = OKBtnClick 44 61 Down = False 45 62 Permanent = False 46 OnClick = OKBtnClick47 63 end 48 64 object CancelBtn: TButtonA 65 ClientHeight = 25 66 ClientWidth = 100 67 Top = 400 49 68 Left = 96 69 Width = 100 50 70 Height = 25 51 Top = 400 52 Width = 100 71 Visible = True 72 Enabled = True 73 ShowHint = False 74 Font.Color = clDefault 75 Font.PixelsPerInch = 144 76 Align = alNone 77 Color = clDefault 78 OnClick = CancelBtnClick 53 79 Down = False 54 80 Permanent = False 55 OnClick = CancelBtnClick56 end57 object ButtonFullscreen: TButtonC58 Left = 2459 Height = 1860 Top = 36861 Width = 1862 Down = False63 Permanent = False64 OnClick = ButtonFullscreenClick65 ButtonIndex = 066 81 end 67 82 end -
branches/highdpi/Locale.pas
r167 r178 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, ButtonC;9 ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, UDpiControls; 10 10 11 11 type … … 27 27 28 28 TLocaleDlg = class(TDrawDlg) 29 ButtonFullscreen: TButtonC; 30 List: TListBox; 29 List: TDpiListBox; 31 30 OKBtn: TButtonA; 32 31 CancelBtn: TButtonA; 33 procedure ButtonFullscreenClick(Sender: TObject);34 32 procedure CancelBtnClick(Sender: TObject); 35 33 procedure FormCreate(Sender: TObject); … … 103 101 OkBtn.Graphic := GrExt[HGrSystem].Data; 104 102 CancelBtn.Graphic := GrExt[HGrSystem].Data; 105 106 ButtonFullscreen.Graphic := GrExt[HGrSystem].Data;107 if FullScreen then ButtonFullscreen.ButtonIndex := 3108 else ButtonFullscreen.ButtonIndex := 2;109 103 end; 110 104 … … 112 106 begin 113 107 ModalResult := mrOk; 114 end;115 116 procedure TLocaleDlg.ButtonFullscreenClick(Sender: TObject);117 begin118 FullScreen := not FullScreen;119 ButtonFullscreen.ButtonIndex := ButtonFullscreen.ButtonIndex xor 1;120 108 end; 121 109 … … 126 114 127 115 procedure TLocaleDlg.FormPaint(Sender: TObject); 128 var129 S: string;130 W: Integer;131 116 begin 132 117 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6); … … 139 124 BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture); 140 125 BtnFrame(Canvas, CancelBtn.BoundsRect, MainTexture); 141 142 RFrame(Canvas, ButtonFullscreen.Left - 1, ButtonFullscreen.Top - 1,143 ButtonFullscreen.Left + 12, ButtonFullscreen.Top + 12, MainTexture.clBevelShade,144 MainTexture.clBevelLight);145 146 s := Phrases.Lookup('SETTINGS', 0);147 LoweredTextOut(Canvas, -2, MainTexture, ButtonFullscreen.Left + 32,148 ButtonFullscreen.Top - 4, s);149 126 end; 150 127 -
branches/highdpi/Localization/cs/Language.txt
r167 r178 942 942 Uspíšit\produkci 943 943 Maximální\produkce 944 945 #SETTINGS946 Celá obrazovka -
branches/highdpi/Localization/de/Language.txt
r167 r178 960 960 beschleunigte\Produktion 961 961 maximale\Produktion 962 963 #SETTINGS964 Full screen -
branches/highdpi/Localization/it/Language.txt
r167 r178 932 932 Favorisci\produzione 933 933 Massimizza\produzione 934 935 #SETTINGS936 Full screen -
branches/highdpi/Localization/ru/Language.txt
r167 r178 968 968 Максимум\Производства 969 969 970 #SETTINGS971 Full screen -
branches/highdpi/Localization/zh-Hans/language.txt
r167 r178 960 960 Éú²ú×î´ó»¯ 961 961 962 #SETTINGS963 Full screen -
branches/highdpi/Localization/zh-Hant/language.txt
r167 r178 960 960 ¥Í²£³Ì¤j¤Æ 961 961 962 #SETTINGS963 Full screen -
branches/highdpi/Log.pas
r38 r178 6 6 uses 7 7 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 8 StdCtrls, Menus ;8 StdCtrls, Menus, UDpiControls; 9 9 10 10 type … … 33 33 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); 34 34 public 35 Host: T Form;35 Host: TDpiForm; 36 36 procedure Add(Level, Turn: Integer; Text: pchar); 37 37 private -
branches/highdpi/Messg.pas
r173 r178 42 42 43 43 implementation 44 45 uses46 Sound;47 44 48 45 {$R *.lfm} -
branches/highdpi/NoTerm.pas
r144 r178 6 6 uses 7 7 ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform, 8 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg ;8 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg, UDpiControls; 9 9 10 10 type … … 25 25 G: TNewGameData; 26 26 Server: TServerCall; 27 Shade, State: T Bitmap;27 Shade, State: TDpiBitmap; 28 28 WinStat, ExtStat, AloneStat: array [0 .. nPl - 1] of integer; 29 29 DisallowShowActive: array [0 .. nPl - 1] of boolean; … … 147 147 Server := TInitModuleData(Data).Server; 148 148 TInitModuleData(Data).Flags := aiThreaded; 149 Shade := T Bitmap.Create;149 Shade := TDpiBitmap.Create; 150 150 Shade.SetSize(64, 64); 151 151 for x := 0 to 63 do … … 155 155 else 156 156 Shade.Canvas.Pixels[x, y] := $000000; 157 State := T Bitmap.Create;157 State := TDpiBitmap.Create; 158 158 State.SetSize(192, 20); 159 159 State.Canvas.Brush.Style := bsClear; … … 174 174 begin 175 175 Invalidate; 176 Update 176 Update; 177 177 end 178 178 else -
branches/highdpi/Packages/CevoComponents/Area.pas
r165 r178 4 4 5 5 uses 6 Classes, Graphics, Controls ;6 Classes, Graphics, Controls, UDpiControls; 7 7 8 8 type 9 TArea = class(T GraphicControl)9 TArea = class(TDpiGraphicControl) 10 10 constructor Create(AOwner: TComponent); override; 11 11 protected … … 20 20 procedure Register; 21 21 begin 22 RegisterComponents(' C-evo', [TArea]);22 RegisterComponents('Samples', [TArea]); 23 23 end; 24 24 … … 26 26 begin 27 27 inherited; 28 Enabled := false;29 ShowHint := true;28 Enabled := False; 29 ShowHint := True; 30 30 end; 31 31 -
branches/highdpi/Packages/CevoComponents/BaseWin.pas
r171 r178 5 5 uses 6 6 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 7 DrawDlg ;7 DrawDlg, UDpiControls; 8 8 9 9 type … … 32 32 public 33 33 UsedOffscreenWidth, UsedOffscreenHeight: integer; 34 Offscreen: T Bitmap;35 OffscreenUser: T Form;34 Offscreen: TDpiBitmap; 35 OffscreenUser: TDpiForm; 36 36 property WindowMode: integer read FWindowMode; 37 37 end; … … 72 72 SideFrame = 9; 73 73 74 procedure CreateOffscreen(var Offscreen: T Bitmap);74 procedure CreateOffscreen(var Offscreen: TDpiBitmap); 75 75 procedure Register; 76 76 … … 494 494 end; 495 495 496 procedure CreateOffscreen(var Offscreen: T Bitmap);496 procedure CreateOffscreen(var Offscreen: TDpiBitmap); 497 497 begin 498 498 if Offscreen <> nil then 499 499 exit; 500 Offscreen := T Bitmap.Create;500 Offscreen := TDpiBitmap.Create; 501 501 Offscreen.PixelFormat := pf24bit; 502 502 if Screen.Height - yUnused < 480 then -
branches/highdpi/Packages/CevoComponents/ButtonA.pas
r165 r178 5 5 uses 6 6 ButtonBase, 7 Classes, Graphics, LCLIntf, LCLType ;7 Classes, Graphics, LCLIntf, LCLType, UDpiControls; 8 8 9 9 type … … 13 13 FCaption: string; 14 14 procedure SetCaption(x: string); 15 procedure SetFont(const x: T Font);15 procedure SetFont(const x: TDpiFont); 16 16 published 17 17 property Visible; … … 19 19 property OnClick; 20 20 public 21 property Font: T Font write SetFont;21 property Font: TDpiFont write SetFont; 22 22 protected 23 23 procedure Paint; override; … … 30 30 procedure Register; 31 31 begin 32 RegisterComponents(' C-evo', [TButtonA]);32 RegisterComponents('Samples', [TButtonA]); 33 33 end; 34 34 … … 43 43 begin 44 44 with Canvas do 45 if FGraphic <> nil then 46 begin 47 BitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195, 45 if FGraphic <> nil then begin 46 DpiBitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195, 48 47 243 + 26 * Byte(Down), SRCCOPY); 49 48 Canvas.Brush.Style := bsClear; 50 Text out(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption)49 TextOut(50 - (TextWidth(FCaption) + 1) div 2, 12 - TextHeight(FCaption) 51 50 div 2, FCaption); 52 end 53 else 54 begin 51 end else begin 55 52 Brush.Color := $0000FF; 56 53 FrameRect(Rect(0, 0, 100, 25)) … … 67 64 end; 68 65 69 procedure TButtonA.SetFont(const x: T Font);66 procedure TButtonA.SetFont(const x: TDpiFont); 70 67 begin 71 68 Canvas.Font.Assign(x); -
branches/highdpi/Packages/CevoComponents/ButtonB.pas
r165 r178 4 4 5 5 uses 6 ButtonBase, 7 Classes, Graphics, LCLIntf, LCLType; 6 ButtonBase, Classes, Graphics, LCLIntf, LCLType, UDpiControls; 8 7 9 8 type … … 11 10 constructor Create(aOwner: TComponent); override; 12 11 private 13 FMask: T Bitmap;12 FMask: TDpiBitmap; 14 13 FIndex: integer; 15 14 procedure SetIndex(x: integer); 16 15 public 17 property Mask: T Bitmap read FMask write FMask;16 property Mask: TDpiBitmap read FMask write FMask; 18 17 published 19 18 property Visible; … … 30 29 procedure Register; 31 30 begin 32 RegisterComponents(' C-evo', [TButtonB]);31 RegisterComponents('Samples', [TButtonB]); 33 32 end; 34 33 -
branches/highdpi/Packages/CevoComponents/ButtonBase.pas
r135 r178 4 4 5 5 uses 6 Classes, Graphics, Controls ;6 Classes, Graphics, Controls, UDpiControls; 7 7 8 8 type 9 TButtonBase = class(T GraphicControl)9 TButtonBase = class(TDpiGraphicControl) 10 10 protected 11 11 FDown, FPermanent: boolean; 12 FGraphic: T Bitmap;12 FGraphic: TDpiBitmap; 13 13 // FDownSound, FUpSound: string; 14 14 ClickProc: TNotifyEvent; … … 26 26 public 27 27 constructor Create(aOwner: TComponent); override; 28 property Graphic: T Bitmap read FGraphic write FGraphic;28 property Graphic: TDpiBitmap read FGraphic write FGraphic; 29 29 // property DownSound: string read FDownSound write FDownSound; 30 30 // property UpSound: string read FUpSound write FUpSound; -
branches/highdpi/Packages/CevoComponents/ButtonC.pas
r165 r178 27 27 procedure Register; 28 28 begin 29 RegisterComponents(' C-evo', [TButtonC]);29 RegisterComponents('Samples', [TButtonC]); 30 30 end; 31 31 -
branches/highdpi/Packages/CevoComponents/ButtonN.pas
r165 r178 4 4 5 5 uses 6 Classes, Graphics, Controls, LCLIntf, LCLType ;6 Classes, Graphics, Controls, LCLIntf, LCLType, UDpiControls; 7 7 8 8 type … … 11 11 private 12 12 FPossible, FLit: boolean; 13 FGraphic, FMask, FBackGraphic: T Bitmap;13 FGraphic, FMask, FBackGraphic: TDpiBitmap; 14 14 FIndex, BackIndex: integer; 15 15 FSmartHint: string; … … 23 23 property Lit: boolean read FLit write SetLit; 24 24 property SmartHint: string read FSmartHint write SetSmartHint; 25 property Graphic: T Bitmap read FGraphic write FGraphic;26 property Mask: T Bitmap read FMask write FMask;27 property BackGraphic: T Bitmap read FBackGraphic write FBackGraphic;25 property Graphic: TDpiBitmap read FGraphic write FGraphic; 26 property Mask: TDpiBitmap read FMask write FMask; 27 property BackGraphic: TDpiBitmap read FBackGraphic write FBackGraphic; 28 28 property ButtonIndex: integer read FIndex write SetIndex; 29 29 property OnClick: TNotifyEvent read ChangeProc write ChangeProc; … … 40 40 procedure Register; 41 41 begin 42 RegisterComponents(' C-evo', [TButtonN]);42 RegisterComponents('Samples', [TButtonN]); 43 43 end; 44 44 -
branches/highdpi/Packages/CevoComponents/CevoComponents.lpk
r170 r178 35 35 </Other> 36 36 </CompilerOptions> 37 <Description Value="C-evo components"/> 38 <Version Major="1" Minor="2"/> 39 <Files Count="14"> 37 <Files Count="13"> 40 38 <Item1> 41 39 <Filename Value="Area.pas"/> … … 95 93 <Item13> 96 94 <Filename Value="BaseWin.pas"/> 97 <HasRegisterProc Value="True"/>98 95 <UnitName Value="BaseWin"/> 99 96 </Item13> 100 <Item14>101 <Filename Value="PixelPointer.pas"/>102 <UnitName Value="PixelPointer"/>103 </Item14>104 97 </Files> 105 <RequiredPkgs Count=" 2">98 <RequiredPkgs Count="3"> 106 99 <Item1> 107 <PackageName Value=" LCL"/>100 <PackageName Value="DpiControls"/> 108 101 </Item1> 109 102 <Item2> 103 <PackageName Value="LCL"/> 104 </Item2> 105 <Item3> 110 106 <PackageName Value="FCL"/> 111 </Item 2>107 </Item3> 112 108 </RequiredPkgs> 113 109 <UsageOptions> -
branches/highdpi/Packages/CevoComponents/CevoComponents.pas
r170 r178 10 10 uses 11 11 Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 12 Sound, BaseWin, PixelPointer,LazarusPackageIntf;12 Sound, BaseWin, LazarusPackageIntf; 13 13 14 14 implementation … … 23 23 RegisterUnit('EOTButton', @EOTButton.Register); 24 24 RegisterUnit('DrawDlg', @DrawDlg.Register); 25 RegisterUnit('BaseWin', @BaseWin.Register);26 25 end; 27 26 -
branches/highdpi/Packages/CevoComponents/Directories.pas
r169 r178 4 4 5 5 var 6 HomeDir: string; 7 DataDir: string; 6 HomeDir, DataDir: string; 8 7 LocaleCode: string = ''; 9 8 LocaleCodeAuto: string = ''; … … 11 10 function LocalizedFilePath(const Path: string): string; 12 11 procedure InitUnit; 13 function GetSavedDir(Home: Boolean = False): string;14 function GetMapsDir(Home: Boolean = False): string;15 12 16 13 … … 72 69 else 73 70 begin 74 if not DirectoryExists(AppDataDir) then CreateDir(AppDataDir); 71 if not DirectoryExists(AppDataDir) then 72 CreateDir(AppDataDir); 75 73 DataDir := AppDataDir; 76 74 end; 77 if not DirectoryExists(GetSavedDir) then CreateDir(GetSavedDir); 78 if not DirectoryExists(GetMapsDir) then CreateDir(GetMapsDir); 75 if not DirectoryExists(DataDir + 'Saved') then 76 CreateDir(DataDir + 'Saved'); 77 if not DirectoryExists(DataDir + 'Maps') then 78 CreateDir(DataDir + 'Maps'); 79 79 80 80 // Copy appdata if not done yet 81 if FindFirst( GetSavedDir(True)+ DirectorySeparator + '*.cevo', $21, src) = 0 then81 if FindFirst(HomeDir + 'Saved' + DirectorySeparator + '*.cevo', $21, src) = 0 then 82 82 repeat 83 if (FindFirst( GetSavedDir(True)+ DirectorySeparator + src.Name, $21, dst) <> 0) or83 if (FindFirst(DataDir + 'Saved' + DirectorySeparator + src.Name, $21, dst) <> 0) or 84 84 (dst.Time < src.Time) then 85 CopyFile(PChar( GetSavedDir(True)+ DirectorySeparator + src.Name),86 PChar( GetSavedDir(True)+ DirectorySeparator + src.Name), false);85 CopyFile(PChar(HomeDir + 'Saved' + DirectorySeparator + src.Name), 86 PChar(DataDir + 'Saved' + DirectorySeparator + src.Name), false); 87 87 FindClose(dst); 88 88 until FindNext(src) <> 0; … … 90 90 91 91 // Copy appdata if not done yet 92 if FindFirst( GetMapsDir(True)+ DirectorySeparator + '*.*', $21, src) = 0 then92 if FindFirst(HomeDir + 'Maps' + DirectorySeparator + '*.*', $21, src) = 0 then 93 93 repeat 94 if (FindFirst( GetMapsDir(True)+ DirectorySeparator + src.Name, $21, dst) <> 0) or94 if (FindFirst(DataDir + 'Maps' + DirectorySeparator + src.Name, $21, dst) <> 0) or 95 95 (dst.Time < src.Time) then 96 CopyFile(PChar( GetMapsDir(True)+ DirectorySeparator + src.Name),97 PChar( GetMapsDir(True)+ DirectorySeparator + src.Name), false);96 CopyFile(PChar(HomeDir + 'Maps' + DirectorySeparator + src.Name), 97 PChar(DataDir + 'Maps' + DirectorySeparator + src.Name), false); 98 98 FindClose(dst); 99 99 until FindNext(src) <> 0; … … 101 101 end; 102 102 103 function GetSavedDir(Home: Boolean = False): string;104 begin105 if Home then Result := HomeDir + 'Saved'106 else Result := DataDir + 'Saved';107 end;108 109 function GetMapsDir(Home: Boolean = False): string;110 begin111 if Home then Result := HomeDir + 'Maps'112 else Result := DataDir + 'Maps';113 end;114 115 103 end. -
branches/highdpi/Packages/CevoComponents/DrawDlg.pas
r174 r178 7 7 uses 8 8 Classes, SysUtils, Forms, LCLIntf, LCLType, LMessages, Messages, Graphics, 9 Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools ;9 Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools, UDpiControls; 10 10 11 11 type 12 12 { TDrawDlg } 13 13 14 TDrawDlg = class(T Form)14 TDrawDlg = class(TDpiForm) 15 15 public 16 16 constructor Create(AOwner: TComponent); override; 17 destructor Destroy; override;18 17 procedure SmartInvalidate; virtual; 19 private20 MoveFormPos: TPoint;21 MoveMousePos: TPoint;22 MoveActive: Boolean;23 procedure VisibleChangedHandler(Sender: TObject);24 18 protected 25 TitleHeight: Integer;19 TitleHeight: integer; 26 20 // defines area to grip the window for moving (from top) 27 21 procedure InitButtons; 28 22 procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND; 29 23 procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST; 30 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);31 override;32 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;33 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;34 procedure MouseLeave; override;35 24 end; 36 25 … … 69 58 inherited; 70 59 TitleHeight := 0; 71 MoveActive := False;72 AddHandlerOnVisibleChanged(VisibleChangedHandler);73 end;74 75 destructor TDrawDlg.Destroy;76 begin77 RemoveHandlerOnVisibleChanging(VisibleChangedHandler);78 inherited Destroy;79 60 end; 80 61 … … 117 98 end; 118 99 119 procedure TDrawDlg.MouseDown(Button: TMouseButton; Shift: TShiftState; X,120 Y: Integer);121 var122 MousePosNew: TPoint;123 NewFormPos: TPoint;124 begin125 inherited;126 {$IFDEF LINUX}127 // HitTest is not supported under Linux GTK2 so use form inside move mechanizm128 NewFormPos := ScreenToClient(Mouse.CursorPos);129 if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and130 (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin131 MoveMousePos := ClientToScreen(Point(X, Y));132 MoveFormPos := Point(Left, Top);133 MousePosNew := Mouse.CursorPos;134 // Activate move only if mouse position was not changed during inherited call135 if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin136 MoveActive := True;137 end;138 end else MoveActive := False;139 {$ENDIF}140 end;141 142 procedure TDrawDlg.MouseMove(Shift: TShiftState; X, Y: Integer);143 var144 MousePos: TPoint;145 begin146 inherited;147 if MoveActive then begin148 MousePos := ClientToScreen(Point(X, Y));149 SetBounds(MoveFormPos.X + MousePos.X - MoveMousePos.X,150 MoveFormPos.Y + MousePos.Y - MoveMousePos.Y,151 Width, Height);152 end;153 end;154 155 procedure TDrawDlg.MouseUp(Button: TMouseButton; Shift: TShiftState; X,156 Y: Integer);157 begin158 MoveActive := False;159 inherited;160 end;161 162 procedure TDrawDlg.MouseLeave;163 begin164 MoveActive := False;165 inherited;166 end;167 168 procedure TDrawDlg.VisibleChangedHandler(Sender: TObject);169 begin170 MoveActive := False;171 end;172 173 100 procedure TDrawDlg.InitButtons; 174 101 var … … 230 157 begin 231 158 if csDesigning in ComponentState then Exit; 232 PaintBackground( self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),159 PaintBackground(Self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border), 233 160 ClientHeight - (6 + 2 * Border)); 234 161 for i := 0 to Border do -
branches/highdpi/Packages/CevoComponents/EOTButton.pas
r165 r178 4 4 5 5 uses 6 ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType ;6 ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType, UDpiControls; 7 7 8 8 const … … 19 19 destructor Destroy; override; 20 20 procedure SetButtonIndexFast(x: integer); 21 procedure SetBack(ca: T Canvas; x, y: integer);21 procedure SetBack(ca: TDpiCanvas; x, y: integer); 22 22 private 23 FTemplate: T Bitmap;23 FTemplate: TDpiBitmap; 24 24 FIndex: integer; 25 25 procedure SetIndex(x: integer); 26 26 public 27 property Template: T Bitmap read FTemplate write FTemplate;27 property Template: TDpiBitmap read FTemplate write FTemplate; 28 28 published 29 29 property Visible; … … 31 31 property OnClick; 32 32 protected 33 Buffer, Back: T Bitmap;33 Buffer, Back: TDpiBitmap; 34 34 procedure Paint; override; 35 35 end; … … 41 41 procedure Register; 42 42 begin 43 RegisterComponents(' C-evo', [TEOTButton]);43 RegisterComponents('Samples', [TEOTButton]); 44 44 end; 45 45 46 procedure ImageOp_CBC(Dst, Src: T Bitmap; xDst, yDst, xSrc, ySrc, w, h, Color0,46 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h, Color0, 47 47 Color2: integer); 48 48 // Src is template … … 99 99 begin 100 100 inherited; 101 Buffer := T Bitmap.Create;101 Buffer := TDpiBitmap.Create; 102 102 Buffer.PixelFormat := pf24bit; 103 103 Buffer.SetSize(48, 48); 104 104 Buffer.Canvas.FillRect(0, 0, Buffer.Width, Buffer.Height); 105 Back := T Bitmap.Create;105 Back := TDpiBitmap.Create; 106 106 Back.PixelFormat := pf24bit; 107 107 Back.SetSize(48, 48); … … 162 162 end; 163 163 164 procedure TEOTButton.SetBack(ca: T Canvas; x, y: integer);164 procedure TEOTButton.SetBack(ca: TDpiCanvas; x, y: integer); 165 165 begin 166 166 BitBlt(Back.Canvas.Handle, 0, 0, 48, 48, ca.Handle, x, y, SRCCOPY); -
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r173 r178 8 8 {$ENDIF} 9 9 StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, 10 Forms, Menus, GraphType ;10 Forms, Menus, GraphType, UDpiControls; 11 11 12 12 type 13 13 TTexture = record 14 Image: T Bitmap;14 Image: TDpiBitmap; 15 15 clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark, 16 16 clPage, clCover: TColor; 17 17 end; 18 19 TColor32 = type cardinal; 20 TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha); 21 TPixel32 = packed record 22 case integer of 23 0: (B, G, R, A: byte); 24 1: (ARGB: TColor32); 25 2: (Planes: array[0..3] of byte); 26 3: (Components: array[TColor32Component] of byte); 27 end; 28 PPixel32 = ^TPixel32; 29 30 { TPixelPointer } 31 32 TPixelPointer = record 33 Base: PPixel32; 34 Pixel: PPixel32; 35 Line: PPixel32; 36 RelLine: PPixel32; 37 BytesPerPixel: integer; 38 BytesPerLine: integer; 39 procedure NextLine; inline; // Move pointer to start of new base line 40 procedure NextPixel; inline; // Move pointer to next pixel 41 procedure SetXY(X, Y: integer); inline; // Set pixel position relative to base 42 procedure SetX(X: integer); inline; // Set horizontal pixel position relative to base 43 procedure Init(Bitmap: TDpiRasterImage; BaseX: integer = 0; BaseY: integer = 0); inline; 44 end; 45 PPixelPointer = ^TPixelPointer; 18 46 19 47 {$IFDEF WINDOWS} … … 21 49 {$ENDIF} 22 50 procedure RestoreResolution; 51 function Play(Item: string; Index: integer = -1): boolean; 52 procedure PreparePlay(Item: string; Index: integer = -1); 23 53 procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0); 24 54 function TurnToYear(Turn: integer): integer; 25 55 function TurnToString(Turn: integer): string; 26 56 function MovementToString(Movement: integer): string; 27 procedure BtnFrame(ca: T Canvas; p: TRect; const T: TTexture);28 procedure EditFrame(ca: T Canvas; p: TRect; const T: TTexture);57 procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture); 58 procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture); 29 59 function HexStringToColor(S: string): integer; 30 function LoadGraphicFile(bmp: T Bitmap; Path: string; Options: integer = 0): boolean;60 function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: integer = 0): boolean; 31 61 function LoadGraphicSet(const Name: string): integer; 32 procedure Dump(dst: T Bitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);33 procedure Sprite(Canvas: T Canvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);62 procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 63 procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 34 64 overload; 35 procedure Sprite(dst: T Bitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);65 procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 36 66 overload; 37 procedure MakeBlue(dst: T Bitmap; x, y, w, h: integer);38 procedure ImageOp_B(dst, Src: T Bitmap; xDst, yDst, xSrc, ySrc, w, h: integer);39 procedure ImageOp_BCC(dst, Src: T Bitmap;67 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer); 68 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: integer); 69 procedure ImageOp_BCC(dst, Src: TDpiBitmap; 40 70 xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer); 41 procedure ImageOp_CCC(bmp: T Bitmap; x, y, w, h, Color0, Color1, Color2: integer);42 function BitBltCanvas(DestCanvas: T Canvas; X, Y, Width, Height: integer;43 SrcCanvas: T Canvas; XSrc, YSrc: integer; Rop: DWORD): boolean;44 procedure SLine(ca: T Canvas; x0, x1, y: integer; cl: TColor);45 procedure DLine(ca: T Canvas; x0, x1, y: integer; cl0, cl1: TColor);46 procedure Frame(ca: T Canvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);47 procedure RFrame(ca: T Canvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);48 procedure CFrame(ca: T Canvas; x0, y0, x1, y1, Corner: integer; cl: TColor);49 procedure FrameImage(ca: T Canvas; Src: TBitmap;71 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: integer); 72 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer; 73 SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean; 74 procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor); 75 procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor); 76 procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 77 procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 78 procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor); 79 procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap; 50 80 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False); 51 procedure GlowFrame(dst: T Bitmap; x0, y0, Width, Height: integer; cl: TColor);81 procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor); 52 82 procedure InitOrnament; 53 83 procedure InitCityMark(const T: TTexture); 54 procedure Fill(ca: T Canvas; Left, Top, Width, Height, xOffset, yOffset: integer);55 procedure FillLarge(ca: T Canvas; x0, y0, x1, y1, xm: integer);56 procedure FillSeamless(ca: T Canvas; Left, Top, Width, Height, xOffset, yOffset: integer;57 const Texture: T Bitmap);58 procedure FillRectSeamless(ca: T Canvas; x0, y0, x1, y1, xOffset, yOffset: integer;59 const Texture: T Bitmap);60 procedure PaintBackground(Form: T Form; Left, Top, Width, Height: integer);61 procedure Corner(ca: T Canvas; x, y, Kind: integer; const T: TTexture);62 procedure BiColorTextOut(ca: T Canvas; clMain, clBack: TColor; x, y: integer; s: string);63 procedure LoweredTextOut(ca: T Canvas; cl: TColor; const T: TTexture;84 procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); 85 procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: integer); 86 procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer; 87 const Texture: TDpiBitmap); 88 procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer; 89 const Texture: TDpiBitmap); 90 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer); 91 procedure Corner(ca: TDpiCanvas; x, y, Kind: integer; const T: TTexture); 92 procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string); 93 procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture; 64 94 x, y: integer; s: string); 65 function BiColorTextWidth(ca: T Canvas; s: string): integer;66 procedure RisedTextOut(ca: T Canvas; x, y: integer; s: string);67 procedure LightGradient(ca: T Canvas; x, y, Width, Color: integer);68 procedure DarkGradient(ca: T Canvas; x, y, Width, Kind: integer);69 procedure VLightGradient(ca: T Canvas; x, y, Height, Color: integer);70 procedure VDarkGradient(ca: T Canvas; x, y, Height, Kind: integer);71 procedure NumberBar(dst: T Bitmap; x, y: integer; Cap: string; val: integer;95 function BiColorTextWidth(ca: TDpiCanvas; s: string): integer; 96 procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string); 97 procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: integer); 98 procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: integer); 99 procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: integer); 100 procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: integer); 101 procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string; val: integer; 72 102 const T: TTexture); 73 procedure CountBar(dst: T Bitmap; x, y, w: integer; Kind: integer;103 procedure CountBar(dst: TDpiBitmap; x, y, w: integer; Kind: integer; 74 104 Cap: string; val: integer; const T: TTexture); 75 procedure PaintProgressBar(ca: T Canvas; Kind, x, y, pos, Growth, max: integer;105 procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: integer; 76 106 const T: TTexture); 77 procedure PaintRelativeProgressBar(ca: T Canvas;107 procedure PaintRelativeProgressBar(ca: TDpiCanvas; 78 108 Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean; 79 109 const T: TTexture); 80 procedure PaintLogo(ca: T Canvas; x, y, clLight, clShade: integer);110 procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: integer); 81 111 function SetMainTextureByAge(Age: integer): boolean; 82 112 procedure LoadPhrases; … … 118 148 wOrna = 27; 119 149 hOrna = 26; // ornament 150 151 // sound modes 152 smOff = 0; 153 smOn = 1; 154 smOnAlt = 2; 120 155 121 156 // color matrix … … 153 188 TGrExtDescr = record { don't use dynamic strings here! } 154 189 Name: string[31]; 155 Data, Mask: T Bitmap;190 Data, Mask: TDpiBitmap; 156 191 pixUsed: array [byte] of byte; 157 192 end; … … 166 201 167 202 var 168 Phrases: TStringTable; 169 Phrases2: TStringTable; 170 nGrExt: Integer; 203 Phrases, Phrases2, Sounds: TStringTable; 204 nGrExt: integer; 171 205 GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr; 172 HGrSystem, HGrSystem2, ClickFrameColor, MainTextureAge: Integer;206 HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer; 173 207 MainTexture: TTexture; 174 Templates, Colors, Paper, BigImp, LogoBuffer: T Bitmap;175 FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: Boolean;176 177 UniFont: array [TFontType] of T Font;208 Templates, Colors, Paper, BigImp, LogoBuffer: TDpiBitmap; 209 FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean; 210 211 UniFont: array [TFontType] of TDpiFont; 178 212 AppRegistryKey: string = '\SOFTWARE\C-evo'; 179 213 … … 184 218 185 219 uses 186 Directories, Sound, Registry , PixelPointer;220 Directories, Sound, Registry; 187 221 188 222 var … … 221 255 ResolutionChanged := False; 222 256 {$ENDIF} 257 end; 258 259 function Play(Item: string; Index: integer = -1): boolean; 260 {$IFNDEF DEBUG} 261 var 262 WavFileName: string; 263 {$ENDIF} 264 begin 265 Result := False; 266 {$IFNDEF DEBUG} 267 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 268 begin 269 Result := True; 270 Exit; 271 end; 272 WavFileName := Sounds.Lookup(Item, Index); 273 Assert(WavFileName[1] <> '['); 274 Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*'); 275 if Result then 276 // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC) 277 PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName); 278 {$ENDIF} 279 end; 280 281 procedure PreparePlay(Item: string; Index: Integer = -1); 282 {$IFNDEF DEBUG} 283 var 284 WavFileName: string; 285 {$ENDIF} 286 begin 287 {$IFNDEF DEBUG} 288 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 289 Exit; 290 WavFileName := Sounds.Lookup(Item, Index); 291 Assert(WavFileName[1] <> '['); 292 if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then 293 PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName); 294 {$ENDIF} 223 295 end; 224 296 … … 284 356 end; 285 357 286 procedure BtnFrame(ca: T Canvas; p: TRect; const T: TTexture);358 procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture); 287 359 begin 288 360 RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade, … … 290 362 end; 291 363 292 procedure EditFrame(ca: T Canvas; p: TRect; const T: TTexture);364 procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture); 293 365 begin 294 366 Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000); … … 331 403 end; 332 404 333 procedure ApplyGammaToBitmap(Bitmap: T Bitmap);405 procedure ApplyGammaToBitmap(Bitmap: TDpiBitmap); 334 406 var 335 407 PixelPtr: TPixelPointer; … … 348 420 end; 349 421 350 procedure CopyGray8BitTo24bitBitmap(Dst, Src: T RasterImage);422 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiBitmap); 351 423 var 352 424 SrcPtr, DstPtr: TPixelPointer; … … 369 441 end; 370 442 371 function LoadGraphicFile(bmp: T Bitmap; Path: string; Options: Integer): Boolean;372 var 373 jtex: T JpegImage;374 Png: T PortableNetworkGraphic;443 function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean; 444 var 445 jtex: TDpiJpegImage; 446 Png: TDpiPortableNetworkGraphic; 375 447 begin 376 448 Result := True; … … 378 450 Path := Path + '.png'; 379 451 if ExtractFileExt(Path) = '.jpg' then begin 380 jtex := tjpegimage.Create;452 jtex := TDpiJpegImage.Create; 381 453 try 382 454 jtex.LoadFromFile(Path); … … 395 467 else 396 468 if ExtractFileExt(Path) = '.png' then begin 397 Png := T PortableNetworkGraphic.Create;469 Png := TDpiPortableNetworkGraphic.Create; 398 470 Png.PixelFormat := Bmp.PixelFormat; 399 471 try … … 414 486 end 415 487 else 416 Bmp.Canvas. draw(0, 0, Png);488 Bmp.Canvas.Draw(0, 0, Png); 417 489 end; 418 490 Png.Free; … … 446 518 I, x, y, xmax, OriginalColor: Integer; 447 519 FileName: string; 448 Source: T Bitmap;520 Source: TDpiBitmap; 449 521 DataPixel, MaskPixel: TPixelPointer; 450 522 begin … … 454 526 Result := I; 455 527 if I = nGrExt then begin 456 Source := T Bitmap.Create;528 Source := TDpiBitmap.Create; 457 529 Source.PixelFormat := pf24bit; 458 530 FileName := HomeDir + 'Graphics' + DirectorySeparator + Name; … … 471 543 GrExt[nGrExt].Data := Source; 472 544 GrExt[nGrExt].Data.PixelFormat := pf24bit; 473 GrExt[nGrExt].Mask := T Bitmap.Create;545 GrExt[nGrExt].Mask := TDpiBitmap.Create; 474 546 GrExt[nGrExt].Mask.PixelFormat := pf24bit; 475 547 GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height); … … 506 578 end; 507 579 508 procedure Dump(dst: T Bitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);580 procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 509 581 begin 510 582 BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, … … 512 584 end; 513 585 514 procedure MakeBlue(dst: T Bitmap; x, y, w, h: integer);586 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer); 515 587 var 516 588 XX, YY: integer; … … 531 603 end; 532 604 533 procedure ImageOp_B(dst, Src: T Bitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);605 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer); 534 606 // Src is template 535 607 // X channel = background amp (old Dst content), 128=original brightness … … 591 663 end; 592 664 593 procedure ImageOp_BCC(dst, Src: T Bitmap;665 procedure ImageOp_BCC(dst, Src: TDpiBitmap; 594 666 xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer); 595 667 // Src is template … … 657 729 end; 658 730 659 procedure ImageOp_CCC(bmp: T Bitmap; x, y, w, h, Color0, Color1, Color2: Integer);731 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer); 660 732 // Bmp is template 661 733 // B channel = Color0 amp, 128=original brightness … … 690 762 end; 691 763 692 procedure Sprite(Canvas: T Canvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);764 procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 693 765 begin 694 766 BitBlt(Canvas.Handle, xDst, yDst, Width, Height, … … 698 770 end; 699 771 700 procedure Sprite(dst: T Bitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);772 procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 701 773 begin 702 774 BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, … … 706 778 end; 707 779 708 function BitBltCanvas(DestCanvas: T Canvas; X, Y, Width, Height: integer;709 SrcCanvas: T Canvas; XSrc, YSrc: integer; Rop: DWORD): boolean;780 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer; 781 SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean; 710 782 begin 711 783 Assert(Rop = SRCCOPY); … … 715 787 end; 716 788 717 procedure SLine(ca: T Canvas; x0, x1, y: integer; cl: TColor);789 procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor); 718 790 begin 719 791 with ca do begin … … 724 796 end; 725 797 726 procedure DLine(ca: T Canvas; x0, x1, y: integer; cl0, cl1: TColor);798 procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor); 727 799 begin 728 800 with ca do begin … … 738 810 end; 739 811 740 procedure Frame(ca: T Canvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);812 procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 741 813 begin 742 814 with ca do begin … … 751 823 end; 752 824 753 procedure RFrame(ca: T Canvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);825 procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 754 826 begin 755 827 with ca do begin … … 767 839 end; 768 840 769 procedure CFrame(ca: T Canvas; x0, y0, x1, y1, Corner: integer; cl: TColor);841 procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor); 770 842 begin 771 843 with ca do begin … … 786 858 end; 787 859 788 procedure FrameImage(ca: T Canvas; Src: TBitmap;860 procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap; 789 861 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False); 790 862 begin … … 798 870 end; 799 871 800 procedure GlowFrame(dst: T Bitmap; x0, y0, Width, Height: Integer; cl: TColor);872 procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor); 801 873 var 802 874 x, y, ch, r: Integer; … … 879 951 end; 880 952 881 procedure Fill(ca: T Canvas; Left, Top, Width, Height, xOffset, yOffset: Integer);953 procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); 882 954 begin 883 955 Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and … … 887 959 end; 888 960 889 procedure FillLarge(ca: T Canvas; x0, y0, x1, y1, xm: Integer);961 procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: Integer); 890 962 891 963 function Band(I: Integer): Integer; … … 922 994 end; 923 995 924 procedure FillSeamless(ca: T Canvas; Left, Top, Width, Height, xOffset, yOffset: Integer;925 const Texture: T Bitmap);996 procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer; 997 const Texture: TDpiBitmap); 926 998 var 927 999 x, y, x0cut, y0cut, x1cut, y1cut: Integer; … … 957 1029 end; 958 1030 959 procedure FillRectSeamless(ca: T Canvas; x0, y0, x1, y1, xOffset, yOffset: Integer;960 const Texture: T Bitmap);1031 procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer; 1032 const Texture: TDpiBitmap); 961 1033 begin 962 1034 FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture); 963 1035 end; 964 1036 965 procedure PaintBackground(Form: T Form; Left, Top, Width, Height: Integer);1037 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer); 966 1038 begin 967 1039 Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div … … 969 1041 end; 970 1042 971 procedure Corner(ca: T Canvas; x, y, Kind: Integer; const T: TTexture);1043 procedure Corner(ca: TDpiCanvas; x, y, Kind: Integer; const T: TTexture); 972 1044 begin 973 1045 { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle, … … 977 1049 end; 978 1050 979 procedure BiColorTextOut(ca: T Canvas; clMain, clBack: TColor; x, y: Integer; s: string);1051 procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: Integer; s: string); 980 1052 981 1053 procedure PaintIcon(x, y, Kind: Integer); … … 1038 1110 end; 1039 1111 1040 function BiColorTextWidth(ca: T Canvas; s: string): Integer;1112 function BiColorTextWidth(ca: TDpiCanvas; s: string): Integer; 1041 1113 var 1042 1114 P: Integer; … … 1062 1134 end; 1063 1135 1064 procedure LoweredTextOut(ca: T Canvas; cl: TColor; const T: TTexture;1136 procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture; 1065 1137 x, y: Integer; s: string); 1066 1138 begin … … 1074 1146 end; 1075 1147 1076 procedure RisedTextOut(ca: T Canvas; x, y: integer; s: string);1148 procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string); 1077 1149 begin 1078 1150 BiColorTextOut(ca, $FFFFFF, $000000, x, y, s); 1079 1151 end; 1080 1152 1081 procedure Gradient(ca: T Canvas; x, y, dx, dy, Width, Height, Color: Integer;1153 procedure Gradient(ca: TDpiCanvas; x, y, dx, dy, Width, Height, Color: Integer; 1082 1154 Brightness: array of integer); 1083 1155 var … … 1113 1185 end; 1114 1186 1115 procedure LightGradient(ca: T Canvas; x, y, Width, Color: Integer);1187 procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: Integer); 1116 1188 const 1117 1189 Brightness: array [0 .. 15] of integer = … … 1121 1193 end; 1122 1194 1123 procedure DarkGradient(ca: T Canvas; x, y, Width, Kind: Integer);1195 procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: Integer); 1124 1196 const 1125 1197 Brightness: array [0 .. 15] of integer = … … 1130 1202 end; 1131 1203 1132 procedure VLightGradient(ca: T Canvas; x, y, Height, Color: Integer);1204 procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: Integer); 1133 1205 const 1134 1206 Brightness: array [0 .. 15] of integer = … … 1138 1210 end; 1139 1211 1140 procedure VDarkGradient(ca: T Canvas; x, y, Height, Kind: Integer);1212 procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: Integer); 1141 1213 const 1142 1214 Brightness: array [0 .. 15] of integer = … … 1147 1219 end; 1148 1220 1149 procedure NumberBar(dst: T Bitmap; x, y: integer; Cap: string;1221 procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string; 1150 1222 val: Integer; const T: TTexture); 1151 1223 var … … 1163 1235 end; 1164 1236 1165 procedure CountBar(dst: T Bitmap; x, y, w: Integer; Kind: Integer;1237 procedure CountBar(dst: TDpiBitmap; x, y, w: Integer; Kind: Integer; 1166 1238 Cap: string; val: Integer; const T: TTexture); 1167 1239 var … … 1259 1331 end; 1260 1332 1261 procedure PaintProgressBar(ca: T Canvas; Kind, x, y, pos, Growth, max: Integer;1333 procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: Integer; 1262 1334 const T: TTexture); 1263 1335 var … … 1312 1384 1313 1385 // pos and growth are relative to max, set size independent 1314 procedure PaintRelativeProgressBar(ca: T Canvas;1386 procedure PaintRelativeProgressBar(ca: TDpiCanvas; 1315 1387 Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean; 1316 1388 const T: TTexture); … … 1326 1398 end; 1327 1399 1328 procedure PaintLogo(ca: T Canvas; x, y, clLight, clShade: Integer);1400 procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: Integer); 1329 1401 begin 1330 1402 BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, … … 1357 1429 end; 1358 1430 1431 { TPixelPointer } 1432 1433 procedure TPixelPointer.NextLine; inline; 1434 begin 1435 Line := Pointer(Line) + BytesPerLine; 1436 Pixel := Line; 1437 end; 1438 1439 procedure TPixelPointer.NextPixel; inline; 1440 begin 1441 Pixel := Pointer(Pixel) + BytesPerPixel; 1442 end; 1443 1444 procedure TPixelPointer.SetXY(X, Y: Integer); inline; 1445 begin 1446 Line := Pointer(Base) + Y * BytesPerLine; 1447 SetX(X); 1448 end; 1449 1450 procedure TPixelPointer.SetX(X: Integer); inline; 1451 begin 1452 Pixel := Pointer(Line) + X * BytesPerPixel; 1453 end; 1454 1455 procedure TPixelPointer.Init(Bitmap: TDpiRasterImage; BaseX: Integer = 0; 1456 BaseY: integer = 0); inline; 1457 begin 1458 BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 1459 BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 1460 Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine); 1461 SetXY(0, 0); 1462 end; 1463 1359 1464 procedure LoadPhrases; 1360 1465 begin 1361 if Phrases = nil then Phrases := TStringTable.Create; 1362 if Phrases2 = nil then Phrases2 := TStringTable.Create; 1466 if Phrases = nil then 1467 Phrases := TStringTable.Create; 1468 if Phrases2 = nil then 1469 Phrases2 := TStringTable.Create; 1363 1470 Phrases2FallenBackToEnglish := False; 1364 1471 if FileExists(LocalizedFilePath('Language.txt')) then 1365 1472 begin 1366 Phrases. LoadFromFile(LocalizedFilePath('Language.txt'));1473 Phrases.loadfromfile(LocalizedFilePath('Language.txt')); 1367 1474 if FileExists(LocalizedFilePath('Language2.txt')) then 1368 Phrases2. LoadFromFile(LocalizedFilePath('Language2.txt'))1475 Phrases2.loadfromfile(LocalizedFilePath('Language2.txt')) 1369 1476 else 1370 1477 begin 1371 Phrases2. LoadFromFile(HomeDir + 'Language2.txt');1478 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1372 1479 Phrases2FallenBackToEnglish := True; 1373 1480 end; … … 1375 1482 else 1376 1483 begin 1377 Phrases.LoadFromFile(HomeDir + 'Language.txt'); 1378 Phrases2.LoadFromFile(HomeDir + 'Language2.txt'); 1379 end; 1380 1381 if Sounds = nil then Sounds := TStringTable.Create; 1382 if not Sounds.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then 1484 Phrases.loadfromfile(HomeDir + 'Language.txt'); 1485 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1486 end; 1487 1488 if Sounds = nil then 1489 Sounds := TStringTable.Create; 1490 if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then 1383 1491 begin 1384 1492 FreeAndNil(Sounds); … … 1396 1504 begin 1397 1505 for Section := Low(TFontType) to High(TFontType) do 1398 UniFont[Section] := T Font.Create;1506 UniFont[Section] := TDpiFont.Create; 1399 1507 1400 1508 Section := ftNormal; … … 1407 1515 if s[1] = '#' then begin 1408 1516 s := TrimRight(s); 1409 if s = '#SMALL' then Section := ftSmall 1410 else if s = '#TINY' then Section := ftTiny 1411 else if s = '#CAPTION' then Section := ftCaption 1412 else if s = '#BUTTON' then Section := ftButton 1413 else Section := ftNormal; 1517 if s = '#SMALL' then 1518 Section := ftSmall 1519 else if s = '#TINY' then 1520 Section := ftTiny 1521 else if s = '#CAPTION' then 1522 Section := ftCaption 1523 else if s = '#BUTTON' then 1524 Section := ftButton 1525 else 1526 Section := ftNormal; 1414 1527 end else begin 1415 1528 p := Pos(',', s); 1416 1529 if p > 0 then begin 1417 UniFont[ section].Name := Trim(Copy(s, 1, p - 1));1530 UniFont[Section].Name := Trim(Copy(s, 1, p - 1)); 1418 1531 Size := 0; 1419 1532 for i := p + 1 to Length(s) do … … 1428 1541 // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs 1429 1542 UniFont[section].Size := 1430 Round( size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);1543 Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8); 1431 1544 end; 1432 1545 end; … … 1490 1603 LoadPhrases; 1491 1604 1492 LogoBuffer := T Bitmap.Create;1605 LogoBuffer := TDpiBitmap.Create; 1493 1606 LogoBuffer.PixelFormat := pf24bit; 1494 1607 LogoBuffer.SetSize(wBBook, hBBook); … … 1499 1612 HGrSystem := LoadGraphicSet('System.png'); 1500 1613 HGrSystem2 := LoadGraphicSet('System2.png'); 1501 Templates := T Bitmap.Create;1614 Templates := TDpiBitmap.Create; 1502 1615 Templates.PixelFormat := pf24bit; 1503 1616 LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator + 1504 1617 'Templates.png', gfNoGamma); 1505 Colors := T Bitmap.Create;1618 Colors := TDpiBitmap.Create; 1506 1619 Colors.PixelFormat := pf24bit; 1507 1620 LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors.png'); 1508 Paper := T Bitmap.Create;1621 Paper := TDpiBitmap.Create; 1509 1622 Paper.PixelFormat := pf24bit; 1510 1623 LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper.jpg'); 1511 BigImp := T Bitmap.Create;1624 BigImp := TDpiBitmap.Create; 1512 1625 BigImp.PixelFormat := pf24bit; 1513 1626 LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons.png'); 1514 MainTexture.Image := T Bitmap.Create;1627 MainTexture.Image := TDpiBitmap.Create; 1515 1628 MainTextureAge := -2; 1516 1629 ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175]; … … 1530 1643 WriteString('Locale', LocaleCode); 1531 1644 WriteInteger('Gamma', Gamma); 1532 if FullScreen then WriteInteger('ScreenMode', 1)1533 else WriteInteger('ScreenMode', 0);1534 1645 finally 1535 1646 Free; … … 1547 1658 FreeAndNil(Phrases); 1548 1659 FreeAndNil(Phrases2); 1660 if Sounds <> nil then 1661 FreeAndNil(Sounds); 1549 1662 FreeAndNil(LogoBuffer); 1550 1663 FreeAndNil(BigImp); -
branches/highdpi/Packages/CevoComponents/Sound.pas
r174 r178 4 4 5 5 uses 6 Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil, 7 StringTables, Directories 8 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF} 9 {$IFDEF LINUX}, Process, AsyncProcess{$ENDIF}; 6 Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl 7 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF}; 10 8 11 9 type 12 TPlayStyle = (psAsync, psSync);13 14 10 TSoundPlayer = class(TForm) 15 11 private … … 19 15 end; 20 16 21 { TSound } 17 function PrepareSound(FileName: string): integer; 18 procedure PlaySound(FileName: string); 22 19 20 implementation 21 22 {$R *.lfm} 23 24 type 23 25 TSound = class 24 private25 PlayCommand: string;26 {$IFDEF LINUX}27 SoundPlayerAsyncProcess: TAsyncProcess;28 SoundPlayerSyncProcess: TProcess;29 {$ENDIF}30 function GetNonWindowsPlayCommand: string;31 26 public 32 FDeviceID: Word;27 FDeviceID: word; 33 28 FFileName: string; 34 PlayStyle: TPlayStyle;35 29 constructor Create(const FileName: string); 36 30 destructor Destroy; override; … … 40 34 end; 41 35 42 function PrepareSound(FileName: string): Integer;43 procedure PlaySound(FileName: string);44 function Play(Item: string; Index: Integer = -1): Boolean;45 procedure PreparePlay(Item: string; Index: Integer = -1);46 47 const48 // sound modes49 smOff = 0;50 smOn = 1;51 smOnAlt = 2;52 53 var54 Sounds: TStringTable;55 SoundMode: Integer;56 SoundPlayer: TSoundPlayer;57 SoundList: TFPGObjectList<TSound>;58 PlayingSound: TSound;59 60 61 implementation62 63 {$R *.lfm}64 65 resourcestring66 SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s';67 SPlayCommandNotWork = 'The play command %s does not work on your system';68 36 69 37 constructor TSound.Create(const FileName: string); … … 73 41 {$ENDIF} 74 42 begin 75 PlayStyle := psAsync;76 FFileName := FileName;77 43 {$IFDEF WINDOWS} 78 44 FDeviceID := 0; 79 if FileExists(FFileName) then begin 45 FFileName := FileName; 46 if FileExists(FFileName) then 47 begin 80 48 OpenParm.dwCallback := 0; 81 49 OpenParm.lpstrDeviceType := 'WaveAudio'; … … 85 53 FDeviceID := OpenParm.wDeviceID; 86 54 end 87 {$ENDIF}88 {$IFDEF LINUX}89 PlayCommand := GetNonWindowsPlayCommand;90 FDeviceID := 1;91 55 {$ENDIF} 92 56 end; … … 98 62 mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0); 99 63 {$ENDIF} 100 {$IFDEF LINUX}101 FreeAndNil(SoundPlayerSyncProcess);102 FreeAndNil(SoundPlayerAsyncProcess);103 {$ENDIF}104 64 inherited Destroy; 105 65 end; 106 107 function TSound.GetNonWindowsPlayCommand: string;108 begin109 Result := '';110 // Try play111 if (FindDefaultExecutablePath('play') <> '') then112 Result := 'play';113 // Try aplay114 if (result = '') then115 if (FindDefaultExecutablePath('aplay') <> '') then116 Result := 'aplay -q';117 // Try paplay118 if (Result = '') then119 if (FindDefaultExecutablePath('paplay') <> '') then120 Result := 'paplay';121 // Try mplayer122 if (Result = '') then123 if (FindDefaultExecutablePath('mplayer') <> '') then124 Result := 'mplayer -really-quiet';125 // Try CMus126 if (Result = '') then127 if (FindDefaultExecutablePath('CMus') <> '') then128 Result := 'CMus';129 // Try pacat130 if (Result = '') then131 if (FindDefaultExecutablePath('pacat') <> '') then132 Result := 'pacat -p';133 // Try ffplay134 if (Result = '') then135 if (FindDefaultExecutablePath('ffplay') <> '') then136 result := 'ffplay -autoexit -nodisp';137 // Try cvlc138 if (Result = '') then139 if (FindDefaultExecutablePath('cvlc') <> '') then140 result := 'cvlc -q --play-and-exit';141 // Try canberra-gtk-play142 if (Result = '') then143 if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then144 Result := 'canberra-gtk-play -c never -f';145 // Try Macintosh command?146 if (Result = '') then147 if (FindDefaultExecutablePath('afplay') <> '') then148 Result := 'afplay';149 end;150 151 66 152 67 procedure TSound.Play(HWND: DWORD); … … 154 69 var 155 70 PlayParm: TMCI_Play_Parms; 156 {$ENDIF}157 {$IFDEF LINUX}158 var159 L: TStringList;160 I: Integer;161 71 {$ENDIF} 162 72 begin … … 168 78 end 169 79 {$ENDIF} 170 {$IFDEF LINUX}171 // How to play in Linux? Use generic Linux commands172 // Use asyncprocess to play sound as SND_ASYNC173 // proceed if we managed to find a valid command174 if PlayCommand <> '' then begin175 L := TStringList.Create;176 try177 L.Delimiter := ' ';178 L.DelimitedText := PlayCommand;179 if PlayStyle = psASync then begin180 if SoundPlayerAsyncProcess = nil then181 SoundPlayerAsyncProcess := TAsyncProcess.Create(nil);182 SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(FFilename);183 SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]);184 SoundPlayerAsyncProcess.Parameters.Clear;185 for I := 1 to L.Count - 1 do186 SoundPlayerAsyncProcess.Parameters.Add(L[I]);187 SoundPlayerAsyncProcess.Parameters.Add(FFilename);188 try189 SoundPlayerAsyncProcess.Execute;190 except191 On E: Exception do192 E.CreateFmt(SUnableToPlay, ['paASync', FFilename, E.Message]);193 end;194 PlayingSound := nil;195 end else begin196 if SoundPlayerSyncProcess = nil then197 SoundPlayerSyncProcess := TProcess.Create(nil);198 SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(FFilename);199 SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]);200 SoundPlayersyncProcess.Parameters.Clear;201 for I := 1 to L.Count - 1 do202 SoundPlayerSyncProcess.Parameters.Add(L[I]);203 SoundPlayerSyncProcess.Parameters.Add(FFilename);204 try205 SoundPlayerSyncProcess.Execute;206 SoundPlayersyncProcess.WaitOnExit;207 except208 On E: Exception do209 E.CreateFmt(SUnableToPlay, ['paSync', FFilename, E.Message]);210 end;211 PlayingSound := nil;212 end;213 finally214 L.Free;215 end;216 end217 else218 raise Exception.CreateFmt(SPlayCommandNotWork, [PlayCommand]);219 {$ENDIF}220 80 end; 221 81 … … 224 84 {$IFDEF WINDOWS} 225 85 mciSendCommand(FDeviceID, MCI_STOP, 0, 0); 226 {$ENDIF}227 {$IFDEF LINUX}228 if SoundPlayerSyncProcess <> nil then SoundPlayerSyncProcess.Terminate(1);229 if SoundPlayerAsyncProcess <> nil then SoundPlayerAsyncProcess.Terminate(1);230 86 {$ENDIF} 231 87 end; … … 237 93 {$ENDIF} 238 94 end; 95 96 97 var 98 SoundPlayer: TSoundPlayer; 99 SoundList: TFPGObjectList<TSound>; 100 PlayingSound: TSound; 239 101 240 102 {$IFDEF WINDOWS} … … 249 111 {$ENDIF} 250 112 251 function PrepareSound(FileName: string): Integer;113 function PrepareSound(FileName: string): integer; 252 114 begin 253 115 Result := 0; 254 while ( Result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do255 Inc(Result);256 if Result = SoundList.Count then begin257 // First time this sound is played116 while (result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do 117 inc(result); 118 if result = SoundList.Count then begin 119 // first time this sound is played 258 120 SoundList.Add(TSound.Create(FileName)); 259 121 Result := SoundList.Count - 1; … … 263 125 procedure PlaySound(FileName: string); 264 126 begin 265 if PlayingSound <> nil then Exit; 127 if PlayingSound <> nil then 128 exit; 266 129 if SoundPlayer = nil then 267 130 Application.CreateForm(TSoundPlayer, SoundPlayer); … … 271 134 else 272 135 PlayingSound.Play(SoundPlayer.Handle); 273 end;274 275 function Play(Item: string; Index: Integer = -1): Boolean;276 {$IFNDEF DEBUG}277 var278 WavFileName: string;279 {$ENDIF}280 begin281 Result := False;282 {$IFNDEF DEBUG}283 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then284 begin285 Result := True;286 Exit;287 end;288 WavFileName := Sounds.Lookup(Item, Index);289 Assert(WavFileName[1] <> '[');290 Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');291 if Result then292 // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)293 PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);294 {$ENDIF}295 end;296 297 procedure PreparePlay(Item: string; Index: Integer = -1);298 {$IFNDEF DEBUG}299 var300 WavFileName: string;301 {$ENDIF}302 begin303 {$IFNDEF DEBUG}304 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then305 Exit;306 WavFileName := Sounds.Lookup(Item, Index);307 Assert(WavFileName[1] <> '[');308 if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then309 PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);310 {$ENDIF}311 136 end; 312 137 … … 325 150 end; 326 151 FreeAndNil(SoundList); 327 if Sounds <> nil then328 FreeAndNil(Sounds);329 152 end; 330 153 -
branches/highdpi/Packages/CevoComponents/StringTables.pas
r174 r178 17 17 destructor Destroy; override; 18 18 function LoadFromFile(const FileName: String): boolean; 19 function GetHandle(const Item: string): integer;19 function GetHandle(const Item: AnsiString): integer; 20 20 function LookupByHandle(Handle: integer; Index: integer = -1): string; 21 21 function Lookup(const Item: string; Index: integer = -1): string; … … 55 55 end; 56 56 57 function TStringTable.GetHandle(const Item: string): integer;57 function TStringTable.GetHandle(const Item: AnsiString): integer; 58 58 var 59 59 I: Integer; -
branches/highdpi/Start.lfm
r169 r178 1 1 object StartDlg: TStartDlg 2 Left = 2463 Height = 3264 Top = 1205 Width = 5566 BorderIcons = []7 BorderStyle = bsNone8 Caption = 'C-evo'9 2 ClientHeight = 326 10 3 ClientWidth = 556 4 Top = 120 5 Left = 246 6 Width = 556 7 Height = 326 8 Visible = False 9 Caption = 'C-evo' 10 Enabled = True 11 ShowHint = False 12 Font.Color = clWindowText 13 Font.Name = 'MS Sans Serif' 14 Font.PixelsPerInch = 144 15 Font.Height = -13 16 Align = alNone 11 17 Color = clBtnFace 12 DesignTimePPI = 14413 Font.Color = clWindowText14 Font.Height = -1315 Font.Name = 'MS Sans Serif'16 FormStyle = fsStayOnTop17 OnClose = FormClose18 OnCreate = FormCreate19 OnDestroy = FormDestroy20 OnHide = FormHide21 OnKeyDown = FormKeyDown22 18 OnMouseDown = FormMouseDown 23 19 OnMouseMove = FormMouseMove 24 20 OnMouseUp = FormMouseUp 21 OnKeyDown = FormKeyDown 25 22 OnPaint = FormPaint 23 HorzScrollBar.Visible = False 24 VertScrollBar.Visible = False 25 DesignTimePPI = 144 26 FormStyle = fsStayOnTop 27 BorderStyle = bsNone 28 BorderIcons = [] 29 LCLVersion = '2.0.2.0' 26 30 OnShow = FormShow 27 LCLVersion = '2.0.2.0' 31 OnHide = FormHide 32 OnCreate = FormCreate 33 OnDestroy = FormDestroy 34 OnClose = FormClose 28 35 object StartBtn: TButtonA 29 36 Tag = 15104 37 ClientHeight = 25 38 ClientWidth = 100 39 Top = 286 30 40 Left = 389 31 Height = 2532 Top = 28633 41 Width = 100 34 Down = False 35 Permanent = False 42 Height = 25 43 Visible = True 44 Enabled = True 45 ShowHint = False 46 Font.Color = clDefault 47 Font.PixelsPerInch = 144 48 Align = alNone 49 Color = clBtnFace 36 50 OnClick = StartBtnClick 51 Down = False 52 Permanent = False 37 53 end 38 54 object Down1Btn: TButtonC 39 55 Tag = 4096 56 ClientHeight = 12 57 ClientWidth = 12 58 Top = 111 40 59 Left = 522 41 Height = 12 42 Top = 111 43 Width = 12 44 Down = False 45 Permanent = False 60 Width = 12 61 Height = 12 62 Visible = True 63 Enabled = True 64 ShowHint = True 65 Font.Color = clDefault 66 Font.PixelsPerInch = 144 67 Align = alNone 68 Color = clBtnFace 46 69 OnClick = Down1BtnClick 70 Down = False 71 Permanent = False 47 72 ButtonIndex = 0 48 73 end 49 74 object Up1Btn: TButtonC 50 75 Tag = 4096 76 ClientHeight = 12 77 ClientWidth = 12 78 Top = 99 51 79 Left = 522 52 Height = 12 53 Top = 99 54 Width = 12 55 Down = False 56 Permanent = False 80 Width = 12 81 Height = 12 82 Visible = True 83 Enabled = True 84 ShowHint = True 85 Font.Color = clDefault 86 Font.PixelsPerInch = 144 87 Align = alNone 88 Color = clBtnFace 57 89 OnClick = Up1BtnClick 90 Down = False 91 Permanent = False 58 92 ButtonIndex = 1 59 93 end 60 94 object RenameBtn: TButtonB 61 95 Tag = 10240 96 ClientHeight = 25 97 ClientWidth = 25 98 Top = 98 62 99 Left = 412 63 Height = 2564 Top = 9865 100 Width = 25 66 Visible = False 67 Down = False 68 Permanent = False 101 Height = 25 102 Visible = False 103 Enabled = True 104 ShowHint = True 105 Font.Color = clDefault 106 Font.PixelsPerInch = 144 107 Align = alNone 108 Color = clBtnFace 69 109 OnClick = RenameBtnClick 110 Down = False 111 Permanent = False 70 112 ButtonIndex = 31 71 113 end 72 114 object DeleteBtn: TButtonB 73 115 Tag = 10240 116 ClientHeight = 25 117 ClientWidth = 25 118 Top = 98 74 119 Left = 441 75 Height = 2576 Top = 9877 120 Width = 25 78 Visible = False 79 Down = False 80 Permanent = False 121 Height = 25 122 Visible = False 123 Enabled = True 124 ShowHint = True 125 Font.Color = clDefault 126 Font.PixelsPerInch = 144 127 Align = alNone 128 Color = clBtnFace 81 129 OnClick = DeleteBtnClick 130 Down = False 131 Permanent = False 82 132 ButtonIndex = 21 83 133 end 84 134 object Down2Btn: TButtonC 85 135 Tag = 6912 136 ClientHeight = 12 137 ClientWidth = 12 138 Top = 249 86 139 Left = 522 87 Height = 12 88 Top = 249 89 Width = 12 90 Visible = False 91 Down = False 92 Permanent = False 140 Width = 12 141 Height = 12 142 Visible = False 143 Enabled = True 144 ShowHint = True 145 Font.Color = clDefault 146 Font.PixelsPerInch = 144 147 Align = alNone 148 Color = clBtnFace 93 149 OnClick = Down2BtnClick 150 Down = False 151 Permanent = False 94 152 ButtonIndex = 0 95 153 end 96 154 object Up2Btn: TButtonC 97 155 Tag = 6912 156 ClientHeight = 12 157 ClientWidth = 12 158 Top = 237 98 159 Left = 522 99 Height = 12 100 Top = 237 101 Width = 12 102 Visible = False 103 Down = False 104 Permanent = False 160 Width = 12 161 Height = 12 162 Visible = False 163 Enabled = True 164 ShowHint = True 165 Font.Color = clDefault 166 Font.PixelsPerInch = 144 167 Align = alNone 168 Color = clBtnFace 105 169 OnClick = Up2BtnClick 170 Down = False 171 Permanent = False 106 172 ButtonIndex = 1 107 173 end 108 174 object QuitBtn: TButtonB 109 175 Tag = 268435200 176 ClientHeight = 25 177 ClientWidth = 25 178 Top = 7 110 179 Left = 530 111 Height = 25112 Top = 7113 180 Width = 25 114 Down = False 115 Permanent = False 181 Height = 25 182 Visible = True 183 Enabled = True 184 ShowHint = True 185 Font.Color = clDefault 186 Font.PixelsPerInch = 144 187 Align = alNone 188 Color = clBtnFace 116 189 OnClick = QuitBtnClick 190 Down = False 191 Permanent = False 117 192 ButtonIndex = 0 118 193 end 119 194 object CustomizeBtn: TButtonC 120 195 Tag = 768 196 ClientHeight = 12 197 ClientWidth = 12 198 Top = 302 121 199 Left = 120 122 Height = 12 123 Top = 302 124 Width = 12 125 Down = False 126 Permanent = False 200 Width = 12 201 Height = 12 202 Visible = True 203 Enabled = True 204 ShowHint = True 205 Font.Color = clDefault 206 Font.PixelsPerInch = 144 207 Align = alNone 208 Color = clBtnFace 127 209 OnClick = CustomizeBtnClick 210 Down = False 211 Permanent = False 128 212 ButtonIndex = 0 129 213 end 130 214 object AutoDiffUpBtn: TButtonC 215 ClientHeight = 12 216 ClientWidth = 12 217 Top = 237 131 218 Left = 280 132 Height = 12 133 Top = 237 134 Width = 12 135 Down = False 136 Permanent = False 219 Width = 12 220 Height = 12 221 Visible = True 222 Enabled = True 223 ShowHint = True 224 Font.Color = clDefault 225 Font.PixelsPerInch = 144 226 Align = alNone 227 Color = clBtnFace 137 228 OnClick = AutoDiffUpBtnClick 229 Down = False 230 Permanent = False 138 231 ButtonIndex = 1 139 232 end 140 233 object AutoDiffDownBtn: TButtonC 234 ClientHeight = 12 235 ClientWidth = 12 236 Top = 249 141 237 Left = 280 142 Height = 12 143 Top = 249 144 Width = 12 145 Down = False 146 Permanent = False 238 Width = 12 239 Height = 12 240 Visible = True 241 Enabled = True 242 ShowHint = True 243 Font.Color = clDefault 244 Font.PixelsPerInch = 144 245 Align = alNone 246 Color = clBtnFace 147 247 OnClick = AutoDiffDownBtnClick 248 Down = False 249 Permanent = False 148 250 ButtonIndex = 0 149 251 end 150 252 object AutoEnemyUpBtn: TButtonC 253 ClientHeight = 12 254 ClientWidth = 12 255 Top = 152 151 256 Left = 206 152 Height = 12 153 Top = 152 154 Width = 12 155 Down = False 156 Permanent = False 257 Width = 12 258 Height = 12 259 Visible = True 260 Enabled = True 261 ShowHint = True 262 Font.Color = clDefault 263 Font.PixelsPerInch = 144 264 Align = alNone 265 Color = clBtnFace 157 266 OnClick = AutoEnemyUpBtnClick 267 Down = False 268 Permanent = False 158 269 ButtonIndex = 1 159 270 end 160 271 object AutoEnemyDownBtn: TButtonC 272 ClientHeight = 12 273 ClientWidth = 12 274 Top = 164 161 275 Left = 206 162 Height = 12 163 Top = 164 164 Width = 12 165 Down = False 166 Permanent = False 276 Width = 12 277 Height = 12 278 Visible = True 279 Enabled = True 280 ShowHint = True 281 Font.Color = clDefault 282 Font.PixelsPerInch = 144 283 Align = alNone 284 Color = clBtnFace 167 285 OnClick = AutoEnemyDownBtnClick 286 Down = False 287 Permanent = False 168 288 ButtonIndex = 0 169 289 end 170 290 object ReplayBtn: TButtonB 171 291 Tag = 2048 292 ClientHeight = 25 293 ClientWidth = 25 294 Top = 286 172 295 Left = 352 173 Height = 25174 Top = 286175 296 Width = 25 176 Down = False 177 Permanent = False 297 Height = 25 298 Visible = True 299 Enabled = True 300 ShowHint = True 301 Font.Color = clDefault 302 Font.PixelsPerInch = 144 303 Align = alNone 304 Color = clBtnFace 178 305 OnClick = ReplayBtnClick 306 Down = False 307 Permanent = False 179 308 ButtonIndex = 19 180 309 end 181 object List: T ListBox310 object List: TDpiListBox 182 311 Tag = 15360 312 ClientHeight = 238 313 ClientWidth = 265 314 Top = 64 183 315 Left = 45 316 Width = 266 184 317 Height = 238 185 Top = 64 186 Width = 266 187 BorderStyle = bsNone 188 Color = clBlack 189 ExtendedSelect = False 318 Visible = False 319 Enabled = True 320 ShowHint = False 190 321 Font.Color = 4176863 191 Font.Height = -15192 322 Font.Name = 'Times New Roman' 193 323 Font.Style = [fsBold] 194 IntegralHeight = True 195 ItemHeight = 0 324 Font.PixelsPerInch = 144 325 Font.Height = -15 326 Align = alNone 327 Color = clBlack 196 328 OnClick = ListClick 197 ParentFont = False198 ScrollWidth = 266199 TabOrder = 0200 TabStop = False201 TopIndex = -1202 Visible = False203 329 end 204 330 object PopupMenu1: TPopupMenu -
branches/highdpi/Start.pas
r170 r178 7 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Math, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 9 Menus, Registry, DrawDlg, fgl, Protocol ;9 Menus, Registry, DrawDlg, fgl, Protocol, UDpiControls; 10 10 11 11 const … … 56 56 Down1Btn: TButtonC; 57 57 Up1Btn: TButtonC; 58 List: T ListBox;58 List: TDpiListBox; 59 59 RenameBtn: TButtonB; 60 60 DeleteBtn: TButtonB; … … 72 72 procedure FormShow(Sender: TObject); 73 73 procedure FormHide(Sender: TObject); 74 procedure FormClose(Sender: TObject; var Action: TCloseAction);75 74 procedure FormCreate(Sender: TObject); 76 75 procedure FormDestroy(Sender: TObject); 77 76 procedure BrainClick(Sender: TObject); 78 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);79 77 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 80 78 Shift: TShiftState; x, y: integer); 81 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;82 Shift: TShiftState; x, y: integer);83 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);84 79 procedure Up1BtnClick(Sender: TObject); 85 80 procedure Down1BtnClick(Sender: TObject); 81 procedure FormClose(Sender: TObject; var Action: TCloseAction); 86 82 procedure ListClick(Sender: TObject); 87 83 procedure RenameBtnClick(Sender: TObject); … … 92 88 procedure Down2BtnClick(Sender: TObject); 93 89 procedure QuitBtnClick(Sender: TObject); 90 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 94 91 procedure CustomizeBtnClick(Sender: TObject); 95 92 procedure AutoDiffUpBtnClick(Sender: TObject); 96 93 procedure AutoDiffDownBtnClick(Sender: TObject); 94 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 95 Shift: TShiftState; x, y: integer); 96 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); 97 97 procedure AutoEnemyUpBtnClick(Sender: TObject); 98 98 procedure AutoEnemyDownBtnClick(Sender: TObject); 99 99 procedure ReplayBtnClick(Sender: TObject); 100 100 public 101 EmptyPicture: T Bitmap;101 EmptyPicture: TDpiBitmap; 102 102 procedure UpdateFormerGames; 103 103 procedure UpdateMaps; … … 127 127 MapFileName: string; 128 128 FormerGames, Maps: TStringList; 129 LogoBuffer, Mini: T Bitmap; { game world sample preview }129 LogoBuffer, Mini: TDpiBitmap; { game world sample preview } 130 130 MiniColors: array [0 .. 11, 0 .. 1] of TColor; 131 131 // BookDate: string; … … 155 155 156 156 uses 157 Directories, Direct, ScreenTools, Inp, Back, Locale , PixelPointer;157 Directories, Direct, ScreenTools, Inp, Back, Locale; 158 158 159 159 {$R *.lfm} … … 290 290 PlayerSlots.Count := nPlOffered; 291 291 for i := 0 to PlayerSlots.Count - 1 do 292 with PlayerSlots[i]do begin292 with TPlayerSlot(PlayerSlots[i]) do begin 293 293 DiffUpBtn := TButtonC.Create(self); 294 294 DiffUpBtn.Graphic := GrExt[HGrSystem].Data; … … 324 324 CustomizeBtn.ButtonIndex := 2; 325 325 326 Brains[0].Picture := T Bitmap.Create;326 Brains[0].Picture := TDpiBitmap.Create; 327 327 Brains[0].Picture.SetSize(64, 64); 328 328 BitBlt(Brains[0].Picture.Canvas.Handle, 0, 0, 64, 64, 329 329 GrExt[HGrSystem2].Data.Canvas.Handle, 1, 111, SRCCOPY); 330 Brains[1].Picture := T Bitmap.Create;330 Brains[1].Picture := TDpiBitmap.Create; 331 331 Brains[1].Picture.SetSize(64, 64); 332 332 BitBlt(Brains[1].Picture.Canvas.Handle, 0, 0, 64, 64, 333 333 GrExt[HGrSystem2].Data.Canvas.Handle, 66, 111, SRCCOPY); 334 Brains[2].Picture := T Bitmap.Create;334 Brains[2].Picture := TDpiBitmap.Create; 335 335 Brains[2].Picture.SetSize(64, 64); 336 336 BitBlt(Brains[2].Picture.Canvas.Handle, 0, 0, 64, 64, 337 337 GrExt[HGrSystem2].Data.Canvas.Handle, 131, 111, SRCCOPY); 338 Brains[3].Picture := T Bitmap.Create;338 Brains[3].Picture := TDpiBitmap.Create; 339 339 Brains[3].Picture.SetSize(64, 64); 340 340 BitBlt(Brains[3].Picture.Canvas.Handle, 0, 0, 64, 64, … … 346 346 with AIBrains[I] do 347 347 begin 348 AIBrains[i].Picture := T Bitmap.Create;348 AIBrains[i].Picture := TDpiBitmap.Create; 349 349 if not LoadGraphicFile(AIBrains[i].Picture, HomeDir + 'AI' + DirectorySeparator + 350 350 FileName + DirectorySeparator + FileName + '.png', gfNoError) then begin … … 363 363 AIBrains.Free; 364 364 365 EmptyPicture := T Bitmap.Create;365 EmptyPicture := TDpiBitmap.Create; 366 366 EmptyPicture.PixelFormat := pf24bit; 367 367 EmptyPicture.SetSize(64, 64); 368 368 EmptyPicture.Canvas.FillRect(0, 0, EmptyPicture.Width, EmptyPicture.Height); 369 LogoBuffer := T Bitmap.Create;369 LogoBuffer := TDpiBitmap.Create; 370 370 LogoBuffer.PixelFormat := pf24bit; 371 371 LogoBuffer.SetSize(wBuffer, 56); 372 372 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 373 373 374 Mini := T Bitmap.Create;374 Mini := TDpiBitmap.Create; 375 375 for x := 0 to 11 do 376 376 for y := 0 to 1 do … … 926 926 begin // load 927 927 FileName := List.Items[List.ItemIndex]; 928 if LoadGame( GetSavedDir+ DirectorySeparator, FileName + CevoExt, LoadTurn, false)928 if LoadGame(DataDir + 'Saved' + DirectorySeparator, FileName + CevoExt, LoadTurn, false) 929 929 then 930 930 UnlistBackupFile(FileName) … … 1010 1010 end; 1011 1011 1012 StartNewGame( GetSavedDir+ DirectorySeparator, FileName + CevoExt, MapFileName,1012 StartNewGame(DataDir + 'Saved' + DirectorySeparator, FileName + CevoExt, MapFileName, 1013 1013 lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn); 1014 1014 UnlistBackupFile(FileName); … … 1145 1145 pgLoad: 1146 1146 begin 1147 AssignFile(LogFile, GetSavedDir+ DirectorySeparator + List.Items[List.ItemIndex]1147 AssignFile(LogFile, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] 1148 1148 + CevoExt); 1149 1149 try … … 1198 1198 if Page = pgEditMap then 1199 1199 MapFileName := List.Items[List.ItemIndex] + CevoMapExt; 1200 if LoadGraphicFile(Mini, GetMapsDir+ DirectorySeparator + Copy(MapFileName, 1,1200 if LoadGraphicFile(Mini, DataDir + 'Maps' + DirectorySeparator + Copy(MapFileName, 1, 1201 1201 Length(MapFileName) - 9) + '.png', gfNoError) then 1202 1202 begin … … 1215 1215 end; 1216 1216 1217 AssignFile(MapFile, GetMapsDir+ DirectorySeparator + MapFileName);1217 AssignFile(MapFile, DataDir + 'Maps' + DirectorySeparator + MapFileName); 1218 1218 try 1219 1219 Reset(MapFile, 4); … … 1395 1395 begin 1396 1396 FormerGames.Clear; 1397 if FindFirst( GetSavedDir+ DirectorySeparator + '*' + CevoExt, $21, F) = 0 then1397 if FindFirst(DataDir + 'Saved' + DirectorySeparator + '*' + CevoExt, $21, F) = 0 then 1398 1398 repeat 1399 1399 I := FormerGames.Count; … … 1415 1415 begin 1416 1416 Maps.Clear; 1417 if FindFirst( GetMapsDir+ DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then1417 if FindFirst(DataDir + 'Maps' + DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then 1418 1418 repeat 1419 1419 Maps.Add(Copy(f.Name, 1, Length(f.Name) - 9)); … … 1790 1790 end; 1791 1791 if Page = pgLoad then 1792 AssignFile(f, GetSavedDir+ DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)1792 AssignFile(f, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt) 1793 1793 else 1794 AssignFile(f, GetMapsDir+ DirectorySeparator + List.Items[List.ItemIndex] +1794 AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex] + 1795 1795 CevoMapExt); 1796 1796 ok := true; 1797 1797 try 1798 1798 if Page = pgLoad then 1799 Rename(f, GetSavedDir+ DirectorySeparator + NewName + CevoExt)1799 Rename(f, DataDir + 'Saved'+ DirectorySeparator + NewName + CevoExt) 1800 1800 else 1801 Rename(f, GetMapsDir+ DirectorySeparator + NewName + CevoMapExt);1801 Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + CevoMapExt); 1802 1802 except 1803 1803 // Play('INVALID'); … … 1806 1806 if Page <> pgLoad then 1807 1807 try // rename map picture 1808 AssignFile(f, GetMapsDir+ DirectorySeparator + List.Items[List.ItemIndex]1808 AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex] 1809 1809 + '.png'); 1810 Rename(f, GetMapsDir+ DirectorySeparator + NewName + '.png');1810 Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + '.png'); 1811 1811 except 1812 1812 end; … … 1842 1842 begin 1843 1843 if Page = pgLoad then 1844 AssignFile(f, GetSavedDir+ DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)1844 AssignFile(f, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt) 1845 1845 else 1846 AssignFile(f, GetMapsDir+ DirectorySeparator + List.Items[List.ItemIndex] +1846 AssignFile(f, DataDir + 'Maps' + DirectorySeparator + List.Items[List.ItemIndex] + 1847 1847 CevoMapExt); 1848 1848 Erase(f); … … 2036 2036 procedure TStartDlg.ReplayBtnClick(Sender: TObject); 2037 2037 begin 2038 LoadGame( GetSavedDir+ DirectorySeparator, List.Items[List.ItemIndex] + CevoExt,2038 LoadGame(DataDir + 'Saved' + DirectorySeparator, List.Items[List.ItemIndex] + CevoExt, 2039 2039 LastTurn, True); 2040 2040 SlotAvailable := -1;
Note:
See TracChangeset
for help on using the changeset viewer.