Changeset 465 for branches/highdpi/LocalPlayer/Tribes.pas
- Timestamp:
- Nov 30, 2023, 10:16:14 PM (12 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/LocalPlayer/Tribes.pas
r349 r465 6 6 uses 7 7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global, 8 UGraphicSet;8 GraphicSet; 9 9 10 10 type … … 20 20 yShield: Integer; 21 21 end; 22 23 { TModelPictureInfo } 22 24 23 25 TModelPictureInfo = record … … 27 29 Hash: Integer; 28 30 GrName: ShortString; 31 function GetCommandDataSize: Byte; 29 32 end; 30 33 … … 46 49 constructor Create(FileName: string); 47 50 destructor Destroy; override; 48 function GetCityName( i: Integer): string;49 {$IFNDEF SCR} procedure SetCityName( i: Integer; NewName: string); {$ENDIF}51 function GetCityName(I: Integer): string; 52 {$IFNDEF SCR} procedure SetCityName(I: Integer; NewName: string); {$ENDIF} 50 53 {$IFNDEF SCR} function TString(Template: string): string; 51 54 function TPhrase(Item: string): string; {$ENDIF} … … 69 72 function CityName(Founder: Integer): string; 70 73 function ModelCode(const ModelInfo: TModelInfo): Integer; 71 procedure FindStdModelPicture(Code: Integer; var pix: Integer; varName: string);74 procedure FindStdModelPicture(Code: Integer; out pix: Integer; out Name: string); 72 75 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean; 73 procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;76 procedure FindPosition(HGr: TGraphicSet; X, Y, xmax, ymax: Integer; Mark: TColor; 74 77 var xp, yp: Integer); 75 78 … … 212 215 function Get: string; 213 216 var 214 p: Integer;217 P: Integer; 215 218 begin 216 219 while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do 217 220 Delete(Input, 1, 1); 218 p:= Pos(',', Input);219 if p= 0 then220 p:= Length(Input) + 1;221 Result := Copy(Input, 1, p- 1);222 Delete(Input, 1, p);221 P := Pos(',', Input); 222 if P = 0 then 223 P := Length(Input) + 1; 224 Result := Copy(Input, 1, P - 1); 225 Delete(Input, 1, P); 223 226 end; 224 227 225 228 function GetNum: Integer; 226 229 var 227 i: Integer;228 begin 229 Val(Get, Result, i);230 if i<> 0 then230 I: Integer; 231 begin 232 Val(Get, Result, I); 233 if I <> 0 then 231 234 Result := 0; 232 235 end; 233 236 234 procedure FindStdModelPicture(Code: Integer; var pix: Integer; varName: string);235 var 236 i: Integer;237 begin 238 for i:= 0 to StdUnitScript.Count - 1 do237 procedure FindStdModelPicture(Code: Integer; out pix: Integer; out Name: string); 238 var 239 I: Integer; 240 begin 241 for I := 0 to StdUnitScript.Count - 1 do 239 242 begin // look through StdUnits 240 Input := StdUnitScript[ i];243 Input := StdUnitScript[I]; 241 244 pix := GetNum; 242 245 if Code = GetNum then … … 281 284 CloseFile(TribeScript); 282 285 Result := Found = 3; 286 end; 287 288 { TModelPictureInfo } 289 290 function TModelPictureInfo.GetCommandDataSize: Byte; 291 begin 292 Result := SizeOf(trix) + SizeOf(mix) + SizeOf(pix) + SizeOf(Hash) + 1 + 293 Length(GrName); 283 294 end; 284 295 … … 329 340 end; 330 341 331 procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;342 procedure FindPosition(HGr: TGraphicSet; X, Y, xmax, ymax: Integer; Mark: TColor; 332 343 var xp, yp: Integer); 333 344 begin 334 345 xp := 0; 335 while (xp < xmax) and (HGr.Data.Canvas.Pixels[ x + 1 + xp, y] <> Mark) do346 while (xp < xmax) and (HGr.Data.Canvas.Pixels[X + 1 + xp, Y] <> Mark) do 336 347 Inc(xp); 337 348 yp := 0; 338 while (yp < ymax) and (HGr.Data.Canvas.Pixels[ x, y+ 1 + yp] <> Mark) do349 while (yp < ymax) and (HGr.Data.Canvas.Pixels[X, Y + 1 + yp] <> Mark) do 339 350 Inc(yp); 340 351 end; 341 352 342 function TTribe.GetCityName( i: Integer): string;353 function TTribe.GetCityName(I: Integer): string; 343 354 begin 344 355 Result := ''; 345 if nCityLines > ithen346 begin 347 Result := Script[CityLine0 + i];356 if nCityLines > I then 357 begin 358 Result := Script[CityLine0 + I]; 348 359 while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do 349 360 Delete(Result, 1, 1); … … 351 362 {$IFNDEF SCR} 352 363 else 353 Result := Format(TPhrase('GENCITY'), [ i+ 1]);364 Result := Format(TPhrase('GENCITY'), [I + 1]); 354 365 {$ENDIF} 355 366 end; 356 367 357 368 {$IFNDEF SCR} 358 procedure TTribe.SetCityName( i: Integer; NewName: string);359 begin 360 while nCityLines <= ido369 procedure TTribe.SetCityName(I: Integer; NewName: string); 370 begin 371 while nCityLines <= I do 361 372 begin 362 373 Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'), … … 364 375 Inc(nCityLines); 365 376 end; 366 Script[CityLine0 + i] := NewName;377 Script[CityLine0 + I] := NewName; 367 378 end; 368 379 369 380 function TTribe.TString(Template: string): string; 370 381 var 371 p: Integer;382 P: Integer; 372 383 Variant: Char; 373 384 CaseUp: Boolean; 374 385 begin 375 386 repeat 376 p := pos('#', Template);377 if ( p = 0) or (p= Length(Template)) then387 P := Pos('#', Template); 388 if (P = 0) or (P = Length(Template)) then 378 389 Break; 379 Variant := Template[ p+ 1];390 Variant := Template[P + 1]; 380 391 CaseUp := Variant in ['A' .. 'Z']; 381 392 if CaseUp then 382 393 Inc(Variant, 32); 383 Delete(Template, p, 2);394 Delete(Template, P, 2); 384 395 if Variant in ['a' .. 'z'] then 385 396 begin 386 397 if NumberName < 0 then 387 Insert(Name[Variant], Template, p)398 Insert(Name[Variant], Template, P) 388 399 else 389 Insert(Format('P%d', [NumberName]), Template, p);390 if CaseUp and (Length(Template) >= p) and391 (Template[ p] in ['a' .. 'z', #$E0 .. #$FF]) then392 Dec(Template[ p], 32);400 Insert(Format('P%d', [NumberName]), Template, P); 401 if CaseUp and (Length(Template) >= P) and 402 (Template[P] in ['a' .. 'z', #$E0 .. #$FF]) then 403 Dec(Template[P], 32); 393 404 end 394 405 until False; … … 407 418 TLine = array [0 .. 649, 0 .. 2] of Byte; 408 419 var 409 i, x, Gray: Integer;420 I, X, Gray: Integer; 410 421 Item: string; 411 422 begin … … 415 426 with Script do 416 427 begin 417 i:= 0;418 while ( i < Count) and (Copy(Strings[i], 1, 6) <>428 I := 0; 429 while (I < Count) and (Copy(Strings[I], 1, 6) <> 419 430 '#AGE' + char(48 + Age) + ' ') do 420 Inc( i);421 if i< Count then422 begin 423 Input := Strings[ i];431 Inc(I); 432 if I < Count then 433 begin 434 Input := Strings[I]; 424 435 system.Delete(Input, 1, 6); 425 436 Item := Get; … … 430 441 if CompareText(Item, 'stdcities') = 0 then 431 442 case cpix of 432 3: 433 cpix := 0; 434 6: 435 begin 443 3: cpix := 0; 444 6: begin 436 445 cpix := 0; 437 446 Item := 'Nation2'; 438 end 447 end; 439 448 end; 440 449 cHGr := LoadGraphicSet(Item + '.png'); 441 for x := 0 to 3 do 442 with CityPicture[x] do 443 begin 444 FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF, 450 for X := 0 to 3 do 451 with CityPicture[X] do begin 452 FindPosition(cHGr, X * 65, cpix * 49, 63, 47, $00FFFF, 445 453 xShield, yShield); 446 454 // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf); … … 478 486 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean); 479 487 var 480 i: Integer;488 I: Integer; 481 489 ok: Boolean; 482 490 begin … … 485 493 if not IsNew then 486 494 begin 487 i:= nPictureList - 1;488 while ( i >= 0) and (PictureList[i].Hash <> Info.Hash) do489 Dec( i);490 assert(i>= 0);491 assert(PictureList[i].HGr = LoadGraphicSet(GrName));492 assert(PictureList[i].pix = pix);493 ModelPicture[mix].HGr := PictureList[ i].HGr;494 ModelPicture[mix].pix := PictureList[ i].pix;495 ModelName[mix] := PictureList[ i].ModelName;495 I := nPictureList - 1; 496 while (I >= 0) and (PictureList[I].Hash <> Info.Hash) do 497 Dec(I); 498 Assert(I >= 0); 499 Assert(PictureList[I].HGr = LoadGraphicSet(GrName)); 500 Assert(PictureList[I].pix = pix); 501 ModelPicture[mix].HGr := PictureList[I].HGr; 502 ModelPicture[mix].pix := PictureList[I].pix; 503 ModelName[mix] := PictureList[I].ModelName; 496 504 end 497 505 else … … 507 515 // read model name from tribe script 508 516 ok := False; 509 for i:= 0 to Script.Count - 1 do510 begin 511 Input := Script[ i];517 for I := 0 to Script.Count - 1 do 518 begin 519 Input := Script[I]; 512 520 if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then 513 521 ok := True … … 523 531 if ModelName[mix] = '' then 524 532 begin // read model name from StdUnits.txt 525 for i:= 0 to StdUnitScript.Count - 1 do533 for I := 0 to StdUnitScript.Count - 1 do 526 534 begin 527 Input := StdUnitScript[ i];535 Input := StdUnitScript[I]; 528 536 if GetNum = pix then 529 537 begin … … 559 567 Code, Turn: Integer; ForceNew: Boolean): Boolean; 560 568 var 561 i: Integer;569 I: Integer; 562 570 Cnt: Integer; 563 571 HGr: TGraphicSet; … … 598 606 if not ForceNew and (Picture.Hash > 0) then 599 607 begin 600 for i:= 0 to nPictureList - 1 do601 if PictureList[ i].Hash = Picture.Hash then602 begin 603 Picture.GrName := PictureList[ i].HGr.Name;604 Picture.pix := PictureList[ i].pix;608 for I := 0 to nPictureList - 1 do 609 if PictureList[I].Hash = Picture.Hash then 610 begin 611 Picture.GrName := PictureList[I].HGr.Name; 612 Picture.pix := PictureList[I].pix; 605 613 Result := False; 606 614 Exit; … … 614 622 TestPic.GrName := 'StdUnits.png'; 615 623 HGr := HGrStdUnits; 616 for i:= 0 to StdUnitScript.Count - 1 do624 for I := 0 to StdUnitScript.Count - 1 do 617 625 begin // look through StdUnits 618 Input := StdUnitScript[ i];626 Input := StdUnitScript[I]; 619 627 Check; 620 628 end; 621 629 622 630 ok := False; 623 for i:= 0 to Script.Count - 1 do631 for I := 0 to Script.Count - 1 do 624 632 begin // look through units defined in tribe script 625 Input := Script[ i];633 Input := Script[I]; 626 634 if Copy(Input, 1, 6) = '#UNITS' then 627 635 begin
Note:
See TracChangeset
for help on using the changeset viewer.