- Timestamp:
- Jan 11, 2017, 10:14:11 PM (8 years ago)
- Location:
- trunk
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Direct.pas
r38 r52 198 198 begin 199 199 PostMessage(Handle, WM_GO, 0, 0); 200 Gone := true 201 end 200 Gone := true; 201 end; 202 202 end; 203 203 -
trunk/Integrated.lpi
r49 r52 438 438 <StackChecks Value="True"/> 439 439 </Checks> 440 <VerifyObjMethodCallValidity Value="True"/> 440 441 </CodeGeneration> 441 442 <Linking> -
trunk/LocalPlayer/CityScreen.pas
r38 r52 431 431 end; 432 432 433 procedure MakeRed(x, y, w, h: integer); 434 type 435 TLine = array [0 .. 99999, 0 .. 2] of byte; 436 PLine = ^TLine; 437 438 procedure RedLine(line: PLine; length: integer); 439 var 440 i, gray: integer; 441 begin 442 for i := 0 to length - 1 do 443 begin 444 gray := (integer(line[i, 0]) + integer(line[i, 1]) + integer(line[i, 2]) 433 procedure MakeRed(X, Y, W, H: Integer); 434 var 435 XX, YY: Integer; 436 Gray: Integer; 437 PixelPtr: PPixel32; 438 LinePtr: PPixel32; 439 begin 440 Offscreen.BeginUpdate; 441 LinePtr := GetBitmapPixelPtr(Offscreen, X, Y); 442 for YY := 0 to h - 1 do begin 443 PixelPtr := LinePtr; 444 for XX := 0 to w - 1 do begin 445 Gray := (Integer(PixelPtr^.B) + Integer(PixelPtr^.G) + Integer(PixelPtr^.R) 445 446 ) * 85 shr 8; 446 line[i, 0] := 0; 447 line[i, 1] := 0; 448 line[i, 2] := gray; // 255-(255-gray) div 2; 447 PixelPtr^.B := 0; 448 PixelPtr^.G := 0; 449 PixelPtr^.R := Gray; // 255-(255-gray) div 2; 450 PixelPtr := Pointer(PixelPtr) + (Offscreen.RawImage.Description.BitsPerPixel shr 3); 449 451 end; 450 end; 451 452 var 453 i: integer; 454 begin 455 Offscreen.BeginUpdate; 456 for i := 0 to h - 1 do 457 RedLine(@(PLine(offscreen.ScanLine[y + i])[x]), w); 452 LinePtr := Pointer(LinePtr) + Offscreen.RawImage.Description.BytesPerLine; 453 end; 458 454 Offscreen.EndUpdate; 459 455 end; -
trunk/LocalPlayer/Help.pas
r51 r52 365 365 nHeaven = 28; 366 366 maxsum = 9 * 9 * 255 * 75 div 100; 367 type368 TLine = array [0 .. 649, 0 .. 2] of Byte;369 367 var 370 368 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 371 369 Heaven: array [0 .. nHeaven] of integer; 372 Paint Line, CoalLine: ^TLine;373 Imp Line: array [-1 .. 1] of ^TLine;370 PaintPtr, CoalPtr: TPixelPointer; 371 ImpPtr: array [-1 .. 1] of TPixelPointer; 374 372 begin 375 373 // assume eiffel tower has free common heaven … … 385 383 if (y0 + y >= 0) and (y0 + y < InnerHeight) then 386 384 begin 387 Paint Line := OffScreen.ScanLine[y0 + y];388 Coal Line := Templates.ScanLine[yCoal + y];385 PaintPtr.Init(OffScreen, 0, y0 + y); 386 CoalPtr.Init(Templates, 0, yCoal + y); 389 387 for dy := -1 to 1 do 390 388 if ((y + dy) shr 1 >= 0) and ((y + dy) shr 1 < ySizeBig) then 391 Imp Line[dy] := BigImp.ScanLine[ySrc + (y + dy) shr 1];389 ImpPtr[dy].Init(BigImp, 0, ySrc + (y + dy) shr 1); 392 390 for x := 0 to xSizeBig * 2 - 1 do 393 391 begin … … 396 394 begin 397 395 xx := xSrc + (x + dx) shr 1; 396 ImpPtr[dy].SetX(xx); 398 397 for dy := -1 to 1 do 399 398 if ((y + dy) shr 1 < 0) or ((y + dy) shr 1 >= ySizeBig) or 400 399 ((x + dx) shr 1 < 0) or ((x + dx) shr 1 >= xSizeBig) or 401 400 ((y + dy) shr 1 < nHeaven) and 402 (Imp Line[dy, xx, 0] shl 16 + ImpLine[dy, xx, 1]shl 8 +403 Imp Line[dy, xx, 2]= Heaven[(y + dy) shr 1]) then401 (ImpPtr[dy].Pixel^.B shl 16 + ImpPtr[dy].Pixel^.G shl 8 + 402 ImpPtr[dy].Pixel^.R = Heaven[(y + dy) shr 1]) then 404 403 sum := sum + 9 * 255 405 404 else 406 sum := sum + Imp Line[dy, xx, 0] + 5 * ImpLine[dy, xx, 1]+ 3 *407 Imp Line[dy, xx, 2];405 sum := sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 * 406 ImpPtr[dy].Pixel^.R; 408 407 end; 409 408 if sum < maxsum then 410 409 begin // no saturation 411 sum := 1 shl 22 - (maxsum - sum) * (256 - CoalLine[xCoal + x, 0] * 2); 412 PaintLine[x0 + x, 0] := PaintLine[x0 + x, 0] * sum shr 22; 413 PaintLine[x0 + x, 1] := PaintLine[x0 + x, 1] * sum shr 22; 414 PaintLine[x0 + x, 2] := PaintLine[x0 + x, 2] * sum shr 22; 410 CoalPtr.SetX(xCoal + x); 411 sum := 1 shl 22 - (maxsum - sum) * (256 - CoalPtr.Pixel^.B * 2); 412 PaintPtr.SetX(x0 + x); 413 PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * sum shr 22; 414 PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * sum shr 22; 415 PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * sum shr 22; 415 416 end; 416 417 end; -
trunk/LocalPlayer/TechTree.pas
r38 r52 120 120 121 121 procedure TTechTreeDlg.FormShow(Sender: TObject); 122 type123 TLine = array [0 .. 9999, 0 .. 2] of Byte;124 122 var 125 123 X, Y, ad, TexWidth, TexHeight: Integer; 126 124 s: string; 127 Src Line, DstLine: ^TLine;125 SrcPixel, DstPixel: PPixel32; 128 126 begin 129 127 if Image = nil then … … 171 169 for Y := 0 to Image.height - 1 do 172 170 begin 173 SrcLine := Paper.ScanLine[Y mod TexHeight];174 DstLine := Image.ScanLine[Y];175 171 for X := 0 to Image.width - 1 do 176 172 begin 177 if Cardinal((@DstLine[X])^) and $FFFFFF = $7F007F then // transparent 178 DstLine[X] := SrcLine[X mod TexWidth]; 173 DstPixel := GetBitmapPixelPtr(Image, X, Y); 174 if (DstPixel^.ARGB and $FFFFFF) = $7F007F then // transparent 175 begin 176 SrcPixel := GetBitmapPixelPtr(Paper, X mod TexWidth, Y mod TexHeight); 177 DstPixel^.B := SrcPixel^.B; 178 DstPixel^.G := SrcPixel^.G; 179 DstPixel^.R := SrcPixel^.R; 180 end; 179 181 end; 180 182 end; -
trunk/LocalPlayer/Term.pas
r50 r52 506 506 Sharpen = 80; 507 507 type 508 TLine = array [0 .. 99999, 0 .. 2] of Byte;509 508 TBuffer = array [0 .. 99999, 0 .. 2] of integer; 510 509 var … … 512 511 ydivider: integer; 513 512 resampled: ^TBuffer; 514 line: ^TLine;513 PixelPtr: TPixelPointer; 515 514 begin 516 515 nx := BigImp.width div xSizeBig * xSizeSmall; … … 529 528 if ydivider > ySizeSmall then 530 529 ydivider := ySizeSmall; 531 line := BigImp.ScanLine[cut + iy * ySizeBig + y];530 PixelPtr.Init(BigImp, 0, cut + iy * ySizeBig + y); 532 531 for x := 0 to xSizeBig - 1 do 533 532 begin … … 541 540 for ch := 0 to 2 do 542 541 begin 543 c := line[ix * xSizeBig + x, ch]; 542 PixelPtr.SetX(ix * xSizeBig + x); 543 c := PixelPtr.Pixel^.Planes[ch]; 544 544 inc(resampled[ir, ch], c * xdivider * ydivider); 545 545 if xdivider < xSizeSmall then … … 558 558 559 559 // sharpen resampled icons 560 SmallImp.width := nx; 561 SmallImp.height := ny; 560 SmallImp.SetSize(nx, ny); 562 561 SmallImp.BeginUpdate; 563 for y := 0 to ny - 1 do 564 begin 565 line := SmallImp.ScanLine[y]; 562 for y := 0 to ny - 1 do begin 563 PixelPtr.Init(SmallImp, 0, y); 566 564 for x := 0 to nx - 1 do 567 for ch := 0 to 2 do 568 begin 565 for ch := 0 to 2 do begin 569 566 sum := 0; 570 567 Cnt := 0; … … 581 578 sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum * 582 579 Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut)); 583 if sum < 0 then 584 sum := 0; 585 if sum > 255 then 586 sum := 255; 587 line[x][ch] := sum; 580 if sum < 0 then sum := 0; 581 if sum > 255 then sum := 255; 582 PixelPtr.SetX(x); 583 PixelPtr.Pixel^.Planes[ch] := sum; 588 584 end; 589 585 end; … … 4066 4062 4067 4063 procedure TMainScreen.MiniPaint; 4068 type4069 TLine = array [0 .. 99999999, 0 .. 2] of Byte;4070 4064 var 4071 4065 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer; 4072 PrevMini Line, MiniLine: ^TLine;4066 PrevMiniPixel, MiniPixel: PPixel32; 4073 4067 begin 4074 4068 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67]; … … 4080 4074 FillRect(Rect(0, 0, Mini.width, Mini.height)); 4081 4075 end; 4082 MiniLine := nil;4083 4076 Mini.BeginUpdate; 4084 4077 for y := 0 to G.ly - 1 do 4085 4078 begin 4086 PrevMiniLine := MiniLine;4087 MiniLine := Mini.ScanLine[y];4088 4079 for x := 0 to G.lx - 1 do 4089 4080 if MyMap[x + G.lx * y] and fTerrain <> fUNKNOWN then … … 4093 4084 begin 4094 4085 xm := ((x - xwMini) * 2 + i + y and 1 - hw + G.lx * 5) mod (G.lx * 2); 4086 MiniPixel := GetBitmapPixelPtr(Mini, xm, y); 4095 4087 cm := MiniColors[MyMap[Loc] and fTerrain, i]; 4096 4088 if ClientMode = cEditMap then … … 4115 4107 end; 4116 4108 cm := $808080 or cm shr 1; { increase brightness } 4117 if PrevMiniLine <> nil then 4118 begin // 2x2 city dot covers two scanlines 4119 PrevMiniLine[xm, 0] := cm shr 16; 4120 PrevMiniLine[xm, 1] := cm shr 8 and $FF; 4121 PrevMiniLine[xm, 2] := cm and $FF; 4109 if y > 0 then begin 4110 // 2x2 city dot covers two scanlines 4111 PrevMiniPixel := GetBitmapPixelPtr(Mini, xm, y - 1); 4112 PrevMiniPixel^.B := cm shr 16; 4113 PrevMiniPixel^.G := cm shr 8 and $FF; 4114 PrevMiniPixel^.R := cm and $FF; 4122 4115 end 4123 4116 end … … 4148 4141 cm := Tribe[MyRO.Territory[Loc]].Color; 4149 4142 end; 4150 Mini Line[xm, 0]:= cm shr 16;4151 Mini Line[xm, 1]:= cm shr 8 and $FF;4152 Mini Line[xm, 2]:= cm and $FF;4143 MiniPixel^.B := cm shr 16; 4144 MiniPixel^.G := cm shr 8 and $FF; 4145 MiniPixel^.R := cm and $FF; 4153 4146 end; 4154 4147 end; -
trunk/LocalPlayer/Wonders.pas
r38 r52 78 78 79 79 procedure TWondersDlg.OffscreenPaint; 80 type81 TLine = array [0 .. 649, 0 .. 2] of Byte;82 80 83 81 procedure DarkIcon(i: Integer); 84 82 var 85 83 X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer; 86 Src, Dst: ^TLine;84 Src, Dst: PPixel32; 87 85 begin 88 86 x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0]; … … 90 88 x0Src := (i mod 7) * xSizeBig; 91 89 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 92 for Y := 0 to ySizeBig - 1 do 93 begin 94 Src := BigImp.ScanLine[y0Src + Y]; 95 Dst := Offscreen.ScanLine[y0Dst + Y]; 96 for X := 0 to xSizeBig - 1 do 97 begin 98 darken := ((255 - Src[x0Src + X][0]) * 3 + (255 - Src[x0Src + X][1]) * 99 15 + (255 - Src[x0Src + X][2]) * 9) div 128; 100 for ch := 0 to 2 do 101 begin 102 c := Dst[x0Dst + X][ch] - darken; 103 if c < 0 then 104 Dst[x0Dst + X][ch] := 0 105 else 106 Dst[x0Dst + X][ch] := c; 90 for Y := 0 to ySizeBig - 1 do begin 91 for X := 0 to xSizeBig - 1 do begin 92 Src := GetBitmapPixelPtr(BigImp, x0Src + X, y0Src + Y); 93 Dst := GetBitmapPixelPtr(Offscreen, x0Dst + X, y0Dst + Y); 94 darken := ((255 - Src^.B) * 3 + (255 - Src^.G) * 95 15 + (255 - Src^.R) * 9) div 128; 96 for ch := 0 to 2 do begin 97 c := Dst^.Planes[ch] - darken; 98 if c < 0 then Dst^.Planes[ch] := 0 99 else Dst^.Planes[ch] := c; 107 100 end 108 101 end … … 129 122 i, X, Y, r, ax, ch, c: Integer; 130 123 HaveWonder: boolean; 131 Line: array [0 .. 1] of ^TLine;124 Line: array [0 .. 1] of PPixel32; 132 125 s: string; 133 126 begin … … 160 153 xm := ClientWidth div 2; 161 154 ym := ClientHeight div 2; 162 for Y := 0 to 127 do 163 begin 164 Line[0] := Offscreen.ScanLine[ym + Y]; 165 Line[1] := Offscreen.ScanLine[ym - 1 - Y]; 166 for X := 0 to 179 do 167 begin 155 for Y := 0 to 127 do begin 156 for X := 0 to 179 do begin 168 157 r := X * X * (32 * 32) + Y * Y * (45 * 45); 169 158 ax := ((1 shl 16 div 32) * 45) * Y; … … 173 162 ((ax < amax1 * X) or (ax > amin3 * X))) then 174 163 for i := 0 to 1 do 175 for ch := 0 to 2 do 176 begin 177 c := Line[i][xm + X][ch] - darken; 164 for ch := 0 to 2 do begin 165 Line[0] := GetBitmapPixelPtr(Offscreen, xm + X, ym + Y); 166 Line[1] := GetBitmapPixelPtr(Offscreen, xm + X, ym - 1 - Y); 167 c := Line[i]^.Planes[ch] - darken; 178 168 if c < 0 then 179 Line[i] [xm + X][ch] := 0169 Line[i]^.Planes[ch] := 0 180 170 else 181 Line[i][xm + X][ch] := c; 182 c := Line[i][xm - 1 - X][ch] - darken; 171 Line[i]^.Planes[ch] := c; 172 Line[0] := GetBitmapPixelPtr(Offscreen, xm - 1 - X, ym + Y); 173 Line[1] := GetBitmapPixelPtr(Offscreen, xm - 1 - X, ym - 1 - Y); 174 c := Line[i]^.Planes[ch] - darken; 183 175 if c < 0 then 184 Line[i] [xm - 1 - X][ch] := 0176 Line[i]^.Planes[ch] := 0 185 177 else 186 Line[i] [xm - 1 - X][ch] := c;178 Line[i]^.Planes[ch] := c; 187 179 end; 188 180 end; -
trunk/ScreenTools.pas
r48 r52 29 29 end; 30 30 PPixel32 = ^TPixel32; 31 32 { TPixelPointer } 33 34 TPixelPointer = record 35 Base: PPixel32; 36 Pixel: PPixel32; 37 Line: PPixel32; 38 BytesPerPixel: Integer; 39 BytesPerLine: Integer; 40 procedure NextLine; 41 procedure NextPixel; 42 procedure SetXY(X, Y: Integer); 43 procedure SetX(X: Integer); 44 procedure Init(Bitmap: TBitmap; X: Integer = 0; Y: Integer = 0); 45 end; 31 46 32 47 {$IFDEF WINDOWS} … … 1488 1503 Reg: TRegistry; 1489 1504 1505 { TPixelPointer } 1506 1507 procedure TPixelPointer.NextLine; inline; 1508 begin 1509 Line := Pointer(Line) + BytesPerLine; 1510 Pixel := Line; 1511 end; 1512 1513 procedure TPixelPointer.NextPixel; inline; 1514 begin 1515 Pixel := Pointer(Pixel) + BytesPerPixel; 1516 end; 1517 1518 procedure TPixelPointer.SetXY(X, Y: Integer); inline; 1519 begin 1520 Line := Pointer(Base) + Y * BytesPerLine; 1521 SetX(X); 1522 end; 1523 1524 procedure TPixelPointer.SetX(X: Integer); inline; 1525 begin 1526 Pixel := Pointer(Line) + X * BytesPerPixel; 1527 end; 1528 1529 procedure TPixelPointer.Init(Bitmap: TBitmap; X: Integer = 0; Y: Integer = 0); inline; 1530 begin 1531 Base := PPixel32(Bitmap.RawImage.Data); 1532 BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 1533 BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 1534 SetXY(X, Y); 1535 end; 1536 1537 procedure UnitInit; 1538 begin 1539 Reg := TRegistry.create; 1540 try 1541 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true); 1542 if Reg.ValueExists('Gamma') then 1543 Gamma := Reg.ReadInteger('Gamma') 1544 else begin 1545 Gamma := 100; 1546 Reg.WriteInteger('Gamma', Gamma); 1547 end; 1548 finally 1549 Reg.Free; 1550 end; 1551 1552 if Gamma <> 100 then 1553 begin 1554 GammaLUT[0] := 0; 1555 for i := 1 to 255 do 1556 begin 1557 p := round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma)); 1558 assert((p >= 0) and (p < 256)); 1559 GammaLUT[i] := p; 1560 end; 1561 end; 1562 1563 {$IFDEF WINDOWS} 1564 EnumDisplaySettings(nil, $FFFFFFFF, StartResolution); 1565 {$ENDIF} 1566 ResolutionChanged := false; 1567 1568 Phrases := TStringTable.create; 1569 Phrases2 := TStringTable.create; 1570 Phrases2FallenBackToEnglish := false; 1571 if FileExists(DataDir + 'Localization' + DirectorySeparator + 'Language.txt') then 1572 begin 1573 Phrases.loadfromfile(DataDir + 'Localization' + DirectorySeparator + ' + Language.txt'); 1574 if FileExists(DataDir + 'Localization' + DirectorySeparator + 'Language2.txt') then 1575 Phrases2.loadfromfile(DataDir + 'Localization' + DirectorySeparator + 'Language2.txt') 1576 else 1577 begin 1578 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1579 Phrases2FallenBackToEnglish := true; 1580 end 1581 end 1582 else 1583 begin 1584 Phrases.loadfromfile(HomeDir + 'Language.txt'); 1585 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1586 end; 1587 1588 Sounds := TStringTable.create; 1589 if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then 1590 begin 1591 Sounds.Free; 1592 Sounds := nil 1593 end; 1594 1595 for section := Low(TFontType) to High(TFontType) do 1596 UniFont[section] := TFont.create; 1597 1598 LogoBuffer := TBitmap.create; 1599 LogoBuffer.PixelFormat := pf24bit; 1600 LogoBuffer.SetSize(wBBook, hBBook); 1601 1602 section := ftNormal; 1603 AssignFile(fontscript, LocalizedFilePath('Fonts.txt')); 1604 try 1605 Reset(fontscript); 1606 while not eof(fontscript) do 1607 begin 1608 ReadLn(fontscript, s); 1609 if s <> '' then 1610 if s[1] = '#' then 1611 begin 1612 s := TrimRight(s); 1613 if s = '#SMALL' then 1614 section := ftSmall 1615 else if s = '#TINY' then 1616 section := ftTiny 1617 else if s = '#CAPTION' then 1618 section := ftCaption 1619 else if s = '#BUTTON' then 1620 section := ftButton 1621 else 1622 section := ftNormal; 1623 end 1624 else 1625 begin 1626 p := pos(',', s); 1627 if p > 0 then 1628 begin 1629 UniFont[section].Name := Trim(copy(s, 1, p - 1)); 1630 size := 0; 1631 for i := p + 1 to Length(s) do 1632 case s[i] of 1633 '0' .. '9': 1634 size := size * 10 + Byte(s[i]) - 48; 1635 'B', 'b': 1636 UniFont[section].Style := UniFont[section].Style + [fsBold]; 1637 'I', 'i': 1638 UniFont[section].Style := UniFont[section].Style + [fsItalic]; 1639 end; 1640 // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs 1641 UniFont[section].size := 1642 round(size * 72 / UniFont[section].PixelsPerInch * 0.8); 1643 end; 1644 end; 1645 end; 1646 CloseFile(fontscript); 1647 except 1648 end; 1649 1650 nGrExt := 0; 1651 HGrSystem := LoadGraphicSet('System'); 1652 HGrSystem2 := LoadGraphicSet('System2'); 1653 Templates := TBitmap.create; 1654 LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator + 'Templates', gfNoGamma); 1655 Templates.PixelFormat := pf24bit; 1656 Colors := TBitmap.create; 1657 LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors'); 1658 Paper := TBitmap.create; 1659 LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper', gfJPG); 1660 BigImp := TBitmap.create; 1661 LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons'); 1662 MainTexture.Image := TBitmap.create; 1663 MainTextureAge := -2; 1664 ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175]; 1665 InitOrnamentDone := false; 1666 GenerateNames := true; 1667 end; 1668 1669 procedure UnitDone; 1670 begin 1671 RestoreResolution; 1672 for i := 0 to nGrExt - 1 do 1673 begin 1674 GrExt[i].Data.Free; 1675 GrExt[i].Mask.Free; 1676 FreeMem(GrExt[i]); 1677 end; 1678 for section := Low(TFontType) to High(TFontType) do 1679 FreeAndNil(UniFont[section]); 1680 FreeAndNil(Phrases); 1681 FreeAndNil(Phrases2); 1682 if Sounds <> nil then 1683 FreeAndNil(Sounds); 1684 FreeAndNil(LogoBuffer); 1685 FreeAndNil(BigImp); 1686 FreeAndNil(Paper); 1687 FreeAndNil(Templates); 1688 FreeAndNil(Colors); 1689 FreeAndNil(MainTexture.Image); 1690 end; 1691 1490 1692 initialization 1491 1693 1492 Reg := TRegistry.create; 1493 try 1494 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true); 1495 if Reg.ValueExists('Gamma') then 1496 Gamma := Reg.ReadInteger('Gamma') 1497 else begin 1498 Gamma := 100; 1499 Reg.WriteInteger('Gamma', Gamma); 1500 end; 1501 finally 1502 Reg.Free; 1503 end; 1504 1505 if Gamma <> 100 then 1506 begin 1507 GammaLUT[0] := 0; 1508 for i := 1 to 255 do 1509 begin 1510 p := round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma)); 1511 assert((p >= 0) and (p < 256)); 1512 GammaLUT[i] := p; 1513 end; 1514 end; 1515 1516 {$IFDEF WINDOWS} 1517 EnumDisplaySettings(nil, $FFFFFFFF, StartResolution); 1518 {$ENDIF} 1519 ResolutionChanged := false; 1520 1521 Phrases := TStringTable.create; 1522 Phrases2 := TStringTable.create; 1523 Phrases2FallenBackToEnglish := false; 1524 if FileExists(DataDir + 'Localization' + DirectorySeparator + 'Language.txt') then 1525 begin 1526 Phrases.loadfromfile(DataDir + 'Localization' + DirectorySeparator + ' + Language.txt'); 1527 if FileExists(DataDir + 'Localization' + DirectorySeparator + 'Language2.txt') then 1528 Phrases2.loadfromfile(DataDir + 'Localization' + DirectorySeparator + 'Language2.txt') 1529 else 1530 begin 1531 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1532 Phrases2FallenBackToEnglish := true; 1533 end 1534 end 1535 else 1536 begin 1537 Phrases.loadfromfile(HomeDir + 'Language.txt'); 1538 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1539 end; 1540 1541 Sounds := TStringTable.create; 1542 if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then 1543 begin 1544 Sounds.Free; 1545 Sounds := nil 1546 end; 1547 1548 for section := Low(TFontType) to High(TFontType) do 1549 UniFont[section] := TFont.create; 1550 1551 LogoBuffer := TBitmap.create; 1552 LogoBuffer.PixelFormat := pf24bit; 1553 LogoBuffer.SetSize(wBBook, hBBook); 1554 1555 section := ftNormal; 1556 AssignFile(fontscript, LocalizedFilePath('Fonts.txt')); 1557 try 1558 Reset(fontscript); 1559 while not eof(fontscript) do 1560 begin 1561 ReadLn(fontscript, s); 1562 if s <> '' then 1563 if s[1] = '#' then 1564 begin 1565 s := TrimRight(s); 1566 if s = '#SMALL' then 1567 section := ftSmall 1568 else if s = '#TINY' then 1569 section := ftTiny 1570 else if s = '#CAPTION' then 1571 section := ftCaption 1572 else if s = '#BUTTON' then 1573 section := ftButton 1574 else 1575 section := ftNormal; 1576 end 1577 else 1578 begin 1579 p := pos(',', s); 1580 if p > 0 then 1581 begin 1582 UniFont[section].Name := Trim(copy(s, 1, p - 1)); 1583 size := 0; 1584 for i := p + 1 to Length(s) do 1585 case s[i] of 1586 '0' .. '9': 1587 size := size * 10 + Byte(s[i]) - 48; 1588 'B', 'b': 1589 UniFont[section].Style := UniFont[section].Style + [fsBold]; 1590 'I', 'i': 1591 UniFont[section].Style := UniFont[section].Style + [fsItalic]; 1592 end; 1593 // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs 1594 UniFont[section].size := 1595 round(size * 72 / UniFont[section].PixelsPerInch * 0.8); 1596 end; 1597 end; 1598 end; 1599 CloseFile(fontscript); 1600 except 1601 end; 1602 1603 nGrExt := 0; 1604 HGrSystem := LoadGraphicSet('System'); 1605 HGrSystem2 := LoadGraphicSet('System2'); 1606 Templates := TBitmap.create; 1607 LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator + 'Templates', gfNoGamma); 1608 Templates.PixelFormat := pf24bit; 1609 Colors := TBitmap.create; 1610 LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors'); 1611 Paper := TBitmap.create; 1612 LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper', gfJPG); 1613 BigImp := TBitmap.create; 1614 LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons'); 1615 MainTexture.Image := TBitmap.create; 1616 MainTextureAge := -2; 1617 ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175]; 1618 InitOrnamentDone := false; 1619 GenerateNames := true; 1694 UnitInit; 1620 1695 1621 1696 finalization 1622 1697 1623 RestoreResolution; 1624 for i := 0 to nGrExt - 1 do 1625 begin 1626 GrExt[i].Data.Free; 1627 GrExt[i].Mask.Free; 1628 FreeMem(GrExt[i]); 1629 end; 1630 for section := Low(TFontType) to High(TFontType) do 1631 UniFont[section].Free; 1632 Phrases.Free; 1633 FreeAndNil(Phrases2); 1634 if Sounds <> nil then 1635 Sounds.Free; 1636 LogoBuffer.Free; 1637 BigImp.Free; 1638 Paper.Free; 1639 Templates.Free; 1640 Colors.Free; 1641 MainTexture.Image.Free; 1698 UnitDone; 1642 1699 1643 1700 end. -
trunk/Start.pas
r46 r52 1034 1034 1035 1035 procedure PaintFileMini; 1036 type1037 TLine = array [0 .. 99999999, 0 .. 2] of Byte;1038 1036 var 1039 1037 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer; 1040 Mini Line, PrevMiniLine: ^TLine;1038 MiniPixel, PrevMiniPixel: PPixel32; 1041 1039 begin 1042 1040 OwnColor := GrExt[HGrSystem].Data.Canvas.Pixels[95, 67]; … … 1047 1045 if MiniMode = mmPicture then 1048 1046 begin 1049 MiniLine := nil;1050 1047 Mini.BeginUpdate; 1051 for y := 0 to MiniHeight - 1 do 1052 begin 1053 PrevMiniLine := MiniLine; 1054 MiniLine := Mini.ScanLine[y]; 1055 for x := 0 to MiniWidth - 1 do 1056 for i := 0 to 1 do 1057 begin 1048 for y := 0 to MiniHeight - 1 do begin 1049 for x := 0 to MiniWidth - 1 do begin 1050 for i := 0 to 1 do begin 1058 1051 xm := (x * 2 + i + y and 1) mod (MiniWidth * 2); 1052 MiniPixel := GetBitmapPixelPtr(Mini, xm, y); 1059 1053 Tile := SaveMap[x + MiniWidth * y]; 1060 1054 if Tile and fTerrain = fUNKNOWN then … … 1066 1060 else 1067 1061 cm := EnemyColor; 1068 if PrevMiniLine <> nil then 1069 begin // 2x2 city dot covers two scanlines 1070 PrevMiniLine[xm, 0] := cm shr 16; 1071 PrevMiniLine[xm, 1] := cm shr 8 and $FF; 1072 PrevMiniLine[xm, 2] := cm and $FF; 1062 if y > 0 then begin 1063 // 2x2 city dot covers two lines 1064 PrevMiniPixel := GetBitmapPixelPtr(Mini, xm, y - 1); 1065 PrevMiniPixel^.B := cm shr 16; 1066 PrevMiniPixel^.G:= cm shr 8 and $FF; 1067 PrevMiniPixel^.R := cm and $FF; 1073 1068 end 1074 1069 end … … 1080 1075 else 1081 1076 cm := MiniColors[Tile and fTerrain, i]; 1082 Mini Line[xm, 0]:= cm shr 16;1083 Mini Line[xm, 1]:= cm shr 8 and $FF;1084 Mini Line[xm, 2]:= cm and $FF;1077 MiniPixel^.B := cm shr 16; 1078 MiniPixel^.G:= cm shr 8 and $FF; 1079 MiniPixel^.R := cm and $FF; 1085 1080 end; 1081 end; 1086 1082 end; 1087 1083 Mini.EndUpdate;
Note:
See TracChangeset
for help on using the changeset viewer.