Changeset 128 for trunk


Ignore:
Timestamp:
May 1, 2018, 3:15:03 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Code cleanup.
  • Modified: Formatted ScreenTools unit.
  • Modified: Base fonts loading split to separate function.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/Components/ScreenTools.pas

    r115 r128  
    1414    Image: TBitmap;
    1515    clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
    16       clPage, clCover: TColor;
    17   end;
    18 
    19   TColor32 = type Cardinal;
     16    clPage, clCover: TColor;
     17  end;
     18
     19  TColor32 = type cardinal;
    2020  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
    2121  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);
     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);
    2727  end;
    2828  PPixel32 = ^TPixel32;
    … …  
    3535    Line: PPixel32;
    3636    RelLine: PPixel32;
    37     BytesPerPixel: Integer;
    38     BytesPerLine: Integer;
     37    BytesPerPixel: integer;
     38    BytesPerLine: integer;
    3939    procedure NextLine; inline; // Move pointer to start of new base line
    4040    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: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0); inline;
     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: TRasterImage; BaseX: integer = 0; BaseY: integer = 0); inline;
    4444  end;
    4545  PPixelPointer = ^TPixelPointer;
    … …  
    5858procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
    5959function HexStringToColor(s: string): integer;
    60 function LoadGraphicFile(bmp: TBitmap; Path: string;
    61   Options: integer = 0): boolean;
     60function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer = 0): boolean;
    6261function LoadGraphicSet(const Name: string): integer;
    6362procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    64 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
    65   yGr: integer); overload;
    66 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    67   yGr: integer); overload;
     63procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     64  overload;
     65procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     66  overload;
    6867procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    6968procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
    70 procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1,
    71   Color2: integer);
    72 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
    73   Color2: integer);
    74 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer; SrcCanvas: TCanvas;
    75   XSrc, YSrc: Integer; Rop: DWORD): Boolean;
     69procedure ImageOp_BCC(dst, Src: TBitmap;
     70  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
     71procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
     72function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
     73  SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    7674procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    7775procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    … …  
    8078procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    8179procedure FrameImage(ca: TCanvas; Src: TBitmap;
    82   x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     80  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    8381procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
    8482procedure InitOrnament;
    8583procedure InitCityMark(const T: TTexture);
    86 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
    87   yOffset: integer);
     84procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
    8885procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    89 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
    90   yOffset: integer; const Texture: TBitmap);
    91 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset,
    92   yOffset: integer; const Texture: TBitmap);
     86procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
     87  const Texture: TBitmap);
     88procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
     89  const Texture: TBitmap);
    9390procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    9491procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
    95 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
    96   s: string);
     92procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    9793procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    9894  x, y: integer; s: string);
    … …  
    105101procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
    106102  const T: TTexture);
    107 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer; Cap: string;
    108   val: integer; const T: TTexture);
     103procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     104  Cap: string; val: integer; const T: TTexture);
    109105procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
    110106  const T: TTexture);
    111 procedure PaintRelativeProgressBar(ca: TCanvas; Kind, x, y, size, pos, Growth,
    112   max: integer; IndicateComplete: boolean; const T: TTexture);
     107procedure PaintRelativeProgressBar(ca: TCanvas;
     108  Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
     109  const T: TTexture);
    113110procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
    114111function SetMainTextureByAge(Age: integer): boolean;
    … …  
    192189    Name: string[31];
    193190    Data, Mask: TBitmap;
    194     pixUsed: array [Byte] of Byte;
     191    pixUsed: array [byte] of byte;
    195192  end;
    196193
    … …  
    210207  MainTexture: TTexture;
    211208  Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
    212   FullScreen, GenerateNames, InitOrnamentDone,
    213     Phrases2FallenBackToEnglish: boolean;
     209  FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean;
    214210
    215211  UniFont: array [TFontType] of TFont;
    … …  
    227223  {$IFDEF WINDOWS}
    228224  StartResolution: TDeviceMode;
     225  ResolutionChanged: boolean;
    229226  {$ENDIF}
    230   ResolutionChanged: boolean;
    231227
    232228  Gamma: integer; // global gamma correction (cent)
    233   GammaLUT: array [0 .. 255] of Byte;
     229  GammaLUT: array [0 .. 255] of byte;
    234230
    235231{$IFDEF WINDOWS}
    … …  
    245241  DevMode.dmBitsPerPel := bpp;
    246242  DevMode.dmDisplayFrequency := freq;
    247   result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL;
    248   if result then
    249     ResolutionChanged := true;
    250 end;
     243  Result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL;
     244  if Result then
     245    ResolutionChanged := True;
     246end;
     247
    251248{$ENDIF}
    252249
    … …  
    256253  if ResolutionChanged then
    257254    ChangeDisplaySettings(StartResolution, 0);
     255  ResolutionChanged := False;
    258256  {$ENDIF}
    259   ResolutionChanged := false;
    260257end;
    261258
    … …  
    270267  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    271268  begin
    272     result := true;
     269    Result := True;
    273270    exit;
    274271  end;
    275272  WAVFileName := Sounds.Lookup(Item, Index);
    276273  assert(WAVFileName[1] <> '[');
    277   result := (WAVFileName <> '') and (WAVFileName[1] <> '[') and
    278     (WAVFileName <> '*');
    279   if result then
     274  Result := (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*');
     275  if Result then
    280276    // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WAVFileName+'.wav'),SND_ASYNC)
    281     PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName)
     277    PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName);
    282278{$ENDIF}
    283279end;
    … …  
    294290  WAVFileName := Sounds.Lookup(Item, Index);
    295291  assert(WAVFileName[1] <> '[');
    296   if (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*')
    297   then
    298     PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName)
     292  if (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*') then
     293    PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName);
    299294{$ENDIF}
    300295end;
    … …  
    316311  i: integer;
    317312begin
    318   result := -4000;
     313  Result := -4000;
    319314  for i := 1 to Turn do
    320     if result < -1000 then
    321       inc(result, 50) // 0..60
    322     else if result < 0 then
    323       inc(result, 25) // 60..100
    324     else if result < 1500 then
    325       inc(result, 20) // 100..175
    326     else if result < 1750 then
    327       inc(result, 10) // 175..200
    328     else if result < 1850 then
    329       inc(result, 2) // 200..250
     315    if Result < -1000 then
     316      Inc(Result, 50) // 0..60
     317    else if Result < 0 then
     318      Inc(Result, 25) // 60..100
     319    else if Result < 1500 then
     320      Inc(Result, 20) // 100..175
     321    else if Result < 1750 then
     322      Inc(Result, 10) // 175..200
     323    else if Result < 1850 then
     324      Inc(Result, 2) // 200..250
    330325    else
    331       inc(result);
     326      Inc(Result);
    332327end;
    333328
    … …  
    340335    year := turntoyear(Turn);
    341336    if year < 0 then
    342       result := Format(Phrases.Lookup('BC'), [-year])
     337      Result := Format(Phrases.Lookup('BC'), [-year])
    343338    else
    344       result := Format(Phrases.Lookup('AD'), [year]);
     339      Result := Format(Phrases.Lookup('AD'), [year]);
    345340  end
    346341  else
    347     result := IntToStr(Turn)
     342    Result := IntToStr(Turn);
    348343end;
    349344
    … …  
    352347  if Movement >= 1000 then
    353348  begin
    354     result := char(48 + Movement div 1000);
     349    Result := char(48 + Movement div 1000);
    355350    Movement := Movement mod 1000;
    356351  end
    357352  else
    358     result := '';
    359   result := result + char(48 + Movement div 100);
     353    Result := '';
     354  Result := Result + char(48 + Movement div 100);
    360355  Movement := Movement mod 100;
    361356  if Movement > 0 then
    362357  begin
    363     result := result + '.' + char(48 + Movement div 10);
     358    Result := Result + '.' + char(48 + Movement div 10);
    364359    Movement := Movement mod 10;
    365360    if Movement > 0 then
    366       result := result + char(48 + Movement);
    367   end
     361      Result := Result + char(48 + Movement);
     362  end;
    368363end;
    369364
    … …  
    371366begin
    372367  RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade,
    373     T.clBevelLight)
     368    T.clBevelLight);
    374369end;
    375370
    … …  
    380375  Frame(ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000);
    381376  RFrame(ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.clBevelShade,
    382     T.clBevelLight)
     377    T.clBevelLight);
    383378end;
    384379
    … …  
    389384    case x of
    390385      '0' .. '9':
    391         result := ord(x) - 48;
     386        Result := Ord(x) - 48;
    392387      'A' .. 'F':
    393         result := ord(x) - 65 + 10;
     388        Result := Ord(x) - 65 + 10;
    394389      'a' .. 'f':
    395         result := ord(x) - 97 + 10;
    396     else
    397       result := 0
    398     end
     390        Result := Ord(x) - 97 + 10;
     391      else
     392        Result := 0
     393    end;
    399394  end;
    400395
    … …  
    404399  s := s + '000000';
    405400  if Gamma = 100 then
    406     result := $10 * HexCharToInt(s[1]) + $1 * HexCharToInt(s[2]) + $1000 *
    407       HexCharToInt(s[3]) + $100 * HexCharToInt(s[4]) + $100000 *
     401    Result := $10 * HexCharToInt(s[1]) + $1 * HexCharToInt(s[2]) +
     402      $1000 * HexCharToInt(s[3]) + $100 * HexCharToInt(s[4]) + $100000 *
    408403      HexCharToInt(s[5]) + $10000 * HexCharToInt(s[6])
    409404  else
    410     result := GammaLUT[$10 * HexCharToInt(s[1]) + HexCharToInt(s[2])] + $100 *
    411       GammaLUT[$10 * HexCharToInt(s[3]) + HexCharToInt(s[4])] + $10000 *
    412       GammaLUT[$10 * HexCharToInt(s[5]) + HexCharToInt(s[6])];
     405    Result := GammaLUT[$10 * HexCharToInt(s[1]) + HexCharToInt(s[2])] +
     406      $100 * GammaLUT[$10 * HexCharToInt(s[3]) + HexCharToInt(s[4])] +
     407      $10000 * GammaLUT[$10 * HexCharToInt(s[5]) + HexCharToInt(s[6])];
    413408end;
    414409
    … …  
    416411var
    417412  PixelPtr: TPixelPointer;
    418   X, Y: Integer;
     413  X, Y: integer;
    419414begin
    420415  Bitmap.BeginUpdate;
    421416  PixelPtr.Init(Bitmap);
    422   for Y := 0 to Bitmap.Height - 1 do begin
    423     for X := 0 to Bitmap.Width - 1 do begin
     417  for Y := 0 to Bitmap.Height - 1 do
     418  begin
     419    for X := 0 to Bitmap.Width - 1 do
     420    begin
    424421      PixelPtr.Pixel^.B := GammaLUT[PixelPtr.Pixel^.B];
    425422      PixelPtr.Pixel^.G := GammaLUT[PixelPtr.Pixel^.G];
    … …  
    435432var
    436433  SrcPtr, DstPtr: TPixelPointer;
    437   X, Y: Integer;
     434  X, Y: integer;
    438435begin
    439436  //Dst.SetSize(Src.Width, Src.Height);
    440437  SrcPtr.Init(Src);
    441438  DstPtr.Init(Dst);
    442   for Y := 0 to Src.Height - 1 do begin
    443     for X := 0 to Src.Width - 1 do begin
     439  for Y := 0 to Src.Height - 1 do
     440  begin
     441    for X := 0 to Src.Width - 1 do
     442    begin
    444443      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    445444      DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
    … …  
    459458begin
    460459  Result := True;
    461   if ExtractFileExt(Path) = '' then Path := Path + '.png';
    462   if ExtractFileExt(Path) = '.jpg' then begin
    463     jtex := tjpegimage.create;
     460  if ExtractFileExt(Path) = '' then
     461    Path := Path + '.png';
     462  if ExtractFileExt(Path) = '.jpg' then
     463  begin
     464    jtex := tjpegimage.Create;
    464465    try
    465466      jtex.LoadFromFile(Path);
    … …  
    467468      Result := False;
    468469    end;
    469     if result then begin
    470       if Options and gfNoGamma = 0 then bmp.PixelFormat := pf24bit;
     470    if Result then
     471    begin
     472      if Options and gfNoGamma = 0 then
     473        bmp.PixelFormat := pf24bit;
    471474      Bmp.SetSize(jtex.Width, jtex.Height);
    472475      Bmp.Canvas.Draw(0, 0, jtex);
    473476    end;
    474477    jtex.Free;
    475   end else
    476   if ExtractFileExt(Path) = '.png' then begin
     478  end
     479  else
     480  if ExtractFileExt(Path) = '.png' then
     481  begin
    477482    Png := TPortableNetworkGraphic.Create;
    478483    Png.PixelFormat := Bmp.PixelFormat;
    … …  
    482487      Result := False;
    483488    end;
    484     if Result then begin
    485       if Options and gfNoGamma = 0 then bmp.PixelFormat := pf24bit;
     489    if Result then
     490    begin
     491      if Options and gfNoGamma = 0 then
     492        bmp.PixelFormat := pf24bit;
    486493      bmp.SetSize(Png.Width, Png.Height);
    487       if (Png.RawImage.Description.Format = ricfGray) then begin
     494      if (Png.RawImage.Description.Format = ricfGray) then
     495      begin
    488496        // LCL doesn't support 8-bit colors properly. Use 24-bit instead.
    489497        Bmp.PixelFormat := pf24bit;
    490         CopyGray8BitTo24bitBitmap(Bmp, Png)
    491       end else Bmp.Canvas.draw(0, 0, Png);
     498        CopyGray8BitTo24bitBitmap(Bmp, Png);
     499      end
     500      else
     501        Bmp.Canvas.draw(0, 0, Png);
    492502    end;
    493503    Png.Free;
    494   end else
    495   if ExtractFileExt(Path) = '.bmp' then begin
     504  end
     505  else
     506  if ExtractFileExt(Path) = '.bmp' then
     507  begin
    496508    try
    497509      bmp.LoadFromFile(Path);
    … …  
    499511      Result := False;
    500512    end;
    501     if Result then begin
     513    if Result then
     514    begin
    502515      if Options and gfNoGamma = 0 then
    503516        bmp.PixelFormat := pf24bit;
    504     end
    505   end else
     517    end;
     518  end
     519  else
    506520    raise Exception.Create('Unsupported image file type ' + ExtractFileExt(Path));
    507521
    508   if not Result then begin
     522  if not Result then
     523  begin
    509524    if Options and gfNoError = 0 then
    510       raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'),
    511         [Path]));
     525      raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [Path]));
    512526  end;
    513527
    … …  
    527541    Inc(I);
    528542  Result := I;
    529   if I = nGrExt then begin
     543  if I = nGrExt then
     544  begin
    530545    Source := TBitmap.Create;
    531546    Source.PixelFormat := pf24bit;
    532547    FileName := HomeDir + 'Graphics' + DirectorySeparator + Name;
    533     if not LoadGraphicFile(Source, FileName) then begin
     548    if not LoadGraphicFile(Source, FileName) then
     549    begin
    534550      Result := -1;
    535551      Exit;
    … …  
    540556
    541557    xmax := Source.Width - 1; // allows 4-byte access even for last pixel
    542     if xmax > 970 then xmax := 970;
     558    if xmax > 970 then
     559      xmax := 970;
    543560
    544561    GrExt[nGrExt].Data := Source;
    545562    GrExt[nGrExt].Data.PixelFormat := pf24bit;
    546     GrExt[nGrExt].Mask := TBitmap.create;
     563    GrExt[nGrExt].Mask := TBitmap.Create;
    547564    GrExt[nGrExt].Mask.PixelFormat := pf24bit;
    548565    GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height);
    … …  
    552569    DataPixel.Init(GrExt[nGrExt].Data);
    553570    MaskPixel.Init(GrExt[nGrExt].Mask);
    554     for y := 0 to Source.Height - 1 do begin
    555       for x := 0 to xmax - 1 do begin
     571    for y := 0 to Source.Height - 1 do
     572    begin
     573      for x := 0 to xmax - 1 do
     574      begin
    556575        OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
    557         if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then begin // transparent
     576        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
     577        begin // transparent
    558578          MaskPixel.Pixel^.ARGB := $FFFFFF;
    559           DataPixel.Pixel^.ARGB := DataPixel.Pixel^.ARGB and $FF000000
    560         end else begin
     579          DataPixel.Pixel^.ARGB := DataPixel.Pixel^.ARGB and $FF000000;
     580        end
     581        else
     582        begin
    561583          MaskPixel.Pixel^.ARGB := $000000; // non-transparent
    562           if Gamma <> 100 then begin
     584          if Gamma <> 100 then
     585          begin
    563586            DataPixel.Pixel^.B := GammaLUT[DataPixel.Pixel^.B];
    564587            DataPixel.Pixel^.G := GammaLUT[DataPixel.Pixel^.G];
    … …  
    576599
    577600    FillChar(GrExt[nGrExt].pixUsed, GrExt[nGrExt].Data.Height div 49 * 10, 0);
    578     inc(nGrExt);
     601    Inc(nGrExt);
    579602  end;
    580603end;
    … …  
    588611procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    589612var
    590   XX, YY: Integer;
     613  XX, YY: integer;
    591614  PixelPtr: TPixelPointer;
    592615begin
    593616  Dst.BeginUpdate;
    594617  PixelPtr.Init(Dst);
    595   for yy := 0 to h - 1 do begin
    596     for xx := 0 to w - 1 do begin
     618  for yy := 0 to h - 1 do
     619  begin
     620    for xx := 0 to w - 1 do
     621    begin
    597622      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    598623      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
    … …  
    609634// X channel = background amp (old Dst content), 128=original brightness
    610635var
    611   X, Y: Integer;
    612   Brightness, Test: Integer;
     636  X, Y: integer;
     637  Brightness, Test: integer;
    613638  PixelSrc: TPixelPointer;
    614639  PixelDst: TPixelPointer;
    615   pf: TPixelFormat;
    616 begin
    617   pf := src.PixelFormat;
     640begin
    618641  //Assert(Src.PixelFormat = pf8bit);
    619642  Assert(dst.PixelFormat = pf24bit);
    … …  
    641664  PixelDst.Init(Dst, xDst, yDst);
    642665  PixelSrc.Init(Src, xSrc, ySrc);
    643   for Y := 0 to h - 1 do begin
    644     for X := 0 to w - 1 do begin
     666  for Y := 0 to h - 1 do
     667  begin
     668    for X := 0 to w - 1 do
     669    begin
    645670      Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color
    646671      test := (PixelDst.Pixel^.R * Brightness) shr 7;
    647       if test >= 256 then PixelDst.Pixel^.R := 255
    648         else PixelDst.Pixel^.R := test; // Red
     672      if test >= 256 then
     673        PixelDst.Pixel^.R := 255
     674      else
     675        PixelDst.Pixel^.R := test; // Red
    649676      test := (PixelDst.Pixel^.G * Brightness) shr 7;
    650       if test >= 256 then PixelDst.Pixel^.G := 255
    651         else PixelDst.Pixel^.G := test; // Green
     677      if test >= 256 then
     678        PixelDst.Pixel^.G := 255
     679      else
     680        PixelDst.Pixel^.G := test; // Green
    652681      test := (PixelDst.Pixel^.B * Brightness) shr 7;
    653       if test >= 256 then PixelDst.Pixel^.R := 255
    654         else PixelDst.Pixel^.B := Test; // Blue
     682      if test >= 256 then
     683        PixelDst.Pixel^.R := 255
     684      else
     685        PixelDst.Pixel^.B := Test; // Blue
    655686      PixelDst.NextPixel;
    656687      PixelSrc.NextPixel;
    … …  
    663694end;
    664695
    665 procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1,
    666   Color2: integer);
     696procedure ImageOp_BCC(dst, Src: TBitmap;
     697  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    667698// Src is template
    668699// B channel = background amp (old Dst content), 128=original brightness
    … …  
    673704  SrcPixel, DstPixel: TPixelPointer;
    674705begin
    675   if xDst < 0 then begin
     706  if xDst < 0 then
     707  begin
    676708    w := w + xDst;
    677709    xSrc := xSrc - xDst;
    678710    xDst := 0;
    679711  end;
    680   if yDst < 0 then begin
     712  if yDst < 0 then
     713  begin
    681714    h := h + yDst;
    682715    ySrc := ySrc - yDst;
    … …  
    694727  SrcPixel.Init(Src, xSrc, ySrc);
    695728  DstPixel.Init(Dst, xDst, yDst);
    696   for iy := 0 to h - 1 do begin
    697     for ix := 0 to w - 1 do begin
     729  for iy := 0 to h - 1 do
     730  begin
     731    for ix := 0 to w - 1 do
     732    begin
    698733      trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
    699734      amp1 := SrcPixel.Pixel^.G * 2;
    700735      amp2 := SrcPixel.Pixel^.R * 2;
    701       if trans <> $FF then begin
    702         Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) * amp2
    703           + ((Color1 shr 16) and $FF) * amp1) div $FF;
    704         if Value < 256 then DstPixel.Pixel^.B := Value
    705           else DstPixel.Pixel^.B := 255;
    706         Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) * amp2
    707           + ((Color1 shr 8) and $FF) * amp1) div $FF;
    708         if Value < 256 then DstPixel.Pixel^.G := Value
    709           else DstPixel.Pixel^.G := 255;
    710         Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * amp2 +
    711           (Color1 and $FF) * amp1) div $FF;
    712         if Value < 256 then DstPixel.Pixel^.R := Value
    713           else DstPixel.Pixel^.R := 255;
     736      if trans <> $FF then
     737      begin
     738        Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) *
     739          amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF;
     740        if Value < 256 then
     741          DstPixel.Pixel^.B := Value
     742        else
     743          DstPixel.Pixel^.B := 255;
     744        Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) *
     745          amp2 + ((Color1 shr 8) and $FF) * amp1) div $FF;
     746        if Value < 256 then
     747          DstPixel.Pixel^.G := Value
     748        else
     749          DstPixel.Pixel^.G := 255;
     750        Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) *
     751          amp2 + (Color1 and $FF) * amp1) div $FF;
     752        if Value < 256 then
     753          DstPixel.Pixel^.R := Value
     754        else
     755          DstPixel.Pixel^.R := 255;
    714756      end;
    715757      SrcPixel.NextPixel;
    … …  
    723765end;
    724766
    725 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
    726   Color2: integer);
     767procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
    727768// Bmp is template
    728769// B channel = Color0 amp, 128=original brightness
    … …  
    737778  h := y + h;
    738779  PixelPtr.Init(Bmp, x, y);
    739   while y < h do begin
    740     for i := 0 to w - 1 do  begin
    741       Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G * (Color1 and $0000FF)
    742         + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
    743       Green := ((PixelPtr.Pixel^.B * ((Color0 shr 8) and $0000FF) + PixelPtr.Pixel^.G *
    744         ((Color1 shr 8) and $0000FF) + PixelPtr.Pixel^.R * ((Color2 shr 8) and
    745         $0000FF)) shr 8) and $ff;
    746       PixelPtr.Pixel^.B := ((PixelPtr.Pixel^.B * ((Color0 shr 16) and $0000FF) + PixelPtr.Pixel^.G *
    747         ((Color1 shr 16) and $0000FF) + PixelPtr.Pixel^.R * ((Color2 shr 16) and $0000FF))
    748         shr 8) and $ff; // Blue
     780  while y < h do
     781  begin
     782    for i := 0 to w - 1 do
     783    begin
     784      Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
     785        (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
     786      Green := ((PixelPtr.Pixel^.B * ((Color0 shr 8) and $0000FF) +
     787        PixelPtr.Pixel^.G * ((Color1 shr 8) and $0000FF) + PixelPtr.Pixel^.R *
     788        ((Color2 shr 8) and $0000FF)) shr 8) and $ff;
     789      PixelPtr.Pixel^.B := ((PixelPtr.Pixel^.B * ((Color0 shr 16) and $0000FF) +
     790        PixelPtr.Pixel^.G * ((Color1 shr 16) and $0000FF) + PixelPtr.Pixel^.R *
     791        ((Color2 shr 16) and $0000FF)) shr 8) and $ff; // Blue
    749792      PixelPtr.Pixel^.G := Green;
    750793      PixelPtr.Pixel^.R := Red;
    751794      PixelPtr.NextPixel;
    752795    end;
    753     inc(y);
     796    Inc(y);
    754797    PixelPtr.NextLine;
    755798  end;
    … …  
    757800end;
    758801
    759 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
    760   yGr: integer);
     802procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    761803begin
    762804  BitBlt(Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    766808end;
    767809
    768 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    769   yGr: integer);
     810procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    770811begin
    771812  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    775816end;
    776817
    777 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer; SrcCanvas: TCanvas; XSrc,
    778   YSrc: Integer; Rop: DWORD): Boolean;
     818function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
     819  SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    779820begin
    780821  Assert(Rop = SRCCOPY);
    … …  
    791832    MoveTo(x0, y);
    792833    LineTo(x1 + 1, y);
    793   end
     834  end;
    794835end;
    795836
    … …  
    806847    Pixels[x0, y + 1] := cl0;
    807848    Pixels[x1, y] := cl1;
    808   end
     849  end;
    809850end;
    810851
    … …  
    820861    LineTo(x1, y1);
    821862    LineTo(x0, y1);
    822   end
     863  end;
    823864end;
    824865
    … …  
    837878    MoveTo(x0 + 1, y1);
    838879    LineTo(x1, y1);
    839   end
     880  end;
    840881end;
    841882
    … …  
    857898    LineTo(x0, y1);
    858899    LineTo(x0 + Corner, y1);
    859   end
     900  end;
    860901end;
    861902
    862903procedure FrameImage(ca: TCanvas; Src: TBitmap;
    863   x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     904  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    864905begin
    865906  if IsControl then
    … …  
    934975        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := light
    935976      else if p = $FF0000 then
    936         GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := shade
    937     end;
    938   InitOrnamentDone := true
     977        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := shade;
     978    end;
     979  InitOrnamentDone := True;
    939980end;
    940981
    … …  
    947988      if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
    948989      begin
    949         intensity := GrExt[HGrSystem].Data.Canvas.Pixels
    950           [66 + x, 47 + y] and $FF;
    951         GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] := T.clMark and
    952           $FF * intensity div $FF + T.clMark shr 8 and
     990        intensity := GrExt[HGrSystem].Data.Canvas.Pixels[66 +
     991          x, 47 + y] and $FF;
     992        GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] :=
     993          T.clMark and $FF * intensity div $FF + T.clMark shr 8 and
    953994          $FF * intensity div $FF shl 8 + T.clMark shr 16 and
    954           $FF * intensity div $FF shl 16
     995          $FF * intensity div $FF shl 16;
    955996      end;
    956997  BitBlt(GrExt[HGrSystem].Mask.Canvas.Handle, 77, 47, 10, 10,
    … …  
    958999end;
    9591000
    960 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
    961   yOffset: integer);
     1001procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
    9621002begin
    9631003  Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
    … …  
    9751015    n := ((hMainTexture div 2) div (y1 - y0)) * 2;
    9761016    while hMainTexture div 2 + (i + 1) * (y1 - y0) > hMainTexture do
    977       dec(i, n);
     1017      Dec(i, n);
    9781018    while hMainTexture div 2 + i * (y1 - y0) < 0 do
    979       inc(i, n);
    980     result := i;
     1019      Inc(i, n);
     1020    Result := i;
    9811021  end;
    9821022
    … …  
    9901030  BitBlt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
    9911031    x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0,
    992     MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 +
    993     band((x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY);
     1032    MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(
     1033    (x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY);
    9941034  for i := 0 to (xm - x0) div wMainTexture - 1 do
    9951035    BitBlt(ca.Handle, xm - (i + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
    996       MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(-i - 1) *
    997       (y1 - y0), SRCCOPY);
    998   BitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) * wMainTexture -
    999     x0, y1 - y0, MainTexture.Image.Canvas.Handle,
     1036      MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 +
     1037      band(-i - 1) * (y1 - y0), SRCCOPY);
     1038  BitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) *
     1039    wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas.Handle,
    10001040    ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0),
    1001     hMainTexture div 2 + band(-(xm - x0) div wMainTexture - 1) *
    1002     (y1 - y0), SRCCOPY);
    1003 end;
    1004 
    1005 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
    1006   yOffset: integer; const Texture: TBitmap);
     1041    hMainTexture div 2 + band(-(xm - x0) div wMainTexture - 1) * (y1 - y0), SRCCOPY);
     1042end;
     1043
     1044procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
     1045  const Texture: TBitmap);
    10071046var
    10081047  x, y, x0cut, y0cut, x1cut, y1cut: integer;
    10091048begin
    10101049  while xOffset < 0 do
    1011     inc(xOffset, Texture.Width);
     1050    Inc(xOffset, Texture.Width);
    10121051  while yOffset < 0 do
    1013     inc(yOffset, Texture.Height);
    1014   for y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1)
    1015     div Texture.Height do
     1052    Inc(yOffset, Texture.Height);
     1053  for y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div
     1054    Texture.Height do
    10161055  begin
    10171056    y0cut := Top + yOffset - y * Texture.Height;
    … …  
    10211060    if y1cut < 0 then
    10221061      y1cut := 0;
    1023     for x := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1)
    1024       div Texture.Width do
     1062    for x := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div
     1063      Texture.Width do
    10251064    begin
    10261065      x0cut := Left + xOffset - x * Texture.Width;
    … …  
    10381077end;
    10391078
    1040 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset,
    1041   yOffset: integer; const Texture: TBitmap);
     1079procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
     1080  const Texture: TBitmap);
    10421081begin
    10431082  FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
    … …  
    10461085procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    10471086begin
    1048   Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth)
    1049     div 2, (hMainTexture - Form.ClientHeight) div 2);
     1087  Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div
     1088    2, (hMainTexture - Form.ClientHeight) div 2);
    10501089end;
    10511090
    … …  
    10581097end;
    10591098
    1060 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
    1061   s: string);
     1099procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    10621100
    10631101  procedure PaintIcon(x, y, Kind: integer);
    … …  
    10741112  shadow: boolean;
    10751113begin
    1076   inc(x);
    1077   inc(y);
    1078   for shadow := true downto false do
     1114  Inc(x);
     1115  Inc(y);
     1116  for shadow := True downto False do
    10791117    with ca do
    10801118      if not shadow or (clBack <> $7F007F) then
    … …  
    10881126        repeat
    10891127          p := pos('%', sp);
    1090           if (p = 0) or (p + 1 > Length(sp)) or
    1091             not(sp[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
    1092           then
     1128          if (p = 0) or (p + 1 > Length(sp)) or not
     1129            (sp[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then
    10931130          begin
    10941131            ca.Textout(xp, y, sp);
    1095             break
     1132            break;
    10961133          end
    10971134          else
    10981135          begin
    10991136            Textout(xp, y, copy(sp, 1, p - 1));
    1100             inc(xp, ca.TextWidth(copy(sp, 1, p - 1)));
     1137            Inc(xp, ca.TextWidth(copy(sp, 1, p - 1)));
    11011138            if not shadow then
    11021139              case sp[p + 1] of
    … …  
    11221159                  PaintIcon(xp + 1, y, 13);
    11231160              end;
    1124             inc(xp, 10);
     1161            Inc(xp, 10);
    11251162            Delete(sp, 1, p + 1);
    11261163          end
    1127           until false;
    1128           dec(x);
    1129           dec(y);
    1130         end
     1164        until False;
     1165        Dec(x);
     1166        Dec(y);
    11311167      end;
    1132 
    1133   function BiColorTextWidth(ca: TCanvas; s: string): integer;
    1134   var
    1135     p: integer;
    1136   begin
    1137     result := 1;
    1138     repeat
    1139       p := pos('%', s);
    1140       if (p = 0) or (p = Length(s)) then
     1168end;
     1169
     1170function BiColorTextWidth(ca: TCanvas; s: string): integer;
     1171var
     1172  p: integer;
     1173begin
     1174  Result := 1;
     1175  repeat
     1176    p := pos('%', s);
     1177    if (p = 0) or (p = Length(s)) then
     1178    begin
     1179      Inc(Result, ca.TextWidth(s));
     1180      break;
     1181    end
     1182    else
     1183    begin
     1184      if not (s[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
     1185      then
     1186        Inc(Result, ca.TextWidth(copy(s, 1, p + 1)))
     1187      else
     1188        Inc(Result, ca.TextWidth(copy(s, 1, p - 1)) + 10);
     1189      Delete(s, 1, p + 1);
     1190    end
     1191  until False;
     1192end;
     1193
     1194procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     1195  x, y: integer; s: string);
     1196begin
     1197  if cl = -2 then
     1198    BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1,
     1199      T.clBevelLight, x, y, s)
     1200  else if cl < 0 then
     1201    BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s)
     1202  else
     1203    BiColorTextOut(ca, cl, T.clTextLight, x, y, s);
     1204end;
     1205
     1206procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     1207begin
     1208  BiColorTextOut(ca, $FFFFFF, $000000, x, y, s);
     1209end;
     1210
     1211procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: integer;
     1212  Brightness: array of integer);
     1213var
     1214  i, r, g, b: integer;
     1215begin
     1216  begin
     1217    for i := 0 to 15 do
     1218    begin // gradient
     1219      r := Color and $FF + Brightness[i];
     1220      if r < 0 then
     1221        r := 0
     1222      else if r >= 256 then
     1223        r := 255;
     1224      g := Color shr 8 and $FF + Brightness[i];
     1225      if g < 0 then
     1226        g := 0
     1227      else if g >= 256 then
     1228        g := 255;
     1229      b := Color shr 16 and $FF + Brightness[i];
     1230      if b < 0 then
     1231        b := 0
     1232      else if b >= 256 then
     1233        b := 255;
     1234      ca.Pen.Color := r + g shl 8 + b shl 16;
     1235      ca.MoveTo(x + dx * i, y + dy * i);
     1236      ca.LineTo(x + dx * i + Width, y + dy * i + Height);
     1237    end;
     1238    ca.Pen.Color := $000000;
     1239    ca.MoveTo(x + 1, y + 16 * dy + Height);
     1240    ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
     1241    ca.LineTo(x + 16 * dx + Width, y);
     1242  end;
     1243end;
     1244
     1245procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     1246const
     1247  Brightness: array [0 .. 15] of integer =
     1248    (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
     1249begin
     1250  Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness);
     1251end;
     1252
     1253procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     1254const
     1255  Brightness: array [0 .. 15] of integer =
     1256    (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
     1257begin
     1258  Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels
     1259    [187, 137 + Kind], Brightness);
     1260end;
     1261
     1262procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     1263const
     1264  Brightness: array [0 .. 15] of integer =
     1265    (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
     1266begin
     1267  Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness);
     1268end;
     1269
     1270procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     1271const
     1272  Brightness: array [0 .. 15] of integer =
     1273    (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
     1274begin
     1275  Gradient(ca, x, y, 1, 0, 0, Height,
     1276    GrExt[HGrSystem].Data.Canvas.Pixels[187, 137 + Kind], Brightness);
     1277end;
     1278
     1279procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;
     1280  val: integer; const T: TTexture);
     1281var
     1282  s: string;
     1283begin
     1284  if val > 0 then
     1285  begin
     1286    DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade,
     1287      T.clBevelLight);
     1288    LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);
     1289    s := IntToStr(val);
     1290    RisedTextOut(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas,
     1291      s), y, s);
     1292  end;
     1293end;
     1294
     1295procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     1296  Cap: string; val: integer; const T: TTexture);
     1297var
     1298  i, sd, ld, cl, xIcon, yIcon: integer;
     1299  s: string;
     1300begin
     1301  // val:=random(40); //!!!
     1302  if val = 0 then
     1303    exit;
     1304  assert(Kind >= 0);
     1305  with dst.Canvas do
     1306  begin
     1307    // xIcon:=x+100;
     1308    // yIcon:=y;
     1309    // DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight);
     1310
     1311    xIcon := x - 5;
     1312    yIcon := y + 15;
     1313    DLine(dst.Canvas, x - 2, xIcon + w + 2, yIcon + 16, T.clBevelShade,
     1314      T.clBevelLight);
     1315
     1316    s := IntToStr(val);
     1317    if val < 0 then
     1318      cl := $0000FF
     1319    else
     1320      cl := -1;
     1321    LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);
     1322    LoweredTextOut(dst.Canvas, cl, T,
     1323      xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);
     1324
     1325    if (Kind = 12) and (val >= 100) then
     1326    begin // science with symbol for 100
     1327      val := val div 10;
     1328      sd := 14 * (val div 10 + val mod 10 - 1);
     1329      if sd = 0 then
     1330        sd := 1;
     1331      if sd < w - 44 then
     1332        ld := sd
     1333      else
     1334        ld := w - 44;
     1335      for i := 0 to val mod 10 - 1 do
    11411336      begin
    1142         inc(result, ca.TextWidth(s));
    1143         break
    1144       end
     1337        BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
     1338          14, GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1339          70 + Kind div 8 * 15, SRCAND);
     1340        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
     1341          14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
     1342      end;
     1343      for i := 0 to val div 10 - 1 do
     1344      begin
     1345        BitBlt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) *
     1346          (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
     1347          GrExt[HGrSystem].Mask.Canvas.Handle, 67 + 7 mod 8 * 15,
     1348          70 + 7 div 8 * 15, SRCAND);
     1349        Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) *
     1350          (14 * ld div sd) + i * (14 * ld div sd), yIcon + 2, 14,
     1351          14, 67 + 7 mod 8 * 15,
     1352          70 + 7 div 8 * 15);
     1353      end;
     1354    end
     1355    else
     1356    begin
     1357      val := abs(val);
     1358      if val mod 10 = 0 then
     1359        sd := 14 * (val div 10 - 1)
    11451360      else
     1361        sd := 10 * (val mod 10 - 1) + 14 * (val div 10);
     1362      if sd = 0 then
     1363        sd := 1;
     1364      if sd < w - 44 then
     1365        ld := sd
     1366      else
     1367        ld := w - 44;
     1368      for i := 0 to val div 10 - 1 do
    11461369      begin
    1147         if not(s[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
    1148         then
    1149           inc(result, ca.TextWidth(copy(s, 1, p + 1)))
    1150         else
    1151           inc(result, ca.TextWidth(copy(s, 1, p - 1)) + 10);
    1152         Delete(s, 1, p + 1);
    1153       end
    1154       until false;
    1155     end;
    1156 
    1157     procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    1158       x, y: integer; s: string);
    1159     begin
    1160       if cl = -2 then
    1161         BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1,
    1162           T.clBevelLight, x, y, s)
    1163       else if cl < 0 then
    1164         BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s)
    1165       else
    1166         BiColorTextOut(ca, cl, T.clTextLight, x, y, s)
    1167     end;
    1168 
    1169     procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
    1170     begin
    1171       BiColorTextOut(ca, $FFFFFF, $000000, x, y, s)
    1172     end;
    1173 
    1174     procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: integer;
    1175       Brightness: array of integer);
    1176     var
    1177       i, r, g, b: integer;
    1178     begin
     1370        BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
     1371          GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1372          70 + Kind div 8 * 15, SRCAND);
     1373        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
     1374          14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
     1375      end;
     1376      for i := 0 to val mod 10 - 1 do
    11791377      begin
    1180         for i := 0 to 15 do
    1181         begin // gradient
    1182           r := Color and $FF + Brightness[i];
    1183           if r < 0 then
    1184             r := 0
    1185           else if r >= 256 then
    1186             r := 255;
    1187           g := Color shr 8 and $FF + Brightness[i];
    1188           if g < 0 then
    1189             g := 0
    1190           else if g >= 256 then
    1191             g := 255;
    1192           b := Color shr 16 and $FF + Brightness[i];
    1193           if b < 0 then
    1194             b := 0
    1195           else if b >= 256 then
    1196             b := 255;
    1197           ca.Pen.Color := r + g shl 8 + b shl 16;
    1198           ca.MoveTo(x + dx * i, y + dy * i);
    1199           ca.LineTo(x + dx * i + Width, y + dy * i + Height);
    1200         end;
    1201         ca.Pen.Color := $000000;
    1202         ca.MoveTo(x + 1, y + 16 * dy + Height);
    1203         ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
    1204         ca.LineTo(x + 16 * dx + Width, y);
    1205       end
    1206     end;
    1207 
    1208     procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
    1209     const
    1210       Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12,
    1211         -16, -20, -24, -28, -32, -36, -40, -44);
    1212     begin
    1213       Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness)
    1214     end;
    1215 
    1216     procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
    1217     const
    1218       Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8,
    1219         -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
    1220     begin
    1221       Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels
    1222         [187, 137 + Kind], Brightness)
    1223     end;
    1224 
    1225     procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
    1226     const
    1227       Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12,
    1228         -16, -20, -24, -28, -32, -36, -40, -44);
    1229     begin
    1230       Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness)
    1231     end;
    1232 
    1233     procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
    1234     const
    1235       Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8,
    1236         -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
    1237     begin
    1238       Gradient(ca, x, y, 1, 0, 0, Height, GrExt[HGrSystem].Data.Canvas.Pixels
    1239         [187, 137 + Kind], Brightness)
    1240     end;
    1241 
    1242     procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
    1243       const T: TTexture);
    1244     var
    1245       s: string;
    1246     begin
    1247       if val > 0 then
    1248       begin
    1249         DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade,
    1250           T.clBevelLight);
    1251         LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);
    1252         s := IntToStr(val);
    1253         RisedTextOut(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas,
    1254           s), y, s);
    1255       end
    1256     end;
    1257 
    1258     procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
    1259       Cap: string; val: integer; const T: TTexture);
    1260     var
    1261       i, sd, ld, cl, xIcon, yIcon: integer;
    1262       s: string;
    1263     begin
    1264       // val:=random(40); //!!!
    1265       if val = 0 then
    1266         exit;
    1267       assert(Kind >= 0);
    1268       with dst.Canvas do
    1269       begin
    1270         // xIcon:=x+100;
    1271         // yIcon:=y;
    1272         // DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight);
    1273 
    1274         xIcon := x - 5;
    1275         yIcon := y + 15;
    1276         DLine(dst.Canvas, x - 2, xIcon + w + 2, yIcon + 16, T.clBevelShade,
    1277           T.clBevelLight);
    1278 
    1279         s := IntToStr(val);
    1280         if val < 0 then
    1281           cl := $0000FF
    1282         else
    1283           cl := -1;
    1284         LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);
    1285         LoweredTextOut(dst.Canvas, cl, T,
    1286           xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);
    1287 
    1288         if (Kind = 12) and (val >= 100) then
    1289         begin // science with symbol for 100
    1290           val := val div 10;
    1291           sd := 14 * (val div 10 + val mod 10 - 1);
    1292           if sd = 0 then
    1293             sd := 1;
    1294           if sd < w - 44 then
    1295             ld := sd
    1296           else
    1297             ld := w - 44;
    1298           for i := 0 to val mod 10 - 1 do
    1299           begin
    1300             BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
    1301               14, GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
    1302               70 + Kind div 8 * 15, SRCAND);
    1303             Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    1304               14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
    1305           end;
    1306           for i := 0 to val div 10 - 1 do
    1307           begin
    1308             BitBlt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) *
    1309               (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1310               GrExt[HGrSystem].Mask.Canvas.Handle, 67 + 7 mod 8 * 15,
    1311               70 + 7 div 8 * 15, SRCAND);
    1312             Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * (14 * ld div sd) +
    1313               i * (14 * ld div sd), yIcon + 2, 14, 14, 67 + 7 mod 8 * 15,
    1314               70 + 7 div 8 * 15);
    1315           end;
    1316         end
    1317         else
    1318         begin
    1319           val := abs(val);
    1320           if val mod 10 = 0 then
    1321             sd := 14 * (val div 10 - 1)
    1322           else
    1323             sd := 10 * (val mod 10 - 1) + 14 * (val div 10);
    1324           if sd = 0 then
    1325             sd := 1;
    1326           if sd < w - 44 then
    1327             ld := sd
    1328           else
    1329             ld := w - 44;
    1330           for i := 0 to val div 10 - 1 do
    1331           begin
    1332             BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1333               GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
    1334               70 + Kind div 8 * 15, SRCAND);
    1335             Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    1336               14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
    1337           end;
    1338           for i := 0 to val mod 10 - 1 do
    1339           begin
    1340             BitBlt(dst.Canvas.Handle, xIcon + 4 + (val div 10) *
    1341               (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
    1342               GrExt[HGrSystem].Mask.Canvas.Handle, 66 + Kind mod 11 * 11,
    1343               115 + Kind div 11 * 11, SRCAND);
    1344             Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * (14 * ld div sd) +
    1345               i * (10 * ld div sd), yIcon + 6, 10, 10, 66 + Kind mod 11 * 11,
    1346               115 + Kind div 11 * 11)
    1347           end;
    1348         end
    1349       end
    1350     end; // CountBar
    1351 
    1352     procedure PaintProgressBar(ca: TCanvas;
    1353       Kind, x, y, pos, Growth, max: integer; const T: TTexture);
    1354     var
    1355       i: integer;
    1356     begin
    1357       if pos > max then
    1358         pos := max;
    1359       if Growth < 0 then
    1360       begin
    1361         pos := pos + Growth;
    1362         if pos < 0 then
    1363         begin
    1364           Growth := Growth - pos;
    1365           pos := 0
    1366         end
    1367       end
    1368       else if pos + Growth > max then
    1369         Growth := max - pos;
    1370       Frame(ca, x - 1, y - 1, x + max, y + 7, $000000, $000000);
    1371       RFrame(ca, x - 2, y - 2, x + max + 1, y + 8, T.clBevelShade,
    1372         T.clBevelLight);
    1373       with ca do
    1374       begin
    1375         for i := 0 to pos div 8 - 1 do
    1376           BitBlt(Handle, x + i * 8, y, 8, 7,
    1377             GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
    1378         BitBlt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
    1379           GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
    1380         if Growth > 0 then
    1381         begin
    1382           for i := 0 to Growth div 8 - 1 do
    1383             BitBlt(Handle, x + pos + i * 8, y, 8, 7,
    1384               GrExt[HGrSystem].Data.Canvas.Handle, 112, 9 + 8 * Kind, SRCCOPY);
    1385           BitBlt(Handle, x + pos + 8 * (Growth div 8), y,
    1386             Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas.Handle,
    1387             112, 9 + 8 * Kind, SRCCOPY);
    1388         end
    1389         else if Growth < 0 then
    1390         begin
    1391           for i := 0 to -Growth div 8 - 1 do
    1392             BitBlt(Handle, x + pos + i * 8, y, 8, 7,
    1393               GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
    1394           BitBlt(Handle, x + pos + 8 * (-Growth div 8), y,
    1395             -Growth - 8 * (-Growth div 8), 7,
    1396             GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
    1397         end;
    1398         Brush.Color := $000000;
    1399         FillRect(Rect(x + pos + abs(Growth), y, x + max, y + 7));
    1400         Brush.Style := bsClear;
    1401       end
    1402     end;
    1403 
    1404     // pos and growth are relative to max, set size independent
    1405     procedure PaintRelativeProgressBar(ca: TCanvas;
    1406       Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
    1407       const T: TTexture);
    1408     begin
    1409       if Growth > 0 then
    1410         PaintProgressBar(ca, Kind, x, y, pos * size div max,
    1411           (Growth * size + max div 2) div max, size, T)
    1412       else
    1413         PaintProgressBar(ca, Kind, x, y, pos * size div max,
    1414           (Growth * size - max div 2) div max, size, T);
    1415       if IndicateComplete and (pos + Growth >= max) then
    1416         Sprite(ca, HGrSystem, x + size - 10, y - 7, 23, 16, 1, 129);
    1417     end;
    1418 
    1419     procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
    1420     begin
    1421       BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
    1422         y, SRCCOPY);
    1423       ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
    1424         clLight, clShade);
    1425       BitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0,
    1426         0, SRCCOPY);
    1427     end;
    1428 
    1429     function SetMainTextureByAge(Age: integer): boolean;
    1430     begin
    1431       if Age <> MainTextureAge then
    1432         with MainTexture do
    1433         begin
    1434           MainTextureAge := Age;
    1435           LoadGraphicFile(Image, HomeDir + 'Graphics' + DirectorySeparator + 'Texture' +
    1436             IntToStr(Age + 1) + '.jpg');
    1437           clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
    1438           clBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
    1439           clTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
    1440           clTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
    1441           clLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
    1442           clMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
    1443           clPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
    1444           clCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
    1445           result := true
    1446         end
    1447       else
    1448         result := false
    1449     end;
    1450 
    1451     var
    1452       i, p, size: integer;
    1453       s: string;
    1454       fontscript: TextFile;
    1455       section: TFontType;
    1456       Reg: TRegistry;
     1378        BitBlt(dst.Canvas.Handle, xIcon + 4 + (val div 10) *
     1379          (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
     1380          GrExt[HGrSystem].Mask.Canvas.Handle, 66 + Kind mod 11 * 11,
     1381          115 + Kind div 11 * 11, SRCAND);
     1382        Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) *
     1383          (14 * ld div sd) + i * (10 * ld div sd), yIcon + 6, 10,
     1384          10, 66 + Kind mod 11 * 11,
     1385          115 + Kind div 11 * 11);
     1386      end;
     1387    end;
     1388  end;
     1389end; // CountBar
     1390
     1391procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     1392  const T: TTexture);
     1393var
     1394  i: integer;
     1395begin
     1396  if pos > max then
     1397    pos := max;
     1398  if Growth < 0 then
     1399  begin
     1400    pos := pos + Growth;
     1401    if pos < 0 then
     1402    begin
     1403      Growth := Growth - pos;
     1404      pos := 0;
     1405    end;
     1406  end
     1407  else if pos + Growth > max then
     1408    Growth := max - pos;
     1409  Frame(ca, x - 1, y - 1, x + max, y + 7, $000000, $000000);
     1410  RFrame(ca, x - 2, y - 2, x + max + 1, y + 8, T.clBevelShade,
     1411    T.clBevelLight);
     1412  with ca do
     1413  begin
     1414    for i := 0 to pos div 8 - 1 do
     1415      BitBlt(Handle, x + i * 8, y, 8, 7,
     1416        GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
     1417    BitBlt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
     1418      GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
     1419    if Growth > 0 then
     1420    begin
     1421      for i := 0 to Growth div 8 - 1 do
     1422        BitBlt(Handle, x + pos + i * 8, y, 8, 7,
     1423          GrExt[HGrSystem].Data.Canvas.Handle, 112, 9 + 8 * Kind, SRCCOPY);
     1424      BitBlt(Handle, x + pos + 8 * (Growth div 8), y,
     1425        Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas.Handle,
     1426        112, 9 + 8 * Kind, SRCCOPY);
     1427    end
     1428    else if Growth < 0 then
     1429    begin
     1430      for i := 0 to -Growth div 8 - 1 do
     1431        BitBlt(Handle, x + pos + i * 8, y, 8, 7,
     1432          GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
     1433      BitBlt(Handle, x + pos + 8 * (-Growth div 8), y, -Growth -
     1434        8 * (-Growth div 8), 7,
     1435        GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
     1436    end;
     1437    Brush.Color := $000000;
     1438    FillRect(Rect(x + pos + abs(Growth), y, x + max, y + 7));
     1439    Brush.Style := bsClear;
     1440  end;
     1441end;
     1442
     1443// pos and growth are relative to max, set size independent
     1444procedure PaintRelativeProgressBar(ca: TCanvas;
     1445  Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
     1446  const T: TTexture);
     1447begin
     1448  if Growth > 0 then
     1449    PaintProgressBar(ca, Kind, x, y, pos * size div max,
     1450      (Growth * size + max div 2) div max, size, T)
     1451  else
     1452    PaintProgressBar(ca, Kind, x, y, pos * size div max,
     1453      (Growth * size - max div 2) div max, size, T);
     1454  if IndicateComplete and (pos + Growth >= max) then
     1455    Sprite(ca, HGrSystem, x + size - 10, y - 7, 23, 16, 1, 129);
     1456end;
     1457
     1458procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     1459begin
     1460  BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
     1461    y, SRCCOPY);
     1462  ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
     1463    clLight, clShade);
     1464  BitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0,
     1465    0, SRCCOPY);
     1466end;
     1467
     1468function SetMainTextureByAge(Age: integer): boolean;
     1469begin
     1470  if Age <> MainTextureAge then
     1471    with MainTexture do
     1472    begin
     1473      MainTextureAge := Age;
     1474      LoadGraphicFile(Image, HomeDir + 'Graphics' + DirectorySeparator +
     1475        'Texture' + IntToStr(Age + 1) + '.jpg');
     1476      clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
     1477      clBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
     1478      clTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
     1479      clTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
     1480      clLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
     1481      clMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
     1482      clPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
     1483      clCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
     1484      Result := True;
     1485    end
     1486  else
     1487    Result := False;
     1488end;
    14571489
    14581490{ TPixelPointer }
    … …  
    14691501end;
    14701502
    1471 procedure TPixelPointer.SetXY(X, Y: Integer); inline;
     1503procedure TPixelPointer.SetXY(X, Y: integer); inline;
    14721504begin
    14731505  Line := Pointer(Base) + Y * BytesPerLine;
    … …  
    14751507end;
    14761508
    1477 procedure TPixelPointer.SetX(X: Integer); inline;
     1509procedure TPixelPointer.SetX(X: integer); inline;
    14781510begin
    14791511  Pixel := Pointer(Line) + X * BytesPerPixel;
    14801512end;
    14811513
    1482 procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0); inline;
     1514procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: integer = 0;
     1515  BaseY: integer = 0); inline;
    14831516begin
    14841517  BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
    … …  
    14901523procedure LoadPhrases;
    14911524begin
    1492   if Phrases = nil then Phrases := TStringTable.create;
    1493   if Phrases2 = nil then Phrases2 := TStringTable.create;
    1494   Phrases2FallenBackToEnglish := false;
     1525  if Phrases = nil then
     1526    Phrases := TStringTable.Create;
     1527  if Phrases2 = nil then
     1528    Phrases2 := TStringTable.Create;
     1529  Phrases2FallenBackToEnglish := False;
    14951530  if FileExists(LocalizedFilePath('Language.txt')) then
    14961531  begin
    … …  
    15011536    begin
    15021537      Phrases2.loadfromfile(HomeDir + 'Language2.txt');
    1503       Phrases2FallenBackToEnglish := true;
    1504     end
     1538      Phrases2FallenBackToEnglish := True;
     1539    end;
    15051540  end
    15061541  else
    … …  
    15101545  end;
    15111546
    1512   if Sounds = nil then Sounds := TStringTable.create;
     1547  if Sounds = nil then
     1548    Sounds := TStringTable.Create;
    15131549  if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
    15141550  begin
    … …  
    15171553end;
    15181554
    1519 procedure UnitInit;
    1520 begin
    1521   Reg := TRegistry.Create;
    1522   with Reg do
    1523   try
    1524     OpenKey(AppRegistryKey, True);
    1525     if ValueExists('Gamma') then
    1526       Gamma := ReadInteger('Gamma')
    1527       else begin
    1528         Gamma := 100;
    1529         WriteInteger('Gamma', Gamma);
    1530       end;
    1531     if ValueExists('Locale') then LocaleCode := ReadString('Locale')
    1532       else LocaleCode := '';
    1533   finally
    1534     Free;
    1535   end;
    1536 
    1537   if Gamma <> 100 then
    1538   begin
    1539     GammaLUT[0] := 0;
    1540     for i := 1 to 255 do
    1541     begin
    1542       p := round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma));
    1543       assert((p >= 0) and (p < 256));
    1544       GammaLUT[i] := p;
    1545     end;
    1546   end;
    1547 
    1548   {$IFDEF WINDOWS}
    1549   EnumDisplaySettings(nil, $FFFFFFFF, StartResolution);
    1550   {$ENDIF}
    1551   ResolutionChanged := false;
    1552 
    1553   LoadPhrases;
    1554 
    1555   for section := Low(TFontType) to High(TFontType) do
    1556     UniFont[section] := TFont.create;
    1557 
    1558   LogoBuffer := TBitmap.create;
    1559   LogoBuffer.PixelFormat := pf24bit;
    1560   LogoBuffer.SetSize(wBBook, hBBook);
    1561 
    1562   section := ftNormal;
    1563   AssignFile(fontscript, LocalizedFilePath('Fonts.txt'));
     1555procedure LoadFonts;
     1556var
     1557  Section: TFontType;
     1558  FontScript: TextFile;
     1559  Size: integer;
     1560  S: string;
     1561  I: integer;
     1562  P: integer;
     1563begin
     1564  for Section := Low(TFontType) to High(TFontType) do
     1565    UniFont[Section] := TFont.Create;
     1566
     1567  Section := ftNormal;
     1568  AssignFile(FontScript, LocalizedFilePath('Fonts.txt'));
    15641569  try
    15651570    Reset(fontscript);
    1566     while not eof(fontscript) do
    1567     begin
    1568       ReadLn(fontscript, s);
     1571    while not EOF(FontScript) do
     1572    begin
     1573      ReadLn(FontScript, s);
    15691574      if s <> '' then
    15701575        if s[1] = '#' then
    … …  
    15721577          s := TrimRight(s);
    15731578          if s = '#SMALL' then
    1574             section := ftSmall
     1579            Section := ftSmall
    15751580          else if s = '#TINY' then
    1576             section := ftTiny
     1581            Section := ftTiny
    15771582          else if s = '#CAPTION' then
    1578             section := ftCaption
     1583            Section := ftCaption
    15791584          else if s = '#BUTTON' then
    1580             section := ftButton
     1585            Section := ftButton
    15811586          else
    1582             section := ftNormal;
     1587            Section := ftNormal;
    15831588        end
    15841589        else
    15851590        begin
    1586           p := pos(',', s);
     1591          p := Pos(',', s);
    15871592          if p > 0 then
    15881593          begin
    1589             UniFont[section].Name := Trim(copy(s, 1, p - 1));
    1590             size := 0;
     1594            UniFont[section].Name := Trim(Copy(s, 1, p - 1));
     1595            Size := 0;
    15911596            for i := p + 1 to Length(s) do
    15921597              case s[i] of
    15931598                '0' .. '9':
    1594                   size := size * 10 + Byte(s[i]) - 48;
     1599                  Size := Size * 10 + Byte(s[i]) - 48;
    15951600                'B', 'b':
    15961601                  UniFont[section].Style := UniFont[section].Style + [fsBold];
    … …  
    15991604              end;
    16001605            // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
    1601             UniFont[section].size :=
    1602               round(size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
     1606            UniFont[section].Size :=
     1607              Round(size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
    16031608          end;
    16041609        end;
    16051610    end;
    1606     CloseFile(fontscript);
     1611    CloseFile(FontScript);
    16071612  except
    16081613  end;
     1614end;
     1615
     1616procedure ReleaseFonts;
     1617var
     1618  Section: TFontType;
     1619begin
     1620  for Section := Low(TFontType) to High(TFontType) do
     1621    FreeAndNil(UniFont[section]);
     1622end;
     1623
     1624procedure UnitInit;
     1625var
     1626  I: integer;
     1627  P: integer;
     1628  Reg: TRegistry;
     1629begin
     1630  Reg := TRegistry.Create;
     1631  with Reg do
     1632    try
     1633      OpenKey(AppRegistryKey, True);
     1634      if ValueExists('Gamma') then
     1635        Gamma := ReadInteger('Gamma')
     1636      else
     1637      begin
     1638        Gamma := 100;
     1639        WriteInteger('Gamma', Gamma);
     1640      end;
     1641      if ValueExists('Locale') then
     1642        LocaleCode := ReadString('Locale')
     1643      else
     1644        LocaleCode := '';
     1645    finally
     1646      Free;
     1647    end;
     1648
     1649  if Gamma <> 100 then
     1650  begin
     1651    GammaLUT[0] := 0;
     1652    for i := 1 to 255 do
     1653    begin
     1654      p := Round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma));
     1655      Assert((p >= 0) and (p < 256));
     1656      GammaLUT[i] := p;
     1657    end;
     1658  end;
     1659
     1660  {$IFDEF WINDOWS}
     1661  EnumDisplaySettings(nil, $FFFFFFFF, StartResolution);
     1662  ResolutionChanged := False;
     1663  {$ENDIF}
     1664
     1665  LoadPhrases;
     1666
     1667  LogoBuffer := TBitmap.Create;
     1668  LogoBuffer.PixelFormat := pf24bit;
     1669  LogoBuffer.SetSize(wBBook, hBBook);
     1670
     1671  LoadFonts;
    16091672
    16101673  nGrExt := 0;
    … …  
    16131676  Templates := TBitmap.Create;
    16141677  Templates.PixelFormat := pf24bit;
    1615   LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator + 'Templates.png', gfNoGamma);
     1678  LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator +
     1679    'Templates.png', gfNoGamma);
    16161680  Colors := TBitmap.Create;
    16171681  Colors.PixelFormat := pf24bit;
    … …  
    16331697var
    16341698  Reg: TRegistry;
    1635 begin
    1636   Reg := TRegistry.create;
     1699  I: integer;
     1700begin
     1701  Reg := TRegistry.Create;
    16371702  with Reg do
    1638   try
    1639     OpenKey(AppRegistryKey, True);
    1640     WriteString('Locale', LocaleCode);
    1641     WriteInteger('Gamma', Gamma);
    1642   finally
    1643     Free;
    1644   end;
     1703    try
     1704      OpenKey(AppRegistryKey, True);
     1705      WriteString('Locale', LocaleCode);
     1706      WriteInteger('Gamma', Gamma);
     1707    finally
     1708      Free;
     1709    end;
    16451710
    16461711  RestoreResolution;
    1647   for i := 0 to nGrExt - 1 do
    1648   begin
    1649     GrExt[i].Data.Free;
    1650     GrExt[i].Mask.Free;
    1651     FreeMem(GrExt[i]);
    1652   end;
    1653   for section := Low(TFontType) to High(TFontType) do
    1654     FreeAndNil(UniFont[section]);
     1712  for I := 0 to nGrExt - 1 do
     1713  begin
     1714    GrExt[I].Data.Free;
     1715    GrExt[I].Mask.Free;
     1716    FreeMem(GrExt[I]);
     1717  end;
     1718
     1719  ReleaseFonts;
     1720
    16551721  FreeAndNil(Phrases);
    16561722  FreeAndNil(Phrases2);
    … …  
    16651731end;
    16661732
     1733
    16671734initialization
    16681735
    1669 //UnitInit;
     1736  //UnitInit;
    16701737
    16711738finalization
    16721739
    1673 //UnitDone;
     1740  //UnitDone;
    16741741
    16751742end.

  • trunk/Components/StringTables.pas

    r111 r128  
    4646function TStringTable.LoadFromFile(const FileName: String): boolean;
    4747begin
    48   Lines.LoadFromFile(FileName);
     48  Result := True;
     49  Lines.Clear;
     50  try
     51    Lines.LoadFromFile(FileName);
     52  except
     53    Result := False;
     54  end;
    4955end;
    5056

  • trunk/Start.pas

    r124 r128  
    365365    for y := 0 to 1 do
    366366      MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y];
    367   InitButtons();
     367  InitButtons;
    368368
    369369  bixView[0] := bixTerm;
Note: See TracChangeset for help on using the changeset viewer.