Changeset 6 for trunk/ScreenTools.pas


Ignore:
Timestamp:
Jan 7, 2017, 11:32:14 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Formated all project source files using Delphi formatter as original indentation and other formatting was really bad.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ScreenTools.pas

    r2 r6  
    11{$INCLUDE switches}
    2 
    32unit ScreenTools;
    43
    … …  
    87  StringTables,
    98
    10 
    11   Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus;
     9  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus;
    1210
    1311type
    14 TTexture=record
    15   Image: TBitmap;
    16   clBevelLight,clBevelShade,clTextLight,clTextShade,clLitText,clMark,clPage,clCover: TColor
    17   end;
    18 
    19 function ChangeResolution(x,y,bpp,freq: integer): boolean;
    20 procedure RestoreResolution;
    21 function Play(Item: string; Index: integer =-1): boolean;
    22 procedure PreparePlay(Item: string; Index: integer =-1);
    23 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
    24 function turntoyear(Turn: integer): integer;
    25 function TurnToString(Turn: integer): string;
    26 function MovementToString(Movement: integer): string;
    27 procedure BtnFrame(ca:TCanvas;p:TRect;const T: TTexture);
    28 procedure EditFrame(ca:TCanvas;p:TRect;const T: TTexture);
    29 function HexStringToColor(s: string): integer;
    30 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer= 0): boolean;
    31 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; Options: integer= 0): boolean;
    32 function LoadGraphicSet(Name: string): integer;
    33 procedure Dump(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr:integer);
    34 procedure Sprite(Canvas: TCanvas; HGr,xDst,yDst,Width,Height,xGr,yGr: integer); overload;
    35 procedure Sprite(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr:integer); overload;
    36 procedure MakeBlue(Dst: TBitmap; x,y,w,h: integer);
    37 procedure ImageOp_B(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h: integer);
    38 procedure ImageOp_BCC(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h,Color1,Color2: integer);
    39 procedure ImageOp_CCC(Bmp: TBitmap; x,y,w,h,Color0,Color1,Color2: integer);
    40 procedure SLine(ca: TCanvas; x0,x1,y: integer; cl: TColor);
    41 procedure DLine(ca: TCanvas; x0,x1,y: integer; cl0,cl1: TColor);
    42 procedure Frame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor);
    43 procedure RFrame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor);
    44 procedure CFrame(ca: TCanvas; x0,y0,x1,y1,Corner: integer; cl: TColor);
    45 procedure FrameImage(ca: TCanvas; src:TBitmap; x,y,width,height,xSrc,ySrc: integer; IsControl: boolean = false);
    46 procedure GlowFrame(dst: TBitmap; x0,y0,width,height: integer; cl: TColor);
    47 procedure InitOrnament;
    48 procedure InitCityMark(const T: TTexture);
    49 procedure Fill(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer);
    50 procedure FillLarge(ca: TCanvas; x0,y0,x1,y1,xm: integer);
    51 procedure FillSeamless(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer;const Texture: TBitmap);
    52 procedure FillRectSeamless(ca: TCanvas;x0,y0,x1,y1,xOffset,yOffset: integer;
    53   const Texture: TBitmap);
    54 procedure PaintBackground(Form: TForm; Left,Top,Width,Height: integer);
    55 procedure Corner(ca: TCanvas; x,y,Kind:integer; const T: TTexture);
    56 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor;
    57   x,y:integer; s:string);
    58 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    59   x,y:integer; s:string);
    60 function BiColorTextWidth(ca: TCanvas; s: string): integer;
    61 procedure RisedTextOut(ca: TCanvas; x,y:integer; s:string);
    62 procedure LightGradient(ca: TCanvas; x,y,width,Color:integer);
    63 procedure DarkGradient(ca: TCanvas; x,y,width,Kind:integer);
    64 procedure VLightGradient(ca: TCanvas; x,y,height,Color:integer);
    65 procedure VDarkGradient(ca: TCanvas; x,y,height,Kind:integer);
    66 procedure NumberBar(dst:TBitmap; x,y:integer; Cap:string; val: integer;
    67   const T: TTexture);
    68 procedure CountBar(dst:TBitmap; x,y,w:integer; Kind:integer; Cap:string;
    69   val: integer; const T: TTexture);
    70 procedure PaintProgressBar(ca: TCanvas; Kind,x,y,pos,Growth,max: integer;
    71   const T: TTexture);
    72 procedure PaintRelativeProgressBar(ca: TCanvas; Kind,x,y,size,pos,Growth,
    73   max: integer; IndicateComplete: boolean; const T: TTexture);
    74 procedure PaintLogo(ca: TCanvas; x,y,clLight,clShade: integer);
    75 function SetMainTextureByAge(Age: integer): boolean;
    76 
    77 const
    78 nGrExtmax=64;
    79 wMainTexture=640; hMainTexture=480;
    80 
    81 // template positions in Template.bmp
    82 xLogo=1; yLogo=1; wLogo=122; hLogo=23; // logo
    83 xBBook=1; yBBook=74; wBBook=143; hBBook=73; // big book
    84 xSBook=72; ySBook=37; wSBook=72; hSBook=36; // small book
    85 xNation=1; yNation=25;
    86 xCoal=1; yCoal=148;
    87 
    88 // Icons.bmp structure
    89 xSizeBig=56; ySizeBig=40;
    90 
    91 GlowRange=8;
    92 
    93 EmptySpaceColor=$101010;
    94 
    95 // template positions in System2.bmp
    96 xOrna=156; yOrna=1; wOrna=27; hOrna=26; // ornament
    97 
    98 // sound modes
    99 smOff=0; smOn=1; smOnAlt=2;
    100 
    101 // color matrix
    102 clkAge0=1; cliTexture=0; cliBevelLight=cliTexture+1; cliBevelShade=cliTexture+2;
    103 cliTextLight=cliTexture+3; cliTextShade=cliTexture+4; cliLitText=cliTexture+5;
    104 cliMark=cliTexture+6; cliDimmedText=cliTexture+7;
    105 cliRoad=8; cliHouse=cliRoad+1; cliImp=cliRoad+2; cliImpProject=cliRoad+3;
    106 cliPage=13; cliCover=cliPage+1;
    107 clkMisc=5; cliPaper=0; cliPaperText=1; cliPaperCaption=2;
    108 clkCity=6; cliPlains=0; cliPrairie=1; cliHills=2; cliTundra=3; cliWater=4;
    109 
    110 // LoadGraphicFile options
    111 gfNoError=$01; gfNoGamma=$02; gfJPG=$04;
    112 
    113 type
    114 TGrExtDescr=record {don't use dynamic strings here!}
    115   Name:string[31];
    116   Data,Mask:TBitmap;
    117   pixUsed: array[Byte] of Byte;
    118   end;
    119 TGrExtDescrSize=record {for size calculation only - must be the same as
    120   TGrExtDescr, but without pixUsed}
    121   Name:string[31];
    122   Data,Mask:TBitmap;
    123   end;
    124 
    125 TFontType=(ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    126 
    127 var
    128 Phrases, Phrases2, Sounds: TStringTable;
    129 nGrExt: integer;
    130 GrExt:array[0..nGrExtmax-1] of ^TGrExtDescr;
    131 HGrSystem, HGrSystem2, ClickFrameColor,SoundMode, MainTextureAge: integer;
    132 MainTexture: TTexture;
    133 Templates,Colors,Paper,BigImp,LogoBuffer: TBitmap;
    134 FullScreen,GenerateNames,InitOrnamentDone,Phrases2FallenBackToEnglish: boolean;
    135 
    136 UniFont: array[TFontType] of TFont;
     12  TTexture = record
     13    Image: TBitmap;
     14    clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
     15      clPage, clCover: TColor end;
     16
     17    function ChangeResolution(x, y, bpp, freq: integer): boolean;
     18    procedure RestoreResolution;
     19    function Play(Item: string; Index: integer = -1): boolean;
     20    procedure PreparePlay(Item: string; Index: integer = -1);
     21    procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
     22    function turntoyear(Turn: integer): integer;
     23    function TurnToString(Turn: integer): string;
     24    function MovementToString(Movement: integer): string;
     25    procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     26    procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     27    function HexStringToColor(s: string): integer;
     28    function LoadGraphicFile(bmp: TBitmap; Path: string;
     29      Options: integer = 0): boolean;
     30    function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
     31      Options: integer = 0): boolean;
     32    function LoadGraphicSet(Name: string): integer;
     33    procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
     34      yGr: integer);
     35    procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
     36      yGr: integer); overload;
     37    procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
     38      yGr: integer); overload;
     39    procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
     40    procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w,
     41      h: integer);
     42    procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h,
     43      Color1, Color2: integer);
     44    procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
     45      Color2: integer);
     46    procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     47    procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     48    procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     49    procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     50    procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     51    procedure FrameImage(ca: TCanvas; Src: TBitmap;
     52      x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     53    procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer;
     54      cl: TColor);
     55    procedure InitOrnament;
     56    procedure InitCityMark(const T: TTexture);
     57    procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
     58      yOffset: integer);
     59    procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
     60    procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
     61      yOffset: integer; const Texture: TBitmap);
     62    procedure FillRectSeamless(ca: TCanvas;
     63      x0, y0, x1, y1, xOffset, yOffset: integer; const Texture: TBitmap);
     64    procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
     65    procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
     66    procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
     67      s: string);
     68    procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     69      x, y: integer; s: string);
     70    function BiColorTextWidth(ca: TCanvas; s: string): integer;
     71    procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     72    procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     73    procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     74    procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     75    procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     76    procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     77      const T: TTexture);
     78    procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     79      Cap: string; val: integer; const T: TTexture);
     80    procedure PaintProgressBar(ca: TCanvas;
     81      Kind, x, y, pos, Growth, max: integer; const T: TTexture);
     82    procedure PaintRelativeProgressBar(ca: TCanvas;
     83      Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
     84      const T: TTexture);
     85    procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     86    function SetMainTextureByAge(Age: integer): boolean;
     87
     88  const
     89    nGrExtmax = 64;
     90    wMainTexture = 640;
     91    hMainTexture = 480;
     92
     93    // template positions in Template.bmp
     94    xLogo = 1;
     95    yLogo = 1;
     96    wLogo = 122;
     97    hLogo = 23; // logo
     98    xBBook = 1;
     99    yBBook = 74;
     100    wBBook = 143;
     101    hBBook = 73; // big book
     102    xSBook = 72;
     103    ySBook = 37;
     104    wSBook = 72;
     105    hSBook = 36; // small book
     106    xNation = 1;
     107    yNation = 25;
     108    xCoal = 1;
     109    yCoal = 148;
     110
     111    // Icons.bmp structure
     112    xSizeBig = 56;
     113    ySizeBig = 40;
     114
     115    GlowRange = 8;
     116
     117    EmptySpaceColor = $101010;
     118
     119    // template positions in System2.bmp
     120    xOrna = 156;
     121    yOrna = 1;
     122    wOrna = 27;
     123    hOrna = 26; // ornament
     124
     125    // sound modes
     126    smOff = 0;
     127    smOn = 1;
     128    smOnAlt = 2;
     129
     130    // color matrix
     131    clkAge0 = 1;
     132    cliTexture = 0;
     133    cliBevelLight = cliTexture + 1;
     134    cliBevelShade = cliTexture + 2;
     135    cliTextLight = cliTexture + 3;
     136    cliTextShade = cliTexture + 4;
     137    cliLitText = cliTexture + 5;
     138    cliMark = cliTexture + 6;
     139    cliDimmedText = cliTexture + 7;
     140    cliRoad = 8;
     141    cliHouse = cliRoad + 1;
     142    cliImp = cliRoad + 2;
     143    cliImpProject = cliRoad + 3;
     144    cliPage = 13;
     145    cliCover = cliPage + 1;
     146    clkMisc = 5;
     147    cliPaper = 0;
     148    cliPaperText = 1;
     149    cliPaperCaption = 2;
     150    clkCity = 6;
     151    cliPlains = 0;
     152    cliPrairie = 1;
     153    cliHills = 2;
     154    cliTundra = 3;
     155    cliWater = 4;
     156
     157    // LoadGraphicFile options
     158    gfNoError = $01;
     159    gfNoGamma = $02;
     160    gfJPG = $04;
     161
     162  type
     163    TGrExtDescr = record { don't use dynamic strings here! }
     164      Name: string[31];
     165      Data, Mask: TBitmap;
     166      pixUsed: array [Byte] of Byte;
     167    end;
     168
     169    TGrExtDescrSize = record { for size calculation only - must be the same as
     170        TGrExtDescr, but without pixUsed }
     171      Name: string[31];
     172      Data, Mask: TBitmap;
     173    end;
     174
     175    TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
     176
     177  var
     178    Phrases, Phrases2, Sounds: TStringTable;
     179    nGrExt: integer;
     180    GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
     181    HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
     182    MainTexture: TTexture;
     183    Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
     184    FullScreen, GenerateNames, InitOrnamentDone,
     185      Phrases2FallenBackToEnglish: boolean;
     186
     187    UniFont: array [TFontType] of TFont;
    137188
    138189implementation
    … …  
    141192  Directories, Sound, ButtonBase, ButtonA, ButtonB,
    142193
    143   Registry,JPEG;
    144 
    145 var
    146 StartResolution: TDeviceMode;
    147 ResolutionChanged: boolean;
    148 
    149 Gamma: integer; // global gamma correction (cent)
    150 GammaLUT: array[0..255] of byte;
    151 
    152 
    153 function ChangeResolution(x,y,bpp,freq: integer): boolean;
    154 var
    155 DevMode: TDeviceMode;
    156 begin
    157 EnumDisplaySettings(nil, 0, DevMode);
    158 DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL
    159   or DM_DISPLAYFREQUENCY;
    160 DevMode.dmPelsWidth:=x;
    161 DevMode.dmPelsHeight:=y;
    162 DevMode.dmBitsPerPel:=bpp;
    163 DevMode.dmDisplayFrequency:=freq;
    164 result:= ChangeDisplaySettings(DevMode,0)=DISP_CHANGE_SUCCESSFUL;
    165 if result then
    166   ResolutionChanged:=true;
     194  Registry, JPEG;
     195
     196var
     197  StartResolution: TDeviceMode;
     198  ResolutionChanged: boolean;
     199
     200  Gamma: integer; // global gamma correction (cent)
     201  GammaLUT: array [0 .. 255] of Byte;
     202
     203function ChangeResolution(x, y, bpp, freq: integer): boolean;
     204var
     205  DevMode: TDeviceMode;
     206begin
     207  EnumDisplaySettings(nil, 0, DevMode);
     208  DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or
     209    DM_DISPLAYFREQUENCY;
     210  DevMode.dmPelsWidth := x;
     211  DevMode.dmPelsHeight := y;
     212  DevMode.dmBitsPerPel := bpp;
     213  DevMode.dmDisplayFrequency := freq;
     214  result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL;
     215  if result then
     216    ResolutionChanged := true;
    167217end;
    168218
    169219procedure RestoreResolution;
    170220begin
    171 if ResolutionChanged then
    172   ChangeDisplaySettings(StartResolution,0);
    173 ResolutionChanged:=false;
    174 end;
    175 
    176 function Play(Item: string; Index: integer =-1): boolean;
     221  if ResolutionChanged then
     222    ChangeDisplaySettings(StartResolution, 0);
     223  ResolutionChanged := false;
     224end;
     225
     226function Play(Item: string; Index: integer = -1): boolean;
    177227{$IFNDEF DEBUG}
    178228var
    179 WAVFileName: string;
     229  WAVFileName: string;
    180230{$ENDIF}
    181231begin
    182232{$IFNDEF DEBUG}
    183 if (Sounds=nil) or (SoundMode=smOff) or (Item='') then
    184   begin result:=true; exit; end;
    185 WAVFileName:=Sounds.Lookup(Item, Index);
    186 assert(WAVFileName[1]<>'[');
    187 result:=(WAVFileName<>'') and (WAVFileName[1]<>'[') and (WAVFileName<>'*');
    188 if result then
    189 //  SndPlaySound(pchar(HomeDir+'Sounds\'+WAVFileName+'.wav'),SND_ASYNC)
    190   PlaySound(HomeDir+'Sounds\'+WAVFileName)
     233  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     234  begin
     235    result := true;
     236    exit;
     237  end;
     238  WAVFileName := Sounds.Lookup(Item, Index);
     239  assert(WAVFileName[1] <> '[');
     240  result := (WAVFileName <> '') and (WAVFileName[1] <> '[') and
     241    (WAVFileName <> '*');
     242  if result then
     243    // SndPlaySound(pchar(HomeDir+'Sounds\'+WAVFileName+'.wav'),SND_ASYNC)
     244    PlaySound(HomeDir + 'Sounds\' + WAVFileName)
    191245{$ENDIF}
    192246end;
    193247
    194 procedure PreparePlay(Item: string; Index: integer =-1);
     248procedure PreparePlay(Item: string; Index: integer = -1);
    195249{$IFNDEF DEBUG}
    196250var
    197 WAVFileName: string;
     251  WAVFileName: string;
    198252{$ENDIF}
    199253begin
    200254{$IFNDEF DEBUG}
    201 if (Sounds=nil) or (SoundMode=smOff) or (Item='') then exit;
    202 WAVFileName:=Sounds.Lookup(Item, Index);
    203 assert(WAVFileName[1]<>'[');
    204 if (WAVFileName<>'') and (WAVFileName[1]<>'[') and (WAVFileName<>'*') then
    205   PrepareSound(HomeDir+'Sounds\'+WAVFileName)
     255  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     256    exit;
     257  WAVFileName := Sounds.Lookup(Item, Index);
     258  assert(WAVFileName[1] <> '[');
     259  if (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*')
     260  then
     261    PrepareSound(HomeDir + 'Sounds\' + WAVFileName)
    206262{$ENDIF}
    207263end;
    … …  
    209265procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
    210266var
    211 m: TMenuItem;
    212 begin
    213 while MenuItems.Count>Keep do
    214   begin
    215   m:=MenuItems[MenuItems.Count-1];
    216   MenuItems.Delete(MenuItems.Count-1);
    217   m.Free;
     267  m: TMenuItem;
     268begin
     269  while MenuItems.Count > Keep do
     270  begin
     271    m := MenuItems[MenuItems.Count - 1];
     272    MenuItems.Delete(MenuItems.Count - 1);
     273    m.Free;
    218274  end;
    219275end;
    … …  
    221277function turntoyear(Turn: integer): integer;
    222278var
    223 i: integer;
    224 begin
    225 result:=-4000;
    226 for i:=1 to Turn do
    227   if result<-1000 then inc(result,50)       // 0..60
    228   else if result<0 then inc(result,25)      // 60..100
    229   else if result<1500 then inc(result,20)   // 100..175
    230   else if result<1750 then inc(result,10)   // 175..200
    231   else if result<1850 then inc(result,2)    // 200..250
    232   else inc(result);
     279  i: integer;
     280begin
     281  result := -4000;
     282  for i := 1 to Turn do
     283    if result < -1000 then
     284      inc(result, 50) // 0..60
     285    else if result < 0 then
     286      inc(result, 25) // 60..100
     287    else if result < 1500 then
     288      inc(result, 20) // 100..175
     289    else if result < 1750 then
     290      inc(result, 10) // 175..200
     291    else if result < 1850 then
     292      inc(result, 2) // 200..250
     293    else
     294      inc(result);
    233295end;
    234296
    235297function TurnToString(Turn: integer): string;
    236298var
    237 year: integer;
    238 begin
    239 if GenerateNames then
    240   begin
    241   year:=turntoyear(Turn);
    242   if year<0 then result:=Format(Phrases.Lookup('BC'),[-year])
    243   else result:=Format(Phrases.Lookup('AD'),[year]);
    244   end
    245 else result:=IntToStr(Turn)
     299  year: integer;
     300begin
     301  if GenerateNames then
     302  begin
     303    year := turntoyear(Turn);
     304    if year < 0 then
     305      result := Format(Phrases.Lookup('BC'), [-year])
     306    else
     307      result := Format(Phrases.Lookup('AD'), [year]);
     308  end
     309  else
     310    result := IntToStr(Turn)
    246311end;
    247312
    248313function MovementToString(Movement: integer): string;
    249314begin
    250 if Movement>=1000 then
    251   begin
    252   result:=char(48+Movement div 1000);
    253   Movement:=Movement mod 1000;
    254   end
    255 else result:='';
    256 result:=result+char(48+Movement div 100);
    257 Movement:=Movement mod 100;
    258 if Movement>0 then
    259   begin
    260   result:=result+'.'+char(48+Movement div 10);
    261   Movement:=Movement mod 10;
    262   if Movement>0 then
    263     result:=result+char(48+Movement);
    264   end
    265 end;
    266 
    267 procedure BtnFrame(ca:TCanvas;p:TRect;const T: TTexture);
    268 begin
    269 RFrame(ca,p.Left-1,p.Top-1,p.Right,p.Bottom,T.clBevelShade,T.clBevelLight)
    270 end;
    271 
    272 procedure EditFrame(ca:TCanvas;p:TRect;const T: TTexture);
    273 begin
    274 Frame(ca,p.Left-1,p.Top-1,p.Right,p.Bottom,$000000,$000000);
    275 Frame(ca,p.Left-2,p.Top-2,p.Right+1,p.Bottom+1,$000000,$000000);
    276 Frame(ca,p.Left-3,p.Top-3,p.Right+2,p.Bottom+1,$000000,$000000);
    277 RFrame(ca,p.Left-4,p.Top-4,p.Right+3,p.Bottom+2,T.clBevelShade,T.clBevelLight)
     315  if Movement >= 1000 then
     316  begin
     317    result := char(48 + Movement div 1000);
     318    Movement := Movement mod 1000;
     319  end
     320  else
     321    result := '';
     322  result := result + char(48 + Movement div 100);
     323  Movement := Movement mod 100;
     324  if Movement > 0 then
     325  begin
     326    result := result + '.' + char(48 + Movement div 10);
     327    Movement := Movement mod 10;
     328    if Movement > 0 then
     329      result := result + char(48 + Movement);
     330  end
     331end;
     332
     333procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     334begin
     335  RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade,
     336    T.clBevelLight)
     337end;
     338
     339procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     340begin
     341  Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);
     342  Frame(ca, p.Left - 2, p.Top - 2, p.Right + 1, p.Bottom + 1, $000000, $000000);
     343  Frame(ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000);
     344  RFrame(ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.clBevelShade,
     345    T.clBevelLight)
    278346end;
    279347
    … …  
    282350  function HexCharToInt(x: char): integer;
    283351  begin
    284   case x of
    285     '0'..'9': result:=ord(x)-48;
    286     'A'..'F': result:=ord(x)-65+10;
    287     'a'..'f': result:=ord(x)-97+10;
    288     else result:=0
     352    case x of
     353      '0' .. '9':
     354        result := ord(x) - 48;
     355      'A' .. 'F':
     356        result := ord(x) - 65 + 10;
     357      'a' .. 'f':
     358        result := ord(x) - 97 + 10;
     359    else
     360      result := 0
    289361    end
    290362  end;
    291363
    292364begin
    293 while (Length(s)>0) and (s[1]=' ') do Delete(s,1,1);
    294 s:=s+'000000';
    295 if Gamma=100 then
    296   result:=$10*HexCharToInt(s[1])+$1*HexCharToInt(s[2])
    297     +$1000*HexCharToInt(s[3])+$100*HexCharToInt(s[4])
    298     +$100000*HexCharToInt(s[5])+$10000*HexCharToInt(s[6])
    299 else result:=GammaLUT[$10*HexCharToInt(s[1])+HexCharToInt(s[2])]
    300   +$100*GammaLUT[$10*HexCharToInt(s[3])+HexCharToInt(s[4])]
    301   +$10000*GammaLUT[$10*HexCharToInt(s[5])+HexCharToInt(s[6])];
     365  while (Length(s) > 0) and (s[1] = ' ') do
     366    Delete(s, 1, 1);
     367  s := s + '000000';
     368  if Gamma = 100 then
     369    result := $10 * HexCharToInt(s[1]) + $1 * HexCharToInt(s[2]) + $1000 *
     370      HexCharToInt(s[3]) + $100 * HexCharToInt(s[4]) + $100000 *
     371      HexCharToInt(s[5]) + $10000 * HexCharToInt(s[6])
     372  else
     373    result := GammaLUT[$10 * HexCharToInt(s[1]) + HexCharToInt(s[2])] + $100 *
     374      GammaLUT[$10 * HexCharToInt(s[3]) + HexCharToInt(s[4])] + $10000 *
     375      GammaLUT[$10 * HexCharToInt(s[5]) + HexCharToInt(s[6])];
    302376end;
    303377
    304378procedure ApplyGamma(Start, Stop: pbyte);
    305379begin
    306 while integer(Start)<integer(Stop) do
    307   begin Start^:=GammaLUT[Start^]; inc(Start); end;
     380  while integer(Start) < integer(Stop) do
     381  begin
     382    Start^ := GammaLUT[Start^];
     383    inc(Start);
     384  end;
    308385end;
    309386
    310387function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer): boolean;
    311388type
    312 TLine=array[0..9999,0..2] of Byte;
    313 var
    314 FirstLine, LastLine: ^TLine;
    315 jtex: tjpegimage;
    316 begin
    317 result:=true;
    318 if Options and gfJPG<>0 then
    319   begin
    320   jtex:=tjpegimage.create;
    321   try
    322     jtex.loadfromfile(Path+'.jpg');
    323   except
    324     result:=false;
    325     end;
    326   if result then
    327     begin
    328     if Options and gfNoGamma=0 then
    329       bmp.PixelFormat:=pf24bit;
    330     bmp.width:=jtex.width; bmp.height:=jtex.height;
    331     bmp.canvas.draw(0,0,jtex);
    332     end;
    333   jtex.free;
    334   end
    335 else
    336   begin
    337   try
    338     bmp.LoadFromFile(Path+'.bmp');
    339   except
    340     result:=false;
    341     end;
    342   if result then
    343     begin
    344     if Options and gfNoGamma=0 then
    345       bmp.PixelFormat:=pf24bit;
     389  TLine = array [0 .. 9999, 0 .. 2] of Byte;
     390var
     391  FirstLine, LastLine: ^TLine;
     392  jtex: tjpegimage;
     393begin
     394  result := true;
     395  if Options and gfJPG <> 0 then
     396  begin
     397    jtex := tjpegimage.create;
     398    try
     399      jtex.loadfromfile(Path + '.jpg');
     400    except
     401      result := false;
     402    end;
     403    if result then
     404    begin
     405      if Options and gfNoGamma = 0 then
     406        bmp.PixelFormat := pf24bit;
     407      bmp.Width := jtex.Width;
     408      bmp.Height := jtex.Height;
     409      bmp.Canvas.draw(0, 0, jtex);
     410    end;
     411    jtex.Free;
     412  end
     413  else
     414  begin
     415    try
     416      bmp.loadfromfile(Path + '.bmp');
     417    except
     418      result := false;
     419    end;
     420    if result then
     421    begin
     422      if Options and gfNoGamma = 0 then
     423        bmp.PixelFormat := pf24bit;
    346424    end
    347425  end;
    348 if not result then
    349   begin
    350   if Options and gfNoError=0 then
    351     Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),[Path])), 'C-evo', 0);
    352   exit;
    353   end;
    354 if (Options and gfNoGamma=0) and (Gamma<>100) then
    355   begin
    356   FirstLine:=bmp.ScanLine[0];
    357   LastLine:=bmp.ScanLine[bmp.Height-1];
    358   if integer(FirstLine)<integer(LastLine) then
    359     ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width])
    360   else ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width])
    361   end
    362 end;
    363 
    364 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; Options: integer): boolean;
     426  if not result then
     427  begin
     428    if Options and gfNoError = 0 then
     429      Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),
     430        [Path])), 'C-evo', 0);
     431    exit;
     432  end;
     433  if (Options and gfNoGamma = 0) and (Gamma <> 100) then
     434  begin
     435    FirstLine := bmp.ScanLine[0];
     436    LastLine := bmp.ScanLine[bmp.Height - 1];
     437    if integer(FirstLine) < integer(LastLine) then
     438      ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width])
     439    else
     440      ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width])
     441  end
     442end;
     443
     444function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
     445  Options: integer): boolean;
    365446type
    366 TLine=array[0..9999,0..2] of Byte;
    367 var
    368 FirstLine, LastLine: ^TLine;
    369 jtex: tjpegimage;
    370 begin
    371 result:=true;
    372 if Options and gfJPG<>0 then
    373   begin
    374   jtex:=tjpegimage.create;
    375   try
    376     jtex.loadfromfile(LocalizedFilePath(Path+'.jpg'));
    377   except
    378     result:=false;
    379     end;
    380   if result then
    381     begin
    382     if Options and gfNoGamma=0 then
    383       bmp.PixelFormat:=pf24bit;
    384     bmp.width:=jtex.width; bmp.height:=jtex.height;
    385     bmp.canvas.draw(0,0,jtex);
    386     end;
    387   jtex.free;
    388   end
    389 else
    390   begin
    391   try
    392     bmp.LoadFromFile(LocalizedFilePath(Path+'.bmp'));
    393   except
    394     result:=false;
    395     end;
    396   if result then
    397     begin
    398     if Options and gfNoGamma=0 then
    399       bmp.PixelFormat:=pf24bit;
     447  TLine = array [0 .. 9999, 0 .. 2] of Byte;
     448var
     449  FirstLine, LastLine: ^TLine;
     450  jtex: tjpegimage;
     451begin
     452  result := true;
     453  if Options and gfJPG <> 0 then
     454  begin
     455    jtex := tjpegimage.create;
     456    try
     457      jtex.loadfromfile(LocalizedFilePath(Path + '.jpg'));
     458    except
     459      result := false;
     460    end;
     461    if result then
     462    begin
     463      if Options and gfNoGamma = 0 then
     464        bmp.PixelFormat := pf24bit;
     465      bmp.Width := jtex.Width;
     466      bmp.Height := jtex.Height;
     467      bmp.Canvas.draw(0, 0, jtex);
     468    end;
     469    jtex.Free;
     470  end
     471  else
     472  begin
     473    try
     474      bmp.loadfromfile(LocalizedFilePath(Path + '.bmp'));
     475    except
     476      result := false;
     477    end;
     478    if result then
     479    begin
     480      if Options and gfNoGamma = 0 then
     481        bmp.PixelFormat := pf24bit;
    400482    end
    401483  end;
    402 if not result then
    403   begin
    404   if Options and gfNoError=0 then
    405     Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),[Path])), 'C-evo', 0);
    406   exit;
    407   end;
    408 if (Options and gfNoGamma=0) and (Gamma<>100) then
    409   begin
    410   FirstLine:=bmp.ScanLine[0];
    411   LastLine:=bmp.ScanLine[bmp.Height-1];
    412   if integer(FirstLine)<integer(LastLine) then
    413     ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width])
    414   else ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width])
     484  if not result then
     485  begin
     486    if Options and gfNoError = 0 then
     487      Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),
     488        [Path])), 'C-evo', 0);
     489    exit;
     490  end;
     491  if (Options and gfNoGamma = 0) and (Gamma <> 100) then
     492  begin
     493    FirstLine := bmp.ScanLine[0];
     494    LastLine := bmp.ScanLine[bmp.Height - 1];
     495    if integer(FirstLine) < integer(LastLine) then
     496      ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width])
     497    else
     498      ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width])
    415499  end
    416500end;
    … …  
    418502function LoadGraphicSet(Name: string): integer;
    419503type
    420 TLine=array[0..999,0..2] of Byte;
    421 var
    422 i,x,y,xmax,OriginalColor: integer;
    423 FileName: string;
    424 Source: TBitmap;
    425 DataLine, MaskLine: ^TLine;
    426 begin
    427 i:=0;
    428 while (i<nGrExt) and (GrExt[i].Name<>Name) do inc(i);
    429 result:=i;
    430 if i=nGrExt then
    431   begin
    432   FileName:=HomeDir+'Graphics\'+Name;
    433   Source:=TBitmap.Create;
    434   try
    435     Source.LoadFromFile(FileName+'.bmp')
    436   except
    437     result:=-1;
    438     Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),['Graphics\'+Name])), 'C-evo', 0);
    439     exit;
    440     end;
    441 
    442   GetMem(GrExt[nGrExt],SizeOf(TGrExtDescrSize)+Source.Height div 49 *10);
    443   GrExt[nGrExt].Name:=Name;
    444 
    445   xmax:=Source.Width-1; // allows 4-byte access even for last pixel
    446   if xmax>970 then xmax:=970;
    447 
    448   GrExt[nGrExt].Data:=Source;
    449   GrExt[nGrExt].Data.PixelFormat:=pf24bit;
    450   GrExt[nGrExt].Mask:=TBitmap.Create;
    451   GrExt[nGrExt].Mask.PixelFormat:=pf24bit;
    452   GrExt[nGrExt].Mask.Width:=Source.Width;
    453   GrExt[nGrExt].Mask.Height:=Source.Height;
    454 
    455   for y:=0 to Source.Height-1 do
    456     begin
    457     DataLine:=GrExt[nGrExt].Data.ScanLine[y];
    458     MaskLine:=GrExt[nGrExt].Mask.ScanLine[y];
    459     for x:=0 to xmax-1 do
     504  TLine = array [0 .. 999, 0 .. 2] of Byte;
     505var
     506  i, x, y, xmax, OriginalColor: integer;
     507  FileName: string;
     508  Source: TBitmap;
     509  DataLine, MaskLine: ^TLine;
     510begin
     511  i := 0;
     512  while (i < nGrExt) and (GrExt[i].Name <> Name) do
     513    inc(i);
     514  result := i;
     515  if i = nGrExt then
     516  begin
     517    FileName := HomeDir + 'Graphics\' + Name;
     518    Source := TBitmap.create;
     519    try
     520      Source.loadfromfile(FileName + '.bmp')
     521    except
     522      result := -1;
     523      Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),
     524        ['Graphics\' + Name])), 'C-evo', 0);
     525      exit;
     526    end;
     527
     528    GetMem(GrExt[nGrExt], SizeOf(TGrExtDescrSize) + Source.Height div 49 * 10);
     529    GrExt[nGrExt].Name := Name;
     530
     531    xmax := Source.Width - 1; // allows 4-byte access even for last pixel
     532    if xmax > 970 then
     533      xmax := 970;
     534
     535    GrExt[nGrExt].Data := Source;
     536    GrExt[nGrExt].Data.PixelFormat := pf24bit;
     537    GrExt[nGrExt].Mask := TBitmap.create;
     538    GrExt[nGrExt].Mask.PixelFormat := pf24bit;
     539    GrExt[nGrExt].Mask.Width := Source.Width;
     540    GrExt[nGrExt].Mask.Height := Source.Height;
     541
     542    for y := 0 to Source.Height - 1 do
     543    begin
     544      DataLine := GrExt[nGrExt].Data.ScanLine[y];
     545      MaskLine := GrExt[nGrExt].Mask.ScanLine[y];
     546      for x := 0 to xmax - 1 do
    460547      begin
    461       OriginalColor:=Cardinal((@DataLine[x])^) and $FFFFFF;
    462       if (OriginalColor=$FF00FF) or (OriginalColor=$7F007F) then
     548        OriginalColor := Cardinal((@DataLine[x])^) and $FFFFFF;
     549        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
    463550        begin // transparent
    464         Cardinal((@MaskLine[x])^):=$FFFFFF;
    465         Cardinal((@DataLine[x])^):=Cardinal((@DataLine[x])^) and $FF000000
     551          Cardinal((@MaskLine[x])^) := $FFFFFF;
     552          Cardinal((@DataLine[x])^) := Cardinal((@DataLine[x])^) and $FF000000
    466553        end
    467       else
     554        else
    468555        begin
    469         Cardinal((@MaskLine[x])^):=$000000; // non-transparent
    470         if Gamma<>100 then
     556          Cardinal((@MaskLine[x])^) := $000000; // non-transparent
     557          if Gamma <> 100 then
    471558          begin
    472           DataLine[x,0]:=GammaLUT[DataLine[x,0]];
    473           DataLine[x,1]:=GammaLUT[DataLine[x,1]];
    474           DataLine[x,2]:=GammaLUT[DataLine[x,2]];
     559            DataLine[x, 0] := GammaLUT[DataLine[x, 0]];
     560            DataLine[x, 1] := GammaLUT[DataLine[x, 1]];
     561            DataLine[x, 2] := GammaLUT[DataLine[x, 2]];
    475562          end
    476563        end
    … …  
    478565    end;
    479566
    480   FillChar(GrExt[nGrExt].pixUsed,GrExt[nGrExt].Data.Height div 49 *10,0);
    481   inc(nGrExt)
    482   end
    483 end;
    484 
    485 procedure Dump(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr: integer);
    486 begin
    487 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height,
    488   GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCCOPY);
    489 end;
    490 
    491 procedure MakeBlue(Dst: TBitmap; x,y,w,h: integer);
     567    FillChar(GrExt[nGrExt].pixUsed, GrExt[nGrExt].Data.Height div 49 * 10, 0);
     568    inc(nGrExt)
     569  end
     570end;
     571
     572procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     573begin
     574  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
     575    GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCCOPY);
     576end;
     577
     578procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    492579type
    493 TLine=array[0..99999,0..2] of Byte;
    494 PLine=^TLine;
    495 
    496   procedure BlueLine(line: PLine; length: integer);
     580  TLine = array [0 .. 99999, 0 .. 2] of Byte;
     581  PLine = ^TLine;
     582
     583  procedure BlueLine(line: PLine; Length: integer);
    497584  var
     585    i: integer;
     586  begin
     587    for i := 0 to Length - 1 do
     588    begin
     589      line[i, 0] := line[i, 0] div 2;
     590      line[i, 1] := line[i, 1] div 2;
     591      line[i, 2] := line[i, 2] div 2;
     592    end
     593  end;
     594
     595var
    498596  i: integer;
    499   begin
    500   for i:=0 to length-1 do
    501     begin
    502     line[i,0]:=line[i,0] div 2;
    503     line[i,1]:=line[i,1] div 2;
    504     line[i,2]:=line[i,2] div 2;
    505     end
    506   end;
    507 
    508 var
    509 i: integer;
    510 begin
    511 for i:=0 to h-1 do
    512   BlueLine(@(PLine(Dst.ScanLine[y+i])[x]),w)
    513 end;
    514 
    515 procedure ImageOp_B(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h: integer);
     597begin
     598  for i := 0 to h - 1 do
     599    BlueLine(@(PLine(dst.ScanLine[y + i])[x]), w)
     600end;
     601
     602procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
    516603// Src is template
    517604// X channel = background amp (old Dst content), 128=original brightness
    518605type
    519 TPixel=array[0..2] of Byte;
    520 var
    521 i,Brightness,test: integer;
    522 PixelSrc: ^byte;
    523 PixelDst: ^TPixel;
    524 begin
    525 assert(Src.PixelFormat=pf8bit);
    526 assert(Dst.PixelFormat=pf24bit);
    527 if xDst<0 then
    528   begin w:=w+xDst; xSrc:=xSrc-xDst; xDst:=0; end;
    529 if yDst<0 then
    530   begin h:=h+yDst; ySrc:=ySrc-yDst; yDst:=0; end;
    531 if xDst+w>Dst.Width then
    532   w:=Dst.Width-xDst;
    533 if yDst+h>Dst.Height then
    534   h:=Dst.Height-yDst;
    535 if (w<0) or (h<0) then
    536   exit;
    537 
    538 h:=yDst+h;
    539 while yDst<h do
    540   begin
    541   PixelDst:=pointer(integer(Dst.ScanLine[yDst])+3*xDst);
    542   PixelSrc:=pointer(integer(Src.ScanLine[ySrc])+xSrc);
    543   for i:=0 to w-1 do
    544     begin
    545     Brightness:=PixelSrc^;
    546     test:=(PixelDst[2]*Brightness) shr 7;
    547     if test>=256 then PixelDst[2]:=255
    548     else PixelDst[2]:=test; // Red
    549     test:=(PixelDst[1]*Brightness) shr 7;
    550     if test>=256 then PixelDst[1]:=255
    551     else PixelDst[1]:=test; // Green
    552     test:=(PixelDst[0]*Brightness) shr 7;
    553     if test>=256 then PixelDst[2]:=255
    554     else PixelDst[0]:=test; // Blue
    555     PixelDst:=pointer(integer(PixelDst)+3);
    556     PixelSrc:=pointer(integer(PixelSrc)+1);
    557     end;
    558   inc(yDst);
    559   inc(ySrc);
    560   end
    561 end;
    562 
    563 procedure ImageOp_BCC(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h,Color1,Color2: integer);
     606  TPixel = array [0 .. 2] of Byte;
     607var
     608  i, Brightness, test: integer;
     609  PixelSrc: ^Byte;
     610  PixelDst: ^TPixel;
     611begin
     612  assert(Src.PixelFormat = pf8bit);
     613  assert(dst.PixelFormat = pf24bit);
     614  if xDst < 0 then
     615  begin
     616    w := w + xDst;
     617    xSrc := xSrc - xDst;
     618    xDst := 0;
     619  end;
     620  if yDst < 0 then
     621  begin
     622    h := h + yDst;
     623    ySrc := ySrc - yDst;
     624    yDst := 0;
     625  end;
     626  if xDst + w > dst.Width then
     627    w := dst.Width - xDst;
     628  if yDst + h > dst.Height then
     629    h := dst.Height - yDst;
     630  if (w < 0) or (h < 0) then
     631    exit;
     632
     633  h := yDst + h;
     634  while yDst < h do
     635  begin
     636    PixelDst := pointer(integer(dst.ScanLine[yDst]) + 3 * xDst);
     637    PixelSrc := pointer(integer(Src.ScanLine[ySrc]) + xSrc);
     638    for i := 0 to w - 1 do
     639    begin
     640      Brightness := PixelSrc^;
     641      test := (PixelDst[2] * Brightness) shr 7;
     642      if test >= 256 then
     643        PixelDst[2] := 255
     644      else
     645        PixelDst[2] := test; // Red
     646      test := (PixelDst[1] * Brightness) shr 7;
     647      if test >= 256 then
     648        PixelDst[1] := 255
     649      else
     650        PixelDst[1] := test; // Green
     651      test := (PixelDst[0] * Brightness) shr 7;
     652      if test >= 256 then
     653        PixelDst[2] := 255
     654      else
     655        PixelDst[0] := test; // Blue
     656      PixelDst := pointer(integer(PixelDst) + 3);
     657      PixelSrc := pointer(integer(PixelSrc) + 1);
     658    end;
     659    inc(yDst);
     660    inc(ySrc);
     661  end
     662end;
     663
     664procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1,
     665  Color2: integer);
    564666// Src is template
    565667// B channel = background amp (old Dst content), 128=original brightness
    … …  
    567669// R channel = Color2 amp, 128=original brightness
    568670type
    569 TLine=array[0..9999,0..2] of Byte;
    570 var
    571 ix,iy,amp1,amp2,trans,Value: integer;
    572 SrcLine,DstLine: ^TLine;
    573 begin
    574 if xDst<0 then
    575   begin w:=w+xDst; xSrc:=xSrc-xDst; xDst:=0; end;
    576 if yDst<0 then
    577   begin h:=h+yDst; ySrc:=ySrc-yDst; yDst:=0; end;
    578 if xDst+w>Dst.Width then
    579   w:=Dst.Width-xDst;
    580 if yDst+h>Dst.Height then
    581   h:=Dst.Height-yDst;
    582 if (w<0) or (h<0) then
    583   exit;
    584 
    585 for iy:=0 to h-1 do
    586   begin
    587   SrcLine:=Src.ScanLine[ySrc+iy];
    588   DstLine:=Dst.ScanLine[yDst+iy];
    589   for ix:=0 to w-1 do
    590     begin
    591     trans:=SrcLine[xSrc+ix,0]*2; // green channel = transparency
    592     amp1:=SrcLine[xSrc+ix,1]*2;
    593     amp2:=SrcLine[xSrc+ix,2]*2;
    594     if trans<>$FF then
     671  TLine = array [0 .. 9999, 0 .. 2] of Byte;
     672var
     673  ix, iy, amp1, amp2, trans, Value: integer;
     674  SrcLine, DstLine: ^TLine;
     675begin
     676  if xDst < 0 then
     677  begin
     678    w := w + xDst;
     679    xSrc := xSrc - xDst;
     680    xDst := 0;
     681  end;
     682  if yDst < 0 then
     683  begin
     684    h := h + yDst;
     685    ySrc := ySrc - yDst;
     686    yDst := 0;
     687  end;
     688  if xDst + w > dst.Width then
     689    w := dst.Width - xDst;
     690  if yDst + h > dst.Height then
     691    h := dst.Height - yDst;
     692  if (w < 0) or (h < 0) then
     693    exit;
     694
     695  for iy := 0 to h - 1 do
     696  begin
     697    SrcLine := Src.ScanLine[ySrc + iy];
     698    DstLine := dst.ScanLine[yDst + iy];
     699    for ix := 0 to w - 1 do
     700    begin
     701      trans := SrcLine[xSrc + ix, 0] * 2; // green channel = transparency
     702      amp1 := SrcLine[xSrc + ix, 1] * 2;
     703      amp2 := SrcLine[xSrc + ix, 2] * 2;
     704      if trans <> $FF then
    595705      begin
    596       Value:=(DstLine[xDst+ix][0]*trans+(Color2 shr 16 and $FF)*amp2+(Color1 shr 16 and $FF)*amp1) div $FF;
    597       if Value<256 then
    598         DstLine[xDst+ix][0]:=Value
    599       else DstLine[xDst+ix][0]:=255;
    600       Value:=(DstLine[xDst+ix][1]*trans+(Color2 shr 8 and $FF)*amp2+(Color1 shr 8 and $FF)*amp1) div $FF;
    601       if Value<256 then
    602         DstLine[xDst+ix][1]:=Value
    603       else DstLine[xDst+ix][1]:=255;
    604       Value:=(DstLine[xDst+ix][2]*trans+(Color2 and $FF)*amp2+(Color1 and $FF)*amp1) div $FF;
    605       if Value<256 then
    606         DstLine[xDst+ix][2]:=Value
    607       else DstLine[xDst+ix][2]:=255;
     706        Value := (DstLine[xDst + ix][0] * trans + (Color2 shr 16 and $FF) * amp2
     707          + (Color1 shr 16 and $FF) * amp1) div $FF;
     708        if Value < 256 then
     709          DstLine[xDst + ix][0] := Value
     710        else
     711          DstLine[xDst + ix][0] := 255;
     712        Value := (DstLine[xDst + ix][1] * trans + (Color2 shr 8 and $FF) * amp2
     713          + (Color1 shr 8 and $FF) * amp1) div $FF;
     714        if Value < 256 then
     715          DstLine[xDst + ix][1] := Value
     716        else
     717          DstLine[xDst + ix][1] := 255;
     718        Value := (DstLine[xDst + ix][2] * trans + (Color2 and $FF) * amp2 +
     719          (Color1 and $FF) * amp1) div $FF;
     720        if Value < 256 then
     721          DstLine[xDst + ix][2] := Value
     722        else
     723          DstLine[xDst + ix][2] := 255;
    608724      end
    609725    end
    … …  
    611727end;
    612728
    613 procedure ImageOp_CCC(Bmp: TBitmap; x,y,w,h,Color0,Color1,Color2: integer);
     729procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
     730  Color2: integer);
    614731// Bmp is template
    615732// B channel = Color0 amp, 128=original brightness
    … …  
    617734// R channel = Color2 amp, 128=original brightness
    618735type
    619 TPixel=array[0..2] of Byte;
    620 var
    621 i,Red,Green: integer;
    622 Pixel: ^TPixel;
    623 begin
    624 assert(Bmp.PixelFormat=pf24bit);
    625 h:=y+h;
    626 while y<h do
    627   begin
    628   Pixel:=pointer(integer(Bmp.ScanLine[y])+3*x);
    629   for i:=0 to w-1 do
    630     begin
    631     Red:=       (Pixel[0]*(Color0        and $0000FF)
    632                 +Pixel[1]*(Color1        and $0000FF)
    633                 +Pixel[2]*(Color2        and $0000FF)) shr 8;
    634     Green:=     (Pixel[0]*(Color0 shr  8 and $0000FF)
    635                 +Pixel[1]*(Color1 shr  8 and $0000FF)
    636                 +Pixel[2]*(Color2 shr  8 and $0000FF)) shr 8;
    637     Pixel[0]:=  (Pixel[0]*(Color0 shr 16 and $0000FF)
    638                 +Pixel[1]*(Color1 shr 16 and $0000FF)
    639                 +Pixel[2]*(Color2 shr 16 and $0000FF)) shr 8; // Blue
    640     Pixel[1]:=Green;
    641     Pixel[2]:=Red;
    642     Pixel:=pointer(integer(pixel)+3);
    643     end;
    644   inc(y);
    645   end
    646 end;
    647 
    648 procedure Sprite(Canvas: TCanvas; HGr,xDst,yDst,Width,Height,xGr,yGr: integer);
    649 begin
    650 BitBlt(Canvas.Handle,xDst,yDst,Width,Height,
    651   GrExt[HGr].Mask.Canvas.Handle,xGr,yGr,SRCAND);
    652 BitBlt(Canvas.Handle,xDst,yDst,Width,Height,
    653   GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCPAINT);
    654 end;
    655 
    656 procedure Sprite(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr: integer);
    657 begin
    658 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height,
    659   GrExt[HGr].Mask.Canvas.Handle,xGr,yGr,SRCAND);
    660 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height,
    661   GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCPAINT);
    662 end;
    663 
    664 procedure SLine(ca: TCanvas; x0,x1,y: integer; cl: TColor);
    665 begin
    666 with ca do
    667   begin
    668   Pen.Color:=cl; MoveTo(x0,y); LineTo(x1+1,y);
    669   end
    670 end;
    671 
    672 procedure DLine(ca: TCanvas; x0,x1,y: integer; cl0,cl1: TColor);
    673 begin
    674 with ca do
    675   begin
    676   Pen.Color:=cl0; MoveTo(x0,y); LineTo(x1,y);
    677   Pen.Color:=cl1; MoveTo(x0+1,y+1); LineTo(x1+1,y+1);
    678   Pixels[x0,y+1]:=cl0; Pixels[x1,y]:=cl1;
    679   end
    680 end;
    681 
    682 procedure Frame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor);
    683 begin
    684 with ca do
    685   begin
    686   MoveTo(x0,y1);
    687   Pen.Color:=cl0;LineTo(x0,y0);LineTo(x1,y0);
    688   Pen.Color:=cl1;LineTo(x1,y1);LineTo(x0,y1);
    689   end
    690 end;
    691 
    692 procedure RFrame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor);
    693 begin
    694 with ca do
    695   begin
    696   Pen.Color:=cl0;
    697   MoveTo(x0,y0+1);LineTo(x0,y1);
    698   MoveTo(x0+1,y0);LineTo(x1,y0);
    699   Pen.Color:=cl1;
    700   MoveTo(x1,y0+1);LineTo(x1,y1);
    701   MoveTo(x0+1,y1);LineTo(x1,y1);
    702   end
    703 end;
    704 
    705 procedure CFrame(ca: TCanvas; x0,y0,x1,y1,Corner: integer; cl: TColor);
    706 begin
    707 with ca do
    708   begin
    709   Pen.Color:=cl;
    710   MoveTo(x0,y0+Corner-1);LineTo(x0,y0);LineTo(x0+Corner,y0);
    711   MoveTo(x1,y0+Corner-1);LineTo(x1,y0);LineTo(x1-Corner,y0);
    712   MoveTo(x1,y1-Corner+1);LineTo(x1,y1);LineTo(x1-Corner,y1);
    713   MoveTo(x0,y1-Corner+1);LineTo(x0,y1);LineTo(x0+Corner,y1);
    714   end
    715 end;
    716 
    717 procedure FrameImage(ca: TCanvas; src:TBitmap; x,y,width,height,xSrc,ySrc: integer;
    718   IsControl: boolean = false);
    719 begin
    720 if IsControl then
    721   begin
    722   Frame(ca,x-1,y-1,x+width,y+height,$B0B0B0,$FFFFFF);
    723   RFrame(ca,x-2,y-2,x+width+1,y+height+1,$FFFFFF,$B0B0B0);
    724   end
    725 else Frame(ca,x-1,y-1,x+width,y+height,$000000,$000000);
    726 BitBlt(ca.Handle,x,y,width,height,src.Canvas.Handle,xSrc,ySrc,SRCCOPY);
    727 end;
    728 
    729 procedure GlowFrame(dst: TBitmap; x0,y0,width,height: integer; cl: TColor);
     736  TPixel = array [0 .. 2] of Byte;
     737var
     738  i, Red, Green: integer;
     739  Pixel: ^TPixel;
     740begin
     741  assert(bmp.PixelFormat = pf24bit);
     742  h := y + h;
     743  while y < h do
     744  begin
     745    Pixel := pointer(integer(bmp.ScanLine[y]) + 3 * x);
     746    for i := 0 to w - 1 do
     747    begin
     748      Red := (Pixel[0] * (Color0 and $0000FF) + Pixel[1] * (Color1 and $0000FF)
     749        + Pixel[2] * (Color2 and $0000FF)) shr 8;
     750      Green := (Pixel[0] * (Color0 shr 8 and $0000FF) + Pixel[1] *
     751        (Color1 shr 8 and $0000FF) + Pixel[2] * (Color2 shr 8 and
     752        $0000FF)) shr 8;
     753      Pixel[0] := (Pixel[0] * (Color0 shr 16 and $0000FF) + Pixel[1] *
     754        (Color1 shr 16 and $0000FF) + Pixel[2] * (Color2 shr 16 and $0000FF))
     755        shr 8; // Blue
     756      Pixel[1] := Green;
     757      Pixel[2] := Red;
     758      Pixel := pointer(integer(Pixel) + 3);
     759    end;
     760    inc(y);
     761  end
     762end;
     763
     764procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
     765  yGr: integer);
     766begin
     767  BitBlt(Canvas.Handle, xDst, yDst, Width, Height,
     768    GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND);
     769  BitBlt(Canvas.Handle, xDst, yDst, Width, Height,
     770    GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT);
     771end;
     772
     773procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
     774  yGr: integer);
     775begin
     776  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
     777    GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND);
     778  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
     779    GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT);
     780end;
     781
     782procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     783begin
     784  with ca do
     785  begin
     786    Pen.Color := cl;
     787    MoveTo(x0, y);
     788    LineTo(x1 + 1, y);
     789  end
     790end;
     791
     792procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     793begin
     794  with ca do
     795  begin
     796    Pen.Color := cl0;
     797    MoveTo(x0, y);
     798    LineTo(x1, y);
     799    Pen.Color := cl1;
     800    MoveTo(x0 + 1, y + 1);
     801    LineTo(x1 + 1, y + 1);
     802    Pixels[x0, y + 1] := cl0;
     803    Pixels[x1, y] := cl1;
     804  end
     805end;
     806
     807procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     808begin
     809  with ca do
     810  begin
     811    MoveTo(x0, y1);
     812    Pen.Color := cl0;
     813    LineTo(x0, y0);
     814    LineTo(x1, y0);
     815    Pen.Color := cl1;
     816    LineTo(x1, y1);
     817    LineTo(x0, y1);
     818  end
     819end;
     820
     821procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     822begin
     823  with ca do
     824  begin
     825    Pen.Color := cl0;
     826    MoveTo(x0, y0 + 1);
     827    LineTo(x0, y1);
     828    MoveTo(x0 + 1, y0);
     829    LineTo(x1, y0);
     830    Pen.Color := cl1;
     831    MoveTo(x1, y0 + 1);
     832    LineTo(x1, y1);
     833    MoveTo(x0 + 1, y1);
     834    LineTo(x1, y1);
     835  end
     836end;
     837
     838procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     839begin
     840  with ca do
     841  begin
     842    Pen.Color := cl;
     843    MoveTo(x0, y0 + Corner - 1);
     844    LineTo(x0, y0);
     845    LineTo(x0 + Corner, y0);
     846    MoveTo(x1, y0 + Corner - 1);
     847    LineTo(x1, y0);
     848    LineTo(x1 - Corner, y0);
     849    MoveTo(x1, y1 - Corner + 1);
     850    LineTo(x1, y1);
     851    LineTo(x1 - Corner, y1);
     852    MoveTo(x0, y1 - Corner + 1);
     853    LineTo(x0, y1);
     854    LineTo(x0 + Corner, y1);
     855  end
     856end;
     857
     858procedure FrameImage(ca: TCanvas; Src: TBitmap;
     859  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     860begin
     861  if IsControl then
     862  begin
     863    Frame(ca, x - 1, y - 1, x + Width, y + Height, $B0B0B0, $FFFFFF);
     864    RFrame(ca, x - 2, y - 2, x + Width + 1, y + Height + 1, $FFFFFF, $B0B0B0);
     865  end
     866  else
     867    Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000);
     868  BitBlt(ca.Handle, x, y, Width, Height, Src.Canvas.Handle, xSrc, ySrc,
     869    SRCCOPY);
     870end;
     871
     872procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
    730873type
    731 TLine=array[0..649,0..2] of Byte;
    732 var
    733 x,y,ch,r: integer;
    734 DstLine: ^TLine;
    735 begin
    736 for y:=-GlowRange+1 to height-1+GlowRange-1 do
    737   begin
    738   DstLine:=dst.ScanLine[y0+y];
    739   for x:=-GlowRange+1 to width-1+GlowRange-1 do
    740     begin
    741     if x<0 then
    742       if y<0 then r:=round(sqrt(sqr(x)+sqr(y)))
    743       else if y>=height then r:=round(sqrt(sqr(x)+sqr(y-(height-1))))
    744       else r:=-x
    745     else if x>=width then
    746       if y<0 then r:=round(sqrt(sqr(x-(width-1))+sqr(y)))
    747       else if y>=height then r:=round(sqrt(sqr(x-(width-1))+sqr(y-(height-1))))
    748       else r:=x-(width-1)
    749     else if y<0 then r:=-y
    750     else if y>=height then r:=y-(height-1)
    751     else continue;
    752     if r=0 then r:=1;
    753     if r<GlowRange then
    754       for ch:=0 to 2 do
    755         DstLine[x0+x][2-ch]:=(DstLine[x0+x][2-ch]*(r-1)
    756           +(cl shr (8*ch) and $FF)*(GlowRange-r)) div (GlowRange-1);
     874  TLine = array [0 .. 649, 0 .. 2] of Byte;
     875var
     876  x, y, ch, r: integer;
     877  DstLine: ^TLine;
     878begin
     879  for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do
     880  begin
     881    DstLine := dst.ScanLine[y0 + y];
     882    for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do
     883    begin
     884      if x < 0 then
     885        if y < 0 then
     886          r := round(sqrt(sqr(x) + sqr(y)))
     887        else if y >= Height then
     888          r := round(sqrt(sqr(x) + sqr(y - (Height - 1))))
     889        else
     890          r := -x
     891      else if x >= Width then
     892        if y < 0 then
     893          r := round(sqrt(sqr(x - (Width - 1)) + sqr(y)))
     894        else if y >= Height then
     895          r := round(sqrt(sqr(x - (Width - 1)) + sqr(y - (Height - 1))))
     896        else
     897          r := x - (Width - 1)
     898      else if y < 0 then
     899        r := -y
     900      else if y >= Height then
     901        r := y - (Height - 1)
     902      else
     903        continue;
     904      if r = 0 then
     905        r := 1;
     906      if r < GlowRange then
     907        for ch := 0 to 2 do
     908          DstLine[x0 + x][2 - ch] :=
     909            (DstLine[x0 + x][2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
     910            (GlowRange - r)) div (GlowRange - 1);
    757911    end;
    758912  end
    … …  
    761915procedure InitOrnament;
    762916var
    763 x,y,p,light,shade: integer;
    764 begin
    765 if InitOrnamentDone then exit;
    766 light:=MainTexture.clBevelLight; // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2;
    767 shade:=MainTexture.clBevelShade and $FCFCFC shr 2*3+MainTexture.clBevelLight and $FCFCFC shr 2;
    768 for x:=0 to wOrna-1 do for y:=0 to hOrna-1 do
    769   begin
    770   p:=GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y];
    771   if p=$0000FF then
    772     GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y]:=light
    773   else if p=$FF0000 then
    774     GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y]:=shade
    775   end;
    776 InitOrnamentDone:=true
     917  x, y, p, light, shade: integer;
     918begin
     919  if InitOrnamentDone then
     920    exit;
     921  light := MainTexture.clBevelLight;
     922  // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2;
     923  shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
     924    MainTexture.clBevelLight and $FCFCFC shr 2;
     925  for x := 0 to wOrna - 1 do
     926    for y := 0 to hOrna - 1 do
     927    begin
     928      p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y];
     929      if p = $0000FF then
     930        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := light
     931      else if p = $FF0000 then
     932        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := shade
     933    end;
     934  InitOrnamentDone := true
    777935end;
    778936
    779937procedure InitCityMark(const T: TTexture);
    780938var
    781 x,y,intensity: integer;
    782 begin
    783 for x:=0 to 9 do for y:=0 to 9 do
    784   if GrExt[HGrSystem].Mask.Canvas.Pixels[66+x,47+y]=0 then
    785     begin
    786     intensity:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,47+y] and $FF;
    787     GrExt[HGrSystem].Data.Canvas.Pixels[77+x,47+y]:=
    788       T.clMark and $FF *intensity div $FF
    789       +T.clMark shr 8 and $FF *intensity div $FF shl 8
    790       +T.clMark shr 16 and $FF *intensity div $FF shl 16
    791     end;
    792 bitblt(GrExt[HGrSystem].Mask.Canvas.Handle,77,47,10,10,
    793   GrExt[HGrSystem].Mask.Canvas.Handle,66,47,SRCCOPY);
    794 end;
    795 
    796 procedure Fill(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer);
    797 begin
    798 assert((left+xOffset>=0) and (left+xOffset+width<=wMainTexture)
    799   and (top+yOffset>=0) and (top+yOffset+height<=hMainTexture));
    800 bitblt(ca.handle,left,top,width,height,MainTexture.Image.Canvas.Handle,left+xOffset,top+yOffset,SRCCOPY);
    801 end;
    802 
    803 procedure FillLarge(ca: TCanvas; x0,y0,x1,y1,xm: integer);
     939  x, y, intensity: integer;
     940begin
     941  for x := 0 to 9 do
     942    for y := 0 to 9 do
     943      if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
     944      begin
     945        intensity := GrExt[HGrSystem].Data.Canvas.Pixels
     946          [66 + x, 47 + y] and $FF;
     947        GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] := T.clMark and
     948          $FF * intensity div $FF + T.clMark shr 8 and
     949          $FF * intensity div $FF shl 8 + T.clMark shr 16 and
     950          $FF * intensity div $FF shl 16
     951      end;
     952  BitBlt(GrExt[HGrSystem].Mask.Canvas.Handle, 77, 47, 10, 10,
     953    GrExt[HGrSystem].Mask.Canvas.Handle, 66, 47, SRCCOPY);
     954end;
     955
     956procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
     957  yOffset: integer);
     958begin
     959  assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
     960    (Top + yOffset >= 0) and (Top + yOffset + Height <= hMainTexture));
     961  BitBlt(ca.Handle, Left, Top, Width, Height, MainTexture.Image.Canvas.Handle,
     962    Left + xOffset, Top + yOffset, SRCCOPY);
     963end;
     964
     965procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    804966
    805967  function band(i: integer): integer;
    806968  var
    807   n: integer;
    808   begin
    809   n:=((hMainTexture div 2) div (y1-y0))*2;
    810   while hMainTexture div 2+(i+1)*(y1-y0)>hMainTexture do
    811     dec(i,n);
    812   while hMainTexture div 2+i*(y1-y0)<0 do
    813     inc(i,n);
    814   result:=i;
    815   end;
    816 
    817 var
    818 i: integer;
    819 begin
    820 for i:=0 to (x1-xm) div wMainTexture-1 do
    821   bitblt(ca.handle,xm+i*wMainTexture,y0,wMainTexture,y1-y0,
    822     MainTexture.Image.canvas.handle,0,hMainTexture div 2+band(i)*(y1-y0),SRCCOPY);
    823 bitblt(ca.handle,xm+((x1-xm) div wMainTexture)*wMainTexture,y0,
    824   x1-(xm+((x1-xm) div wMainTexture)*wMainTexture),y1-y0,
    825   MainTexture.Image.canvas.handle,0,
    826   hMainTexture div 2+band((x1-xm) div wMainTexture)*(y1-y0),SRCCOPY);
    827 for i:=0 to (xm-x0) div wMainTexture-1 do
    828   bitblt(ca.handle,xm-(i+1)*wMainTexture,y0,wMainTexture,y1-y0,
    829   MainTexture.Image.canvas.handle,0,hMainTexture div 2+band(-i-1)*(y1-y0),SRCCOPY);
    830 bitblt(ca.handle,x0,y0,xm-((xm-x0) div wMainTexture)*wMainTexture-x0,y1-y0,
    831   MainTexture.Image.canvas.handle,((xm-x0) div wMainTexture+1)*wMainTexture-(xm-x0),
    832   hMainTexture div 2+band(-(xm-x0) div wMainTexture-1)*(y1-y0),SRCCOPY);
    833 end;
    834 
    835 procedure FillSeamless(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer;
    836   const Texture: TBitmap);
    837 var
    838 x,y,x0cut,y0cut,x1cut,y1cut: integer;
    839 begin
    840 while xOffset<0 do inc(xOffset,Texture.Width);
    841 while yOffset<0 do inc(yOffset,Texture.Height);
    842 for y:=(Top+yOffset) div Texture.Height to (Top+yOffset+Height-1) div Texture.Height do
    843   begin
    844   y0cut:=Top+yOffset-y*Texture.Height;
    845   if y0cut<0 then y0cut:=0;
    846   y1cut:=(y+1)*Texture.Height-(Top+yOffset+Height);
    847   if y1cut<0 then y1cut:=0;
    848   for x:=(Left+xOffset) div Texture.Width to (Left+xOffset+Width-1) div Texture.Width do
    849     begin
    850     x0cut:=Left+xOffset-x*Texture.Width;
    851     if x0cut<0 then x0cut:=0;
    852     x1cut:=(x+1)*Texture.Width-(Left+xOffset+Width);
    853     if x1cut<0 then x1cut:=0;
    854     BitBlt(ca.Handle,x*Texture.Width+x0cut-xOffset,y*Texture.Height+y0cut-yOffset,
    855       Texture.Width-x0cut-x1cut,Texture.Height-y0cut-y1cut,
    856       Texture.Canvas.Handle,x0cut,y0cut,SRCCOPY);
     969    n: integer;
     970  begin
     971    n := ((hMainTexture div 2) div (y1 - y0)) * 2;
     972    while hMainTexture div 2 + (i + 1) * (y1 - y0) > hMainTexture do
     973      dec(i, n);
     974    while hMainTexture div 2 + i * (y1 - y0) < 0 do
     975      inc(i, n);
     976    result := i;
     977  end;
     978
     979var
     980  i: integer;
     981begin
     982  for i := 0 to (x1 - xm) div wMainTexture - 1 do
     983    BitBlt(ca.Handle, xm + i * wMainTexture, y0, wMainTexture, y1 - y0,
     984      MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(i) *
     985      (y1 - y0), SRCCOPY);
     986  BitBlt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
     987    x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0,
     988    MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 +
     989    band((x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY);
     990  for i := 0 to (xm - x0) div wMainTexture - 1 do
     991    BitBlt(ca.Handle, xm - (i + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
     992      MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(-i - 1) *
     993      (y1 - y0), SRCCOPY);
     994  BitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) * wMainTexture -
     995    x0, y1 - y0, MainTexture.Image.Canvas.Handle,
     996    ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0),
     997    hMainTexture div 2 + band(-(xm - x0) div wMainTexture - 1) *
     998    (y1 - y0), SRCCOPY);
     999end;
     1000
     1001procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
     1002  yOffset: integer; const Texture: TBitmap);
     1003var
     1004  x, y, x0cut, y0cut, x1cut, y1cut: integer;
     1005begin
     1006  while xOffset < 0 do
     1007    inc(xOffset, Texture.Width);
     1008  while yOffset < 0 do
     1009    inc(yOffset, Texture.Height);
     1010  for y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1)
     1011    div Texture.Height do
     1012  begin
     1013    y0cut := Top + yOffset - y * Texture.Height;
     1014    if y0cut < 0 then
     1015      y0cut := 0;
     1016    y1cut := (y + 1) * Texture.Height - (Top + yOffset + Height);
     1017    if y1cut < 0 then
     1018      y1cut := 0;
     1019    for x := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1)
     1020      div Texture.Width do
     1021    begin
     1022      x0cut := Left + xOffset - x * Texture.Width;
     1023      if x0cut < 0 then
     1024        x0cut := 0;
     1025      x1cut := (x + 1) * Texture.Width - (Left + xOffset + Width);
     1026      if x1cut < 0 then
     1027        x1cut := 0;
     1028      BitBlt(ca.Handle, x * Texture.Width + x0cut - xOffset,
     1029        y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,
     1030        Texture.Height - y0cut - y1cut, Texture.Canvas.Handle, x0cut,
     1031        y0cut, SRCCOPY);
    8571032    end
    8581033  end;
    8591034end;
    8601035
    861 procedure FillRectSeamless(ca: TCanvas;x0,y0,x1,y1,xOffset,yOffset: integer;
    862   const Texture: TBitmap);
    863 begin
    864 FillSeamless(ca,x0,y0,x1-x0,y1-y0,xOffset,yOffset,Texture);
    865 end;
    866 
    867 procedure PaintBackground(Form: TForm; Left,Top,Width,Height: integer);
    868 begin
    869 Fill(Form.Canvas,Left,Top,Width,Height,(wMaintexture-Form.ClientWidth) div 2,
    870   (hMaintexture-Form.ClientHeight) div 2);
    871 end;
    872 
    873 procedure Corner(ca: TCanvas; x,y,Kind:integer; const T: TTexture);
    874 begin
    875 {BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
    876   T.xGr+29+Kind*9,T.yGr+89,SRCAND);
    877 BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle,
    878   T.xGr+29+Kind*9,T.yGr+89,SRCPAINT);}
    879 end;
    880 
    881 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor;
    882   x,y:integer; s:string);
    883 
    884   procedure PaintIcon(x,y,Kind: integer);
    885   begin
    886   BitBlt(ca.Handle,x,y+6,10,10,GrExt[HGrSystem].Mask.Canvas.Handle,
    887     66+Kind mod 11 *11,115+Kind div 11 *11,SRCAND);
    888   BitBlt(ca.Handle,x,y+6,10,10,GrExt[HGrSystem].Data.Canvas.Handle,
    889     66+Kind mod 11 *11,115+Kind div 11 *11,SRCPAINT);
    890   end;
    891 
    892 var
    893 p,xp: integer;
    894 sp: string;
    895 shadow: boolean;
    896 begin
    897 inc(x); inc(y);
    898 for shadow:=true downto false do with ca do
    899   if not shadow or (clBack<>$7F007F) then
    900     begin
    901     if shadow then Font.Color:=clBack
    902     else Font.Color:=clMain;
    903     sp:=s;
    904     xp:=x;
     1036procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset,
     1037  yOffset: integer; const Texture: TBitmap);
     1038begin
     1039  FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
     1040end;
     1041
     1042procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
     1043begin
     1044  Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth)
     1045    div 2, (hMainTexture - Form.ClientHeight) div 2);
     1046end;
     1047
     1048procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
     1049begin
     1050  { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
     1051    T.xGr+29+Kind*9,T.yGr+89,SRCAND);
     1052    BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle,
     1053    T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); }
     1054end;
     1055
     1056procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
     1057  s: string);
     1058
     1059  procedure PaintIcon(x, y, Kind: integer);
     1060  begin
     1061    BitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas.Handle,
     1062      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND);
     1063    BitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas.Handle,
     1064      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT);
     1065  end;
     1066
     1067var
     1068  p, xp: integer;
     1069  sp: string;
     1070  shadow: boolean;
     1071begin
     1072  inc(x);
     1073  inc(y);
     1074  for shadow := true downto false do
     1075    with ca do
     1076      if not shadow or (clBack <> $7F007F) then
     1077      begin
     1078        if shadow then
     1079          Font.Color := clBack
     1080        else
     1081          Font.Color := clMain;
     1082        sp := s;
     1083        xp := x;
     1084        repeat
     1085          p := pos('%', sp);
     1086          if (p = 0) or (p + 1 > Length(sp)) or
     1087            not(sp[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
     1088          then
     1089          begin
     1090            ca.Textout(xp, y, sp);
     1091            break
     1092          end
     1093          else
     1094          begin
     1095            Textout(xp, y, copy(sp, 1, p - 1));
     1096            inc(xp, ca.TextWidth(copy(sp, 1, p - 1)));
     1097            if not shadow then
     1098              case sp[p + 1] of
     1099                'c':
     1100                  PaintIcon(xp + 1, y, 6);
     1101                'f':
     1102                  PaintIcon(xp + 1, y, 0);
     1103                'l':
     1104                  PaintIcon(xp + 1, y, 8);
     1105                'm':
     1106                  PaintIcon(xp + 1, y, 17);
     1107                'n':
     1108                  PaintIcon(xp + 1, y, 7);
     1109                'o':
     1110                  PaintIcon(xp + 1, y, 16);
     1111                'p':
     1112                  PaintIcon(xp + 1, y, 2);
     1113                'r':
     1114                  PaintIcon(xp + 1, y, 12);
     1115                't':
     1116                  PaintIcon(xp + 1, y, 4);
     1117                'w':
     1118                  PaintIcon(xp + 1, y, 13);
     1119              end;
     1120            inc(xp, 10);
     1121            Delete(sp, 1, p + 1);
     1122          end
     1123          until false;
     1124          dec(x);
     1125          dec(y);
     1126        end
     1127      end;
     1128
     1129  function BiColorTextWidth(ca: TCanvas; s: string): integer;
     1130  var
     1131    p: integer;
     1132  begin
     1133    result := 1;
    9051134    repeat
    906       p:=pos('%',sp);
    907       if (p=0) or (p+1>length(sp))
    908         or not (sp[p+1] in ['c','f','l','m','n','o','p','r','t','w']) then
    909         begin ca.Textout(xp,y,sp); break end
     1135      p := pos('%', s);
     1136      if (p = 0) or (p = Length(s)) then
     1137      begin
     1138        inc(result, ca.TextWidth(s));
     1139        break
     1140      end
    9101141      else
     1142      begin
     1143        if not(s[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
     1144        then
     1145          inc(result, ca.TextWidth(copy(s, 1, p + 1)))
     1146        else
     1147          inc(result, ca.TextWidth(copy(s, 1, p - 1)) + 10);
     1148        Delete(s, 1, p + 1);
     1149      end
     1150      until false;
     1151    end;
     1152
     1153    procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     1154      x, y: integer; s: string);
     1155    begin
     1156      if cl = -2 then
     1157        BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1,
     1158          T.clBevelLight, x, y, s)
     1159      else if cl < 0 then
     1160        BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s)
     1161      else
     1162        BiColorTextOut(ca, cl, T.clTextLight, x, y, s)
     1163    end;
     1164
     1165    procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     1166    begin
     1167      BiColorTextOut(ca, $FFFFFF, $000000, x, y, s)
     1168    end;
     1169
     1170    procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: integer;
     1171      Brightness: array of integer);
     1172    var
     1173      i, r, g, b: integer;
     1174    begin
     1175      with ca do
     1176      begin
     1177        for i := 0 to 15 do
     1178        begin // gradient
     1179          r := Color and $FF + Brightness[i];
     1180          if r < 0 then
     1181            r := 0
     1182          else if r >= 256 then
     1183            r := 255;
     1184          g := Color shr 8 and $FF + Brightness[i];
     1185          if g < 0 then
     1186            g := 0
     1187          else if g >= 256 then
     1188            g := 255;
     1189          b := Color shr 16 and $FF + Brightness[i];
     1190          if b < 0 then
     1191            b := 0
     1192          else if b >= 256 then
     1193            b := 255;
     1194          Pen.Color := r + g shl 8 + b shl 16;
     1195          MoveTo(x + dx * i, y + dy * i);
     1196          LineTo(x + dx * i + Width, y + dy * i + Height);
     1197        end;
     1198        Pen.Color := $000000;
     1199        MoveTo(x + 1, y + 16 * dy + Height);
     1200        LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
     1201        LineTo(x + 16 * dx + Width, y);
     1202      end
     1203    end;
     1204
     1205    procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     1206    const
     1207      Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12,
     1208        -16, -20, -24, -28, -32, -36, -40, -44);
     1209    begin
     1210      Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness)
     1211    end;
     1212
     1213    procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     1214    const
     1215      Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8,
     1216        -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
     1217    begin
     1218      Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels
     1219        [187, 137 + Kind], Brightness)
     1220    end;
     1221
     1222    procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     1223    const
     1224      Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12,
     1225        -16, -20, -24, -28, -32, -36, -40, -44);
     1226    begin
     1227      Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness)
     1228    end;
     1229
     1230    procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     1231    const
     1232      Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8,
     1233        -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
     1234    begin
     1235      Gradient(ca, x, y, 1, 0, 0, Height, GrExt[HGrSystem].Data.Canvas.Pixels
     1236        [187, 137 + Kind], Brightness)
     1237    end;
     1238
     1239    procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     1240      const T: TTexture);
     1241    var
     1242      s: string;
     1243    begin
     1244      if val > 0 then
     1245      begin
     1246        DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade,
     1247          T.clBevelLight);
     1248        LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);
     1249        s := IntToStr(val);
     1250        RisedTextOut(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas,
     1251          s), y, s);
     1252      end
     1253    end;
     1254
     1255    procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     1256      Cap: string; val: integer; const T: TTexture);
     1257    var
     1258      i, sd, ld, cl, xIcon, yIcon: integer;
     1259      s: string;
     1260    begin
     1261      // val:=random(40); //!!!
     1262      if val = 0 then
     1263        exit;
     1264      assert(Kind >= 0);
     1265      with dst.Canvas do
     1266      begin
     1267        // xIcon:=x+100;
     1268        // yIcon:=y;
     1269        // DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight);
     1270
     1271        xIcon := x - 5;
     1272        yIcon := y + 15;
     1273        DLine(dst.Canvas, x - 2, xIcon + w + 2, yIcon + 16, T.clBevelShade,
     1274          T.clBevelLight);
     1275
     1276        s := IntToStr(val);
     1277        if val < 0 then
     1278          cl := $0000FF
     1279        else
     1280          cl := -1;
     1281        LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);
     1282        LoweredTextOut(dst.Canvas, cl, T,
     1283          xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);
     1284
     1285        if (Kind = 12) and (val >= 100) then
     1286        begin // science with symbol for 100
     1287          val := val div 10;
     1288          sd := 14 * (val div 10 + val mod 10 - 1);
     1289          if sd = 0 then
     1290            sd := 1;
     1291          if sd < w - 44 then
     1292            ld := sd
     1293          else
     1294            ld := w - 44;
     1295          for i := 0 to val mod 10 - 1 do
     1296          begin
     1297            BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
     1298              14, GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1299              70 + Kind div 8 * 15, SRCAND);
     1300            Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
     1301              14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
     1302          end;
     1303          for i := 0 to val div 10 - 1 do
     1304          begin
     1305            BitBlt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) *
     1306              (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
     1307              GrExt[HGrSystem].Mask.Canvas.Handle, 67 + 7 mod 8 * 15,
     1308              70 + 7 div 8 * 15, SRCAND);
     1309            Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * (14 * ld div sd) +
     1310              i * (14 * ld div sd), yIcon + 2, 14, 14, 67 + 7 mod 8 * 15,
     1311              70 + 7 div 8 * 15);
     1312          end;
     1313        end
     1314        else
    9111315        begin
    912         Textout(xp,y,copy(sp,1,p-1));
    913         inc(xp,ca.TextWidth(copy(sp,1,p-1)));
    914         if not shadow then
    915           case sp[p+1] of
    916             'c': PaintIcon(xp+1,y,6);
    917             'f': PaintIcon(xp+1,y,0);
    918             'l': PaintIcon(xp+1,y,8);
    919             'm': PaintIcon(xp+1,y,17);
    920             'n': PaintIcon(xp+1,y,7);
    921             'o': PaintIcon(xp+1,y,16);
    922             'p': PaintIcon(xp+1,y,2);
    923             'r': PaintIcon(xp+1,y,12);
    924             't': PaintIcon(xp+1,y,4);
    925             'w': PaintIcon(xp+1,y,13);
    926             end;
    927         inc(xp,10);
    928         delete(sp,1,p+1);
     1316          val := abs(val);
     1317          if val mod 10 = 0 then
     1318            sd := 14 * (val div 10 - 1)
     1319          else
     1320            sd := 10 * (val mod 10 - 1) + 14 * (val div 10);
     1321          if sd = 0 then
     1322            sd := 1;
     1323          if sd < w - 44 then
     1324            ld := sd
     1325          else
     1326            ld := w - 44;
     1327          for i := 0 to val div 10 - 1 do
     1328          begin
     1329            BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
     1330              GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1331              70 + Kind div 8 * 15, SRCAND);
     1332            Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
     1333              14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
     1334          end;
     1335          for i := 0 to val mod 10 - 1 do
     1336          begin
     1337            BitBlt(dst.Canvas.Handle, xIcon + 4 + (val div 10) *
     1338              (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
     1339              GrExt[HGrSystem].Mask.Canvas.Handle, 66 + Kind mod 11 * 11,
     1340              115 + Kind div 11 * 11, SRCAND);
     1341            Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * (14 * ld div sd) +
     1342              i * (10 * ld div sd), yIcon + 6, 10, 10, 66 + Kind mod 11 * 11,
     1343              115 + Kind div 11 * 11)
     1344          end;
    9291345        end
    930     until false;
    931     dec(x); dec(y);
    932     end
    933 end;
    934 
    935 function BiColorTextWidth(ca: TCanvas; s: string): integer;
    936 var
    937 p: integer;
    938 begin
    939 result:=1;
    940 repeat
    941   p:=pos('%',s);
    942   if (p=0) or (p=Length(s)) then
    943     begin inc(result,ca.TextWidth(s)); break end
    944   else
    945     begin
    946     if not (s[p+1] in ['c','f','l','m','n','o','p','r','t','w']) then
    947       inc(result,ca.TextWidth(copy(s,1,p+1)))
    948     else inc(result,ca.TextWidth(copy(s,1,p-1))+10);
    949     delete(s,1,p+1);
    950     end
    951 until false;
    952 end;
    953 
    954 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    955   x,y:integer; s:string);
    956 begin
    957 if cl=-2 then
    958   BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1, T.clBevelLight, x, y, s)
    959 else if cl<0 then
    960   BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s)
    961 else BiColorTextOut(ca, cl, T.clTextLight, x, y, s)
    962 end;
    963 
    964 procedure RisedTextOut(ca: TCanvas; x,y:integer; s:string);
    965 begin
    966 BiColorTextOut(ca, $FFFFFF, $000000, x, y, s)
    967 end;
    968 
    969 procedure Gradient(ca: TCanvas; x,y,dx,dy,width,height,Color:integer; Brightness: array of integer);
    970 var
    971 i,r,g,b: integer;
    972 begin
    973 with ca do
    974   begin
    975   for i:=0 to 15 do
    976     begin // gradient
    977     r:=Color and $FF+Brightness[i];
    978     if r<0 then r:=0
    979     else if r>=256 then r:=255;
    980     g:=Color shr 8 and $FF+Brightness[i];
    981     if g<0 then g:=0
    982     else if g>=256 then g:=255;
    983     b:=Color shr 16 and $FF+Brightness[i];
    984     if b<0 then b:=0
    985     else if b>=256 then b:=255;
    986     pen.color:=r+g shl 8+b shl 16;
    987     MoveTo(x+dx*i,y+dy*i);
    988     LineTo(x+dx*i+width,y+dy*i+height);
    989     end;
    990   pen.color:=$000000;
    991   MoveTo(x+1,y+16*dy+height);
    992   LineTo(x+16*dx+width,y+16*dy+height);
    993   LineTo(x+16*dx+width,y);
    994   end
    995 end;
    996 
    997 procedure LightGradient(ca: TCanvas; x,y,width,Color:integer);
    998 const
    999 Brightness: array[0..15] of integer=
    1000 (16,12,8,4,0,-4,-8,-12,-16,-20,-24,-28,-32,-36,-40,-44);
    1001 begin
    1002 Gradient(ca,x,y,0,1,width,0,Color,Brightness)
    1003 end;
    1004 
    1005 procedure DarkGradient(ca: TCanvas; x,y,width,Kind:integer);
    1006 const
    1007 Brightness: array[0..15] of integer=
    1008 (16,12,8,4,0,-4,-8,-12-24,-16+16,-20,-24,-28,-32,-36,-40,-44);
    1009 begin
    1010 Gradient(ca,x,y,0,1,width,0,
    1011   GrExt[HGrSystem].Data.Canvas.Pixels[187,137+Kind],Brightness)
    1012 end;
    1013 
    1014 procedure VLightGradient(ca: TCanvas; x,y,height,Color:integer);
    1015 const
    1016 Brightness: array[0..15] of integer=
    1017 (16,12,8,4,0,-4,-8,-12,-16,-20,-24,-28,-32,-36,-40,-44);
    1018 begin
    1019 Gradient(ca,x,y,1,0,0,height,Color,Brightness)
    1020 end;
    1021 
    1022 procedure VDarkGradient(ca: TCanvas; x,y,height,Kind:integer);
    1023 const
    1024 Brightness: array[0..15] of integer=
    1025 (16,12,8,4,0,-4,-8,-12-24,-16+16,-20,-24,-28,-32,-36,-40,-44);
    1026 begin
    1027 Gradient(ca,x,y,1,0,0,height,
    1028   GrExt[HGrSystem].Data.Canvas.Pixels[187,137+Kind],Brightness)
    1029 end;
    1030 
    1031 procedure NumberBar(dst:TBitmap; x,y:integer;
    1032   Cap:string; val: integer; const T: TTexture);
    1033 var
    1034 s:string;
    1035 begin
    1036 if val>0 then
    1037   begin
    1038   DLine(dst.Canvas,x-2,x+170,y+16,T.clBevelShade,T.clBevelLight);
    1039   LoweredTextOut(dst.Canvas,-1,T,x-2,y,Cap);
    1040   s:=IntToStr(val);
    1041   RisedTextout(dst.canvas,x+170-BiColorTextWidth(dst.Canvas,s),y,s);
    1042   end
    1043 end;
    1044 
    1045 procedure CountBar(dst:TBitmap; x,y,w:integer; Kind:integer;
    1046   Cap:string; val: integer; const T: TTexture);
    1047 var
    1048 i,sd,ld,cl,xIcon,yIcon: integer;
    1049 s:string;
    1050 begin
    1051 //val:=random(40); //!!!
    1052 if val=0 then exit;
    1053 assert(Kind>=0);
    1054 with dst.Canvas do
    1055   begin
    1056 //  xIcon:=x+100;
    1057 //  yIcon:=y;
    1058 //  DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight);
    1059 
    1060   xIcon:=x-5;
    1061   yIcon:=y+15;
    1062   DLine(dst.Canvas,x-2,xIcon+w+2,yIcon+16,T.clBevelShade,T.clBevelLight);
    1063 
    1064   s:=IntToStr(val);
    1065   if val<0 then cl:=$0000FF
    1066   else cl:=-1;
    1067   LoweredTextOut(dst.Canvas,cl,T,x-2,y,Cap);
    1068   LoweredTextout(dst.canvas,cl,T,xIcon+w+2-BiColorTextWidth(dst.Canvas,s),yIcon,s);
    1069 
    1070   if (Kind=12) and (val>=100) then
    1071     begin // science with symbol for 100
    1072     val:=val div 10;
    1073     sd:=14*(val div 10+val mod 10-1);
    1074     if sd=0 then sd:=1;
    1075     if sd<w-44 then ld:=sd else ld:=w-44;
    1076     for i:=0 to val mod 10-1 do
     1346      end
     1347    end; // CountBar
     1348
     1349    procedure PaintProgressBar(ca: TCanvas;
     1350      Kind, x, y, pos, Growth, max: integer; const T: TTexture);
     1351    var
     1352      i: integer;
     1353    begin
     1354      if pos > max then
     1355        pos := max;
     1356      if Growth < 0 then
    10771357      begin
    1078       BitBlt(Handle,xIcon+4+i*(14*ld div sd),yIcon+2+1,14,14,
    1079         GrExt[HGrSystem].Mask.Canvas.Handle,
    1080         67+Kind mod 8 *15,70+Kind div 8 *15,SRCAND);
    1081       Sprite(dst,HGrSystem,xIcon+3+i*(14*ld div sd),yIcon+2,14,14,
    1082         67+Kind mod 8 *15,70+Kind div 8 *15);
    1083       end;
    1084     for i:=0 to val div 10-1 do
     1358        pos := pos + Growth;
     1359        if pos < 0 then
     1360        begin
     1361          Growth := Growth - pos;
     1362          pos := 0
     1363        end
     1364      end
     1365      else if pos + Growth > max then
     1366        Growth := max - pos;
     1367      Frame(ca, x - 1, y - 1, x + max, y + 7, $000000, $000000);
     1368      RFrame(ca, x - 2, y - 2, x + max + 1, y + 8, T.clBevelShade,
     1369        T.clBevelLight);
     1370      with ca do
    10851371      begin
    1086       BitBlt(dst.Canvas.Handle,xIcon+4+(val mod 10)*(14*ld div sd)
    1087         +i*(14*ld div sd),yIcon+3,14,14,
    1088         GrExt[HGrSystem].Mask.Canvas.Handle,67+7 mod 8 *15,70+7 div 8 *15,
    1089         SRCAND);
    1090       Sprite(dst,HGrSystem,xIcon+3+(val mod 10)*(14*ld div sd)
    1091         +i*(14*ld div sd),yIcon+2,14,14,67+7 mod 8 *15,70+7 div 8 *15);
    1092       end;
    1093     end
    1094   else
    1095     begin
    1096     val:=abs(val);
    1097     if val mod 10=0 then sd:=14*(val div 10-1)
    1098     else sd:=10*(val mod 10-1)+14*(val div 10);
    1099     if sd=0 then sd:=1;
    1100     if sd<w-44 then ld:=sd else ld:=w-44;
    1101     for i:=0 to val div 10-1 do
    1102       begin
    1103       BitBlt(Handle,xIcon+4+i*(14*ld div sd),yIcon+3,14,14,
    1104         GrExt[HGrSystem].Mask.Canvas.Handle,67+Kind mod 8 *15,70+Kind div 8 *15,SRCAND);
    1105       Sprite(dst,HGrSystem,xIcon+3+i*(14*ld div sd),yIcon+2,14,14,67+Kind mod 8 *15,
    1106         70+Kind div 8 *15);
    1107       end;
    1108     for i:=0 to val mod 10-1 do
    1109       begin
    1110       BitBlt(dst.Canvas.Handle,xIcon+4+(val div 10)*(14*ld div sd)
    1111         +i*(10*ld div sd),yIcon+7,10,10,GrExt[HGrSystem].Mask.Canvas.Handle,
    1112         66+Kind mod 11 *11,115+Kind div 11 *11,SRCAND);
    1113       Sprite(dst,HGrSystem,xIcon+3+(val div 10)*(14*ld div sd)
    1114         +i*(10*ld div sd),yIcon+6,10,10,66+Kind mod 11 *11,115+Kind div 11 *11)
    1115       end;
    1116     end
    1117   end
    1118 end; //CountBar
    1119 
    1120 procedure PaintProgressBar(ca: TCanvas; Kind,x,y,pos,Growth,max: integer;
    1121   const T: TTexture);
    1122 var
    1123 i: integer;
    1124 begin
    1125 if pos>max then pos:=max;
    1126 if Growth<0 then
    1127   begin
    1128   pos:=pos+Growth;
    1129   if pos<0 then begin Growth:=Growth-pos; pos:=0 end
    1130   end
    1131 else if pos+Growth>max then Growth:=max-pos;
    1132 Frame(ca,x-1,y-1,x+max,y+7,$000000,$000000);
    1133 RFrame(ca,x-2,y-2,x+max+1,y+8,T.clBevelShade,T.clBevelLight);
    1134 with ca do
    1135   begin
    1136   for i:=0 to pos div 8-1 do
    1137     BitBlt(Handle,x+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104,
    1138       9+8*Kind,SRCCOPY);
    1139   BitBlt(Handle,x+8*(pos div 8),y,
    1140     pos-8*(pos div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,9+8*Kind,SRCCOPY);
    1141   if Growth>0 then
    1142     begin
    1143     for i:=0 to Growth div 8-1 do
    1144       BitBlt(Handle,x+pos+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,112,
    1145         9+8*Kind,SRCCOPY);
    1146     BitBlt(Handle,x+pos+8*(Growth div 8),y,
    1147       Growth-8*(Growth div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,112,
    1148       9+8*Kind,SRCCOPY);
    1149     end
    1150   else if Growth<0 then
    1151     begin
    1152     for i:=0 to -Growth div 8-1 do
    1153       BitBlt(Handle,x+pos+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104,1,
    1154         SRCCOPY);
    1155     BitBlt(Handle,x+pos+8*(-Growth div 8),y,
    1156       -Growth-8*(-Growth div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,1,
    1157       SRCCOPY);
    1158     end;
    1159   Brush.Color:=$000000;
    1160   FillRect(Rect(x+pos+abs(Growth),y,x+max,y+7));
    1161   Brush.Style:=bsClear;
    1162   end
    1163 end;
    1164 
    1165 // pos and growth are relative to max, set size independent
    1166 procedure PaintRelativeProgressBar(ca: TCanvas; Kind,x,y,size,pos,Growth,
    1167   max: integer; IndicateComplete: boolean; const T: TTexture);
    1168 begin
    1169 if Growth>0 then
    1170   PaintProgressBar(ca,Kind,x,y,pos*size div max,
    1171     (Growth*size+max div 2) div max,size,T)
    1172 else PaintProgressBar(ca,Kind,x,y,pos*size div max,
    1173   (Growth*size-max div 2) div max,size,T);
    1174 if IndicateComplete and (pos+Growth>=max) then
    1175   Sprite(ca, HGrSystem, x+size-10, y-7, 23, 16, 1, 129);
    1176 end;
    1177 
    1178 procedure PaintLogo(ca: TCanvas; x,y,clLight,clShade: integer);
    1179 begin
    1180 BitBlt(LogoBuffer.Canvas.Handle,0,0,wLogo,hLogo,ca.handle,x,y,SRCCOPY);
    1181 ImageOp_BCC(LogoBuffer,Templates,0,0,1,1,wLogo,hLogo,clLight,clShade);
    1182 BitBlt(ca.handle,x,y,wLogo,hLogo,LogoBuffer.Canvas.Handle,0,0,SRCCOPY);
    1183 end;
    1184 
    1185 function SetMainTextureByAge(Age: integer): boolean;
    1186 begin
    1187 if Age<>MainTextureAge then with MainTexture do
    1188   begin
    1189   MainTextureAge:=Age;
    1190   LoadGraphicFile(Image,HomeDir+'Graphics\Texture'+inttostr(Age+1), gfJPG);
    1191   clBevelLight:=Colors.Canvas.Pixels[clkAge0+Age,cliBevelLight];
    1192   clBevelShade:=Colors.Canvas.Pixels[clkAge0+Age,cliBevelShade];
    1193   clTextLight:=Colors.Canvas.Pixels[clkAge0+Age,cliTextLight];
    1194   clTextShade:=Colors.Canvas.Pixels[clkAge0+Age,cliTextShade];
    1195   clLitText:=Colors.Canvas.Pixels[clkAge0+Age,cliLitText];
    1196   clMark:=Colors.Canvas.Pixels[clkAge0+Age,cliMark];
    1197   clPage:=Colors.Canvas.Pixels[clkAge0+Age,cliPage];
    1198   clCover:=Colors.Canvas.Pixels[clkAge0+Age,cliCover];
    1199   result:=true
    1200   end
    1201 else result:=false
    1202 end;
    1203 
    1204 
    1205 var
    1206 i,p,size: integer;
    1207 s: string;
    1208 fontscript: TextFile;
    1209 section: TFontType;
    1210 Reg: TRegistry;
     1372        for i := 0 to pos div 8 - 1 do
     1373          BitBlt(Handle, x + i * 8, y, 8, 7,
     1374            GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
     1375        BitBlt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
     1376          GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
     1377        if Growth > 0 then
     1378        begin
     1379          for i := 0 to Growth div 8 - 1 do
     1380            BitBlt(Handle, x + pos + i * 8, y, 8, 7,
     1381              GrExt[HGrSystem].Data.Canvas.Handle, 112, 9 + 8 * Kind, SRCCOPY);
     1382          BitBlt(Handle, x + pos + 8 * (Growth div 8), y,
     1383            Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas.Handle,
     1384            112, 9 + 8 * Kind, SRCCOPY);
     1385        end
     1386        else if Growth < 0 then
     1387        begin
     1388          for i := 0 to -Growth div 8 - 1 do
     1389            BitBlt(Handle, x + pos + i * 8, y, 8, 7,
     1390              GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
     1391          BitBlt(Handle, x + pos + 8 * (-Growth div 8), y,
     1392            -Growth - 8 * (-Growth div 8), 7,
     1393            GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
     1394        end;
     1395        Brush.Color := $000000;
     1396        FillRect(Rect(x + pos + abs(Growth), y, x + max, y + 7));
     1397        Brush.Style := bsClear;
     1398      end
     1399    end;
     1400
     1401    // pos and growth are relative to max, set size independent
     1402    procedure PaintRelativeProgressBar(ca: TCanvas;
     1403      Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
     1404      const T: TTexture);
     1405    begin
     1406      if Growth > 0 then
     1407        PaintProgressBar(ca, Kind, x, y, pos * size div max,
     1408          (Growth * size + max div 2) div max, size, T)
     1409      else
     1410        PaintProgressBar(ca, Kind, x, y, pos * size div max,
     1411          (Growth * size - max div 2) div max, size, T);
     1412      if IndicateComplete and (pos + Growth >= max) then
     1413        Sprite(ca, HGrSystem, x + size - 10, y - 7, 23, 16, 1, 129);
     1414    end;
     1415
     1416    procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     1417    begin
     1418      BitBlt(LogoBuffer.Canvas.Handle, 0, 0, wLogo, hLogo, ca.Handle, x,
     1419        y, SRCCOPY);
     1420      ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
     1421        clLight, clShade);
     1422      BitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0,
     1423        0, SRCCOPY);
     1424    end;
     1425
     1426    function SetMainTextureByAge(Age: integer): boolean;
     1427    begin
     1428      if Age <> MainTextureAge then
     1429        with MainTexture do
     1430        begin
     1431          MainTextureAge := Age;
     1432          LoadGraphicFile(Image, HomeDir + 'Graphics\Texture' +
     1433            IntToStr(Age + 1), gfJPG);
     1434          clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
     1435          clBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
     1436          clTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
     1437          clTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
     1438          clLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
     1439          clMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
     1440          clPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
     1441          clCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
     1442          result := true
     1443        end
     1444      else
     1445        result := false
     1446    end;
     1447
     1448    var
     1449      i, p, size: integer;
     1450      s: string;
     1451      fontscript: TextFile;
     1452      section: TFontType;
     1453      Reg: TRegistry;
    12111454
    12121455initialization
    1213 Reg:=TRegistry.Create;
    1214 Reg.OpenKey('SOFTWARE\cevo\RegVer9',true);
     1456
     1457Reg := TRegistry.create;
     1458Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
    12151459try
    1216   Gamma:=Reg.ReadInteger('Gamma');
     1460  Gamma := Reg.ReadInteger('Gamma');
    12171461except
    1218   Gamma:=100;
    1219   Reg.WriteInteger('Gamma',Gamma);
    1220   end;
     1462  Gamma := 100;
     1463  Reg.WriteInteger('Gamma', Gamma);
     1464end;
    12211465Reg.closekey;
    12221466Reg.Free;
    12231467
    1224 if Gamma<>100 then
    1225   begin
    1226   GammaLUT[0]:=0;
    1227   for i:=1 to 255 do
    1228     begin
    1229     p:=round(255.0*exp(ln(i/255.0)*100.0/Gamma));
    1230     assert((p>=0) and (p<256));
    1231     GammaLUT[i]:=p;
    1232     end;
    1233   end;
     1468if Gamma <> 100 then
     1469begin
     1470  GammaLUT[0] := 0;
     1471  for i := 1 to 255 do
     1472  begin
     1473    p := round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma));
     1474    assert((p >= 0) and (p < 256));
     1475    GammaLUT[i] := p;
     1476  end;
     1477end;
    12341478
    12351479EnumDisplaySettings(nil, $FFFFFFFF, StartResolution);
    1236 ResolutionChanged:=false;
    1237 
    1238 Phrases:=TStringTable.Create;
    1239 Phrases2:=TStringTable.Create;
    1240 Phrases2FallenBackToEnglish:=false;
    1241 if FileExists(DataDir+'Localization\Language.txt') then
    1242   begin
    1243   Phrases.LoadFromFile(DataDir+'Localization\Language.txt');
    1244   if FileExists(DataDir+'Localization\Language2.txt') then
    1245     Phrases2.LoadFromFile(DataDir+'Localization\Language2.txt')
     1480ResolutionChanged := false;
     1481
     1482Phrases := TStringTable.create;
     1483Phrases2 := TStringTable.create;
     1484Phrases2FallenBackToEnglish := false;
     1485if FileExists(DataDir + 'Localization\Language.txt') then
     1486begin
     1487  Phrases.loadfromfile(DataDir + 'Localization\Language.txt');
     1488  if FileExists(DataDir + 'Localization\Language2.txt') then
     1489    Phrases2.loadfromfile(DataDir + 'Localization\Language2.txt')
    12461490  else
    1247     begin
    1248     Phrases2.LoadFromFile(HomeDir+'Language2.txt');
    1249     Phrases2FallenBackToEnglish:=true;
    1250     end
    1251   end
     1491  begin
     1492    Phrases2.loadfromfile(HomeDir + 'Language2.txt');
     1493    Phrases2FallenBackToEnglish := true;
     1494  end
     1495end
    12521496else
    1253   begin
    1254   Phrases.LoadFromFile(HomeDir+'Language.txt');
    1255   Phrases2.LoadFromFile(HomeDir+'Language2.txt');
    1256   end;
    1257 Sounds:=TStringTable.Create;
    1258 if not Sounds.LoadFromFile(HomeDir+'Sounds\sound.txt') then
    1259   begin Sounds.Free; Sounds:=nil end;
    1260 
    1261 for section:=Low(TFontType) to High(TFontType) do
    1262   UniFont[section]:=TFont.Create;
    1263 
    1264 LogoBuffer:=TBitmap.Create;
    1265 LogoBuffer.PixelFormat:=pf24bit;
    1266 LogoBuffer.Width:=wBBook;
    1267 LogoBuffer.Height:=hBBook;
    1268 
    1269 section:=ftNormal;
    1270 AssignFile(fontscript,LocalizedFilePath('Fonts.txt'));
     1497begin
     1498  Phrases.loadfromfile(HomeDir + 'Language.txt');
     1499  Phrases2.loadfromfile(HomeDir + 'Language2.txt');
     1500end;
     1501Sounds := TStringTable.create;
     1502if not Sounds.loadfromfile(HomeDir + 'Sounds\sound.txt') then
     1503begin
     1504  Sounds.Free;
     1505  Sounds := nil
     1506end;
     1507
     1508for section := Low(TFontType) to High(TFontType) do
     1509  UniFont[section] := TFont.create;
     1510
     1511LogoBuffer := TBitmap.create;
     1512LogoBuffer.PixelFormat := pf24bit;
     1513LogoBuffer.Width := wBBook;
     1514LogoBuffer.Height := hBBook;
     1515
     1516section := ftNormal;
     1517AssignFile(fontscript, LocalizedFilePath('Fonts.txt'));
    12711518try
    12721519  Reset(fontscript);
    12731520  while not eof(fontscript) do
    1274     begin
    1275     ReadLn(fontscript,s);
    1276     if s<>'' then
    1277       if s[1]='#' then
     1521  begin
     1522    ReadLn(fontscript, s);
     1523    if s <> '' then
     1524      if s[1] = '#' then
     1525      begin
     1526        s := TrimRight(s);
     1527        if s = '#SMALL' then
     1528          section := ftSmall
     1529        else if s = '#TINY' then
     1530          section := ftTiny
     1531        else if s = '#CAPTION' then
     1532          section := ftCaption
     1533        else if s = '#BUTTON' then
     1534          section := ftButton
     1535        else
     1536          section := ftNormal;
     1537      end
     1538      else
     1539      begin
     1540        p := pos(',', s);
     1541        if p > 0 then
    12781542        begin
    1279         s:=TrimRight(s);
    1280         if s='#SMALL' then section:=ftSmall
    1281         else if s='#TINY' then section:=ftTiny
    1282         else if s='#CAPTION' then section:=ftCaption
    1283         else if s='#BUTTON' then section:=ftButton
    1284         else section:=ftNormal;
     1543          UniFont[section].Name := Trim(copy(s, 1, p - 1));
     1544          size := 0;
     1545          for i := p + 1 to Length(s) do
     1546            case s[i] of
     1547              '0' .. '9':
     1548                size := size * 10 + Byte(s[i]) - 48;
     1549              'B', 'b':
     1550                UniFont[section].Style := UniFont[section].Style + [fsBold];
     1551              'I', 'i':
     1552                UniFont[section].Style := UniFont[section].Style + [fsItalic];
     1553            end;
     1554          UniFont[section].size :=
     1555            round(size * 72 / UniFont[section].PixelsPerInch);
    12851556        end
    1286       else
    1287         begin
    1288         p:=pos(',',s);
    1289         if p>0 then
    1290           begin
    1291           UniFont[section].Name:=Trim(copy(s,1,p-1));
    1292           size:=0;
    1293           for i:=p+1 to length(s) do
    1294             case s[i] of
    1295               '0'..'9': size:=size*10+byte(s[i])-48;
    1296               'B','b': UniFont[section].Style:=UniFont[section].Style+[fsBold];
    1297               'I','i': UniFont[section].Style:=UniFont[section].Style+[fsItalic];
    1298               end;
    1299           UniFont[section].Size:=Round(size * 72/UniFont[section].PixelsPerInch);
    1300           end
    1301         end
    1302     end;
     1557      end
     1558  end;
    13031559  CloseFile(fontscript);
    13041560except
    1305   end;
    1306 
    1307 nGrExt:=0;
    1308 HGrSystem:=LoadGraphicSet('System');
    1309 HGrSystem2:=LoadGraphicSet('System2');
    1310 Templates:=TBitmap.Create;
    1311 LoadGraphicFile(Templates, HomeDir+'Graphics\Templates', gfNoGamma);
    1312 Templates.PixelFormat:=pf24bit;
    1313 Colors:=TBitmap.Create;
    1314 LoadGraphicFile(Colors,HomeDir+'Graphics\Colors');
    1315 Paper:=TBitmap.Create;
    1316 LoadGraphicFile(Paper,HomeDir+'Graphics\Paper',gfJPG);
    1317 BigImp:=TBitmap.Create;
    1318 LoadGraphicFile(BigImp, HomeDir+'Graphics\Icons');
    1319 MainTexture.Image:=TBitmap.Create;
    1320 MainTextureAge:=-2;
    1321 ClickFrameColor:=GrExt[HGrSystem].Data.Canvas.Pixels[187,175];
    1322 InitOrnamentDone:=false;
    1323 GenerateNames:=true;
     1561end;
     1562
     1563nGrExt := 0;
     1564HGrSystem := LoadGraphicSet('System');
     1565HGrSystem2 := LoadGraphicSet('System2');
     1566Templates := TBitmap.create;
     1567LoadGraphicFile(Templates, HomeDir + 'Graphics\Templates', gfNoGamma);
     1568Templates.PixelFormat := pf24bit;
     1569Colors := TBitmap.create;
     1570LoadGraphicFile(Colors, HomeDir + 'Graphics\Colors');
     1571Paper := TBitmap.create;
     1572LoadGraphicFile(Paper, HomeDir + 'Graphics\Paper', gfJPG);
     1573BigImp := TBitmap.create;
     1574LoadGraphicFile(BigImp, HomeDir + 'Graphics\Icons');
     1575MainTexture.Image := TBitmap.create;
     1576MainTextureAge := -2;
     1577ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];
     1578InitOrnamentDone := false;
     1579GenerateNames := true;
    13241580
    13251581finalization
     1582
    13261583RestoreResolution;
    1327 for i:=0 to nGrExt-1 do
    1328   begin
    1329   GrExt[i].Data.Free; GrExt[i].Mask.Free;
     1584for i := 0 to nGrExt - 1 do
     1585begin
     1586  GrExt[i].Data.Free;
     1587  GrExt[i].Mask.Free;
    13301588  FreeMem(GrExt[i]);
    1331   end;
    1332 for section:=Low(TFontType) to High(TFontType) do
     1589end;
     1590for section := Low(TFontType) to High(TFontType) do
    13331591  UniFont[section].Free;
    13341592Phrases.Free;
    1335 if Sounds<>nil then Sounds.Free;
     1593if Sounds <> nil then
     1594  Sounds.Free;
    13361595LogoBuffer.Free;
    13371596BigImp.Free;
    … …  
    13421601
    13431602end.
    1344 
Note: See TracChangeset for help on using the changeset viewer.