Changeset 52


Ignore:
Timestamp:
Jan 11, 2017, 10:14:11 PM (8 years ago)
Author:
chronos
Message:
  • Fixed: More Bitmap.ScanLine replaced by direct access to RAWImage data.
Location:
trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Direct.pas

    r38 r52  
    198198  begin
    199199    PostMessage(Handle, WM_GO, 0, 0);
    200     Gone := true
    201   end
     200    Gone := true;
     201  end;
    202202end;
    203203

  • trunk/Integrated.lpi

    r49 r52  
    438438        <StackChecks Value="True"/>
    439439      </Checks>
     440      <VerifyObjMethodCallValidity Value="True"/>
    440441    </CodeGeneration>
    441442    <Linking>

  • trunk/LocalPlayer/CityScreen.pas

    r38 r52  
    431431  end;
    432432
    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)
    445446          ) * 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);
    449451      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;
    458454    Offscreen.EndUpdate;
    459455  end;

  • trunk/LocalPlayer/Help.pas

    r51 r52  
    365365  nHeaven = 28;
    366366  maxsum = 9 * 9 * 255 * 75 div 100;
    367 type
    368   TLine = array [0 .. 649, 0 .. 2] of Byte;
    369367var
    370368  x, y, dx, dy, xSrc, ySrc, sum, xx: integer;
    371369  Heaven: array [0 .. nHeaven] of integer;
    372   PaintLine, CoalLine: ^TLine;
    373   ImpLine: array [-1 .. 1] of ^TLine;
     370  PaintPtr, CoalPtr: TPixelPointer;
     371  ImpPtr: array [-1 .. 1] of TPixelPointer;
    374372begin
    375373  // assume eiffel tower has free common heaven
    … …  
    385383    if (y0 + y >= 0) and (y0 + y < InnerHeight) then
    386384    begin
    387       PaintLine := OffScreen.ScanLine[y0 + y];
    388       CoalLine := Templates.ScanLine[yCoal + y];
     385      PaintPtr.Init(OffScreen, 0, y0 + y);
     386      CoalPtr.Init(Templates, 0, yCoal + y);
    389387      for dy := -1 to 1 do
    390388        if ((y + dy) shr 1 >= 0) and ((y + dy) shr 1 < ySizeBig) then
    391           ImpLine[dy] := BigImp.ScanLine[ySrc + (y + dy) shr 1];
     389          ImpPtr[dy].Init(BigImp, 0, ySrc + (y + dy) shr 1);
    392390      for x := 0 to xSizeBig * 2 - 1 do
    393391      begin
    … …  
    396394        begin
    397395          xx := xSrc + (x + dx) shr 1;
     396          ImpPtr[dy].SetX(xx);
    398397          for dy := -1 to 1 do
    399398            if ((y + dy) shr 1 < 0) or ((y + dy) shr 1 >= ySizeBig) or
    400399              ((x + dx) shr 1 < 0) or ((x + dx) shr 1 >= xSizeBig) or
    401400              ((y + dy) shr 1 < nHeaven) and
    402               (ImpLine[dy, xx, 0] shl 16 + ImpLine[dy, xx, 1] shl 8 +
    403               ImpLine[dy, xx, 2] = Heaven[(y + dy) shr 1]) then
     401              (ImpPtr[dy].Pixel^.B shl 16 + ImpPtr[dy].Pixel^.G shl 8 +
     402              ImpPtr[dy].Pixel^.R = Heaven[(y + dy) shr 1]) then
    404403              sum := sum + 9 * 255
    405404            else
    406               sum := sum + ImpLine[dy, xx, 0] + 5 * ImpLine[dy, xx, 1] + 3 *
    407                 ImpLine[dy, xx, 2];
     405              sum := sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *
     406                ImpPtr[dy].Pixel^.R;
    408407        end;
    409408        if sum < maxsum then
    410409        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;
    415416        end;
    416417      end;

  • trunk/LocalPlayer/TechTree.pas

    r38 r52  
    120120
    121121procedure TTechTreeDlg.FormShow(Sender: TObject);
    122 type
    123   TLine = array [0 .. 9999, 0 .. 2] of Byte;
    124122var
    125123  X, Y, ad, TexWidth, TexHeight: Integer;
    126124  s: string;
    127   SrcLine, DstLine: ^TLine;
     125  SrcPixel, DstPixel: PPixel32;
    128126begin
    129127  if Image = nil then
    … …  
    171169    for Y := 0 to Image.height - 1 do
    172170    begin
    173       SrcLine := Paper.ScanLine[Y mod TexHeight];
    174       DstLine := Image.ScanLine[Y];
    175171      for X := 0 to Image.width - 1 do
    176172      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;
    179181      end;
    180182    end;

  • trunk/LocalPlayer/Term.pas

    r50 r52  
    506506  Sharpen = 80;
    507507type
    508   TLine = array [0 .. 99999, 0 .. 2] of Byte;
    509508  TBuffer = array [0 .. 99999, 0 .. 2] of integer;
    510509var
    … …  
    512511    ydivider: integer;
    513512  resampled: ^TBuffer;
    514   line: ^TLine;
     513  PixelPtr: TPixelPointer;
    515514begin
    516515  nx := BigImp.width div xSizeBig * xSizeSmall;
    … …  
    529528        if ydivider > ySizeSmall then
    530529          ydivider := ySizeSmall;
    531         line := BigImp.ScanLine[cut + iy * ySizeBig + y];
     530        PixelPtr.Init(BigImp, 0, cut + iy * ySizeBig + y);
    532531        for x := 0 to xSizeBig - 1 do
    533532        begin
    … …  
    541540          for ch := 0 to 2 do
    542541          begin
    543             c := line[ix * xSizeBig + x, ch];
     542            PixelPtr.SetX(ix * xSizeBig + x);
     543            c := PixelPtr.Pixel^.Planes[ch];
    544544            inc(resampled[ir, ch], c * xdivider * ydivider);
    545545            if xdivider < xSizeSmall then
    … …  
    558558
    559559  // sharpen resampled icons
    560   SmallImp.width := nx;
    561   SmallImp.height := ny;
     560  SmallImp.SetSize(nx, ny);
    562561  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);
    566564    for x := 0 to nx - 1 do
    567       for ch := 0 to 2 do
    568       begin
     565      for ch := 0 to 2 do begin
    569566        sum := 0;
    570567        Cnt := 0;
    … …  
    581578        sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum *
    582579          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;
    588584      end;
    589585  end;
    … …  
    40664062
    40674063procedure TMainScreen.MiniPaint;
    4068 type
    4069   TLine = array [0 .. 99999999, 0 .. 2] of Byte;
    40704064var
    40714065  uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer;
    4072   PrevMiniLine, MiniLine: ^TLine;
     4066  PrevMiniPixel, MiniPixel: PPixel32;
    40734067begin
    40744068  cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67];
    … …  
    40804074    FillRect(Rect(0, 0, Mini.width, Mini.height));
    40814075  end;
    4082   MiniLine := nil;
    40834076  Mini.BeginUpdate;
    40844077  for y := 0 to G.ly - 1 do
    40854078  begin
    4086     PrevMiniLine := MiniLine;
    4087     MiniLine := Mini.ScanLine[y];
    40884079    for x := 0 to G.lx - 1 do
    40894080      if MyMap[x + G.lx * y] and fTerrain <> fUNKNOWN then
    … …  
    40934084        begin
    40944085          xm := ((x - xwMini) * 2 + i + y and 1 - hw + G.lx * 5) mod (G.lx * 2);
     4086          MiniPixel := GetBitmapPixelPtr(Mini, xm, y);
    40954087          cm := MiniColors[MyMap[Loc] and fTerrain, i];
    40964088          if ClientMode = cEditMap then
    … …  
    41154107            end;
    41164108            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;
    41224115            end
    41234116          end
    … …  
    41484141              cm := Tribe[MyRO.Territory[Loc]].Color;
    41494142          end;
    4150           MiniLine[xm, 0] := cm shr 16;
    4151           MiniLine[xm, 1] := cm shr 8 and $FF;
    4152           MiniLine[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;
    41534146        end;
    41544147      end;

  • trunk/LocalPlayer/Wonders.pas

    r38 r52  
    7878
    7979procedure TWondersDlg.OffscreenPaint;
    80 type
    81   TLine = array [0 .. 649, 0 .. 2] of Byte;
    8280
    8381  procedure DarkIcon(i: Integer);
    8482  var
    8583    X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
    86     Src, Dst: ^TLine;
     84    Src, Dst: PPixel32;
    8785  begin
    8886    x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0];
    … …  
    9088    x0Src := (i mod 7) * xSizeBig;
    9189    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;
    107100        end
    108101      end
    … …  
    129122  i, X, Y, r, ax, ch, c: Integer;
    130123  HaveWonder: boolean;
    131   Line: array [0 .. 1] of ^TLine;
     124  Line: array [0 .. 1] of PPixel32;
    132125  s: string;
    133126begin
    … …  
    160153  xm := ClientWidth div 2;
    161154  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
    168157      r := X * X * (32 * 32) + Y * Y * (45 * 45);
    169158      ax := ((1 shl 16 div 32) * 45) * Y;
    … …  
    173162        ((ax < amax1 * X) or (ax > amin3 * X))) then
    174163        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;
    178168            if c < 0 then
    179               Line[i][xm + X][ch] := 0
     169              Line[i]^.Planes[ch] := 0
    180170            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;
    183175            if c < 0 then
    184               Line[i][xm - 1 - X][ch] := 0
     176              Line[i]^.Planes[ch] := 0
    185177            else
    186               Line[i][xm - 1 - X][ch] := c;
     178              Line[i]^.Planes[ch] := c;
    187179          end;
    188180    end;

  • trunk/ScreenTools.pas

    r48 r52  
    2929  end;
    3030  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;
    3146
    3247{$IFDEF WINDOWS}
    … …  
    14881503      Reg: TRegistry;
    14891504
     1505{ TPixelPointer }
     1506
     1507procedure TPixelPointer.NextLine; inline;
     1508begin
     1509  Line := Pointer(Line) + BytesPerLine;
     1510  Pixel := Line;
     1511end;
     1512
     1513procedure TPixelPointer.NextPixel; inline;
     1514begin
     1515  Pixel := Pointer(Pixel) + BytesPerPixel;
     1516end;
     1517
     1518procedure TPixelPointer.SetXY(X, Y: Integer); inline;
     1519begin
     1520  Line := Pointer(Base) + Y * BytesPerLine;
     1521  SetX(X);
     1522end;
     1523
     1524procedure TPixelPointer.SetX(X: Integer); inline;
     1525begin
     1526  Pixel := Pointer(Line) + X * BytesPerPixel;
     1527end;
     1528
     1529procedure TPixelPointer.Init(Bitmap: TBitmap; X: Integer = 0; Y: Integer = 0); inline;
     1530begin
     1531  Base := PPixel32(Bitmap.RawImage.Data);
     1532  BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
     1533  BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
     1534  SetXY(X, Y);
     1535end;
     1536
     1537procedure UnitInit;
     1538begin
     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;
     1667end;
     1668
     1669procedure UnitDone;
     1670begin
     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);
     1690end;
     1691
    14901692initialization
    14911693
    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;
     1694UnitInit;
    16201695
    16211696finalization
    16221697
    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;
     1698UnitDone;
    16421699
    16431700end.

  • trunk/Start.pas

    r46 r52  
    10341034
    10351035  procedure PaintFileMini;
    1036   type
    1037     TLine = array [0 .. 99999999, 0 .. 2] of Byte;
    10381036  var
    10391037    i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer;
    1040     MiniLine, PrevMiniLine: ^TLine;
     1038    MiniPixel, PrevMiniPixel: PPixel32;
    10411039  begin
    10421040    OwnColor := GrExt[HGrSystem].Data.Canvas.Pixels[95, 67];
    … …  
    10471045    if MiniMode = mmPicture then
    10481046    begin
    1049       MiniLine := nil;
    10501047      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
    10581051            xm := (x * 2 + i + y and 1) mod (MiniWidth * 2);
     1052            MiniPixel := GetBitmapPixelPtr(Mini, xm, y);
    10591053            Tile := SaveMap[x + MiniWidth * y];
    10601054            if Tile and fTerrain = fUNKNOWN then
    … …  
    10661060              else
    10671061                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;
    10731068              end
    10741069            end
    … …  
    10801075            else
    10811076              cm := MiniColors[Tile and fTerrain, i];
    1082             MiniLine[xm, 0] := cm shr 16;
    1083             MiniLine[xm, 1] := cm shr 8 and $FF;
    1084             MiniLine[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;
    10851080          end;
     1081        end;
    10861082      end;
    10871083      Mini.EndUpdate;
Note: See TracChangeset for help on using the changeset viewer.