Changeset 14 for trunk/ScreenTools.pas


Ignore:
Timestamp:
Jan 7, 2017, 8:54:23 PM (7 years ago)
Author:
chronos
Message:
  • Removed: Do not create file association at runtime as it is done by installer program.
  • Modified: Additional source formating using Delphi formatter.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ScreenTools.pas

    r11 r14  
    77  Windows, StringTables,
    88
    9   LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus;
     9  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls,
     10  Forms, Menus;
    1011
    1112type
    … …  
    1617  end;
    1718
    18     function ChangeResolution(x, y, bpp, freq: integer): boolean;
    19     procedure RestoreResolution;
    20     function Play(Item: string; Index: integer = -1): boolean;
    21     procedure PreparePlay(Item: string; Index: integer = -1);
    22     procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
    23     function turntoyear(Turn: integer): integer;
    24     function TurnToString(Turn: integer): string;
    25     function MovementToString(Movement: integer): string;
    26     procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
    27     procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
    28     function HexStringToColor(s: string): integer;
    29     function LoadGraphicFile(bmp: TBitmap; Path: string;
    30       Options: integer = 0): boolean;
    31     function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
    32       Options: integer = 0): boolean;
    33     function LoadGraphicSet(Name: string): integer;
    34     procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    35       yGr: integer);
    36     procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
    37       yGr: integer); overload;
    38     procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    39       yGr: integer); overload;
    40     procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    41     procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w,
    42       h: integer);
    43     procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h,
    44       Color1, Color2: integer);
    45     procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
    46       Color2: integer);
    47     procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    48     procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    49     procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    50     procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    51     procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    52     procedure FrameImage(ca: TCanvas; Src: TBitmap;
    53       x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
    54     procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer;
    55       cl: TColor);
    56     procedure InitOrnament;
    57     procedure InitCityMark(const T: TTexture);
    58     procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
    59       yOffset: integer);
    60     procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    61     procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
    62       yOffset: integer; const Texture: TBitmap);
    63     procedure FillRectSeamless(ca: TCanvas;
    64       x0, y0, x1, y1, xOffset, yOffset: integer; const Texture: TBitmap);
    65     procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    66     procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
    67     procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
    68       s: string);
    69     procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    70       x, y: integer; s: string);
    71     function BiColorTextWidth(ca: TCanvas; s: string): integer;
    72     procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
    73     procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
    74     procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
    75     procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
    76     procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
    77     procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
    78       const T: TTexture);
    79     procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
    80       Cap: string; val: integer; const T: TTexture);
    81     procedure PaintProgressBar(ca: TCanvas;
    82       Kind, x, y, pos, Growth, max: integer; const T: TTexture);
    83     procedure PaintRelativeProgressBar(ca: TCanvas;
    84       Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
    85       const T: TTexture);
    86     procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
    87     function SetMainTextureByAge(Age: integer): boolean;
    88 
    89   const
    90     nGrExtmax = 64;
    91     wMainTexture = 640;
    92     hMainTexture = 480;
    93 
    94     // template positions in Template.bmp
    95     xLogo = 1;
    96     yLogo = 1;
    97     wLogo = 122;
    98     hLogo = 23; // logo
    99     xBBook = 1;
    100     yBBook = 74;
    101     wBBook = 143;
    102     hBBook = 73; // big book
    103     xSBook = 72;
    104     ySBook = 37;
    105     wSBook = 72;
    106     hSBook = 36; // small book
    107     xNation = 1;
    108     yNation = 25;
    109     xCoal = 1;
    110     yCoal = 148;
    111 
    112     // Icons.bmp structure
    113     xSizeBig = 56;
    114     ySizeBig = 40;
    115 
    116     GlowRange = 8;
    117 
    118     EmptySpaceColor = $101010;
    119 
    120     // template positions in System2.bmp
    121     xOrna = 156;
    122     yOrna = 1;
    123     wOrna = 27;
    124     hOrna = 26; // ornament
    125 
    126     // sound modes
    127     smOff = 0;
    128     smOn = 1;
    129     smOnAlt = 2;
    130 
    131     // color matrix
    132     clkAge0 = 1;
    133     cliTexture = 0;
    134     cliBevelLight = cliTexture + 1;
    135     cliBevelShade = cliTexture + 2;
    136     cliTextLight = cliTexture + 3;
    137     cliTextShade = cliTexture + 4;
    138     cliLitText = cliTexture + 5;
    139     cliMark = cliTexture + 6;
    140     cliDimmedText = cliTexture + 7;
    141     cliRoad = 8;
    142     cliHouse = cliRoad + 1;
    143     cliImp = cliRoad + 2;
    144     cliImpProject = cliRoad + 3;
    145     cliPage = 13;
    146     cliCover = cliPage + 1;
    147     clkMisc = 5;
    148     cliPaper = 0;
    149     cliPaperText = 1;
    150     cliPaperCaption = 2;
    151     clkCity = 6;
    152     cliPlains = 0;
    153     cliPrairie = 1;
    154     cliHills = 2;
    155     cliTundra = 3;
    156     cliWater = 4;
    157 
    158     // LoadGraphicFile options
    159     gfNoError = $01;
    160     gfNoGamma = $02;
    161     gfJPG = $04;
    162 
    163   type
    164     TGrExtDescr = record { don't use dynamic strings here! }
    165       Name: string[31];
    166       Data, Mask: TBitmap;
    167       pixUsed: array [Byte] of Byte;
    168     end;
    169 
    170     TGrExtDescrSize = record { for size calculation only - must be the same as
    171         TGrExtDescr, but without pixUsed }
    172       Name: string[31];
    173       Data, Mask: TBitmap;
    174     end;
    175 
    176     TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    177 
    178   var
    179     Phrases, Phrases2, Sounds: TStringTable;
    180     nGrExt: integer;
    181     GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
    182     HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
    183     MainTexture: TTexture;
    184     Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
    185     FullScreen, GenerateNames, InitOrnamentDone,
    186       Phrases2FallenBackToEnglish: boolean;
    187 
    188     UniFont: array [TFontType] of TFont;
     19function ChangeResolution(x, y, bpp, freq: integer): boolean;
     20procedure RestoreResolution;
     21function Play(Item: string; Index: integer = -1): boolean;
     22procedure PreparePlay(Item: string; Index: integer = -1);
     23procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
     24function turntoyear(Turn: integer): integer;
     25function TurnToString(Turn: integer): string;
     26function MovementToString(Movement: integer): string;
     27procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     28procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     29function HexStringToColor(s: string): integer;
     30function LoadGraphicFile(bmp: TBitmap; Path: string;
     31  Options: integer = 0): boolean;
     32function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
     33  Options: integer = 0): boolean;
     34function LoadGraphicSet(Name: string): integer;
     35procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     36procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
     37  yGr: integer); overload;
     38procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
     39  yGr: integer); overload;
     40procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
     41procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     42procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1,
     43  Color2: integer);
     44procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
     45  Color2: integer);
     46procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     47procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     48procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     49procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     50procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     51procedure FrameImage(ca: TCanvas; Src: TBitmap;
     52  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     53procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
     54procedure InitOrnament;
     55procedure InitCityMark(const T: TTexture);
     56procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
     57  yOffset: integer);
     58procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
     59procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
     60  yOffset: integer; const Texture: TBitmap);
     61procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset,
     62  yOffset: integer; const Texture: TBitmap);
     63procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
     64procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
     65procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
     66  s: string);
     67procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     68  x, y: integer; s: string);
     69function BiColorTextWidth(ca: TCanvas; s: string): integer;
     70procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     71procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     72procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     73procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     74procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     75procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     76  const T: TTexture);
     77procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer; Cap: string;
     78  val: integer; const T: TTexture);
     79procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     80  const T: TTexture);
     81procedure PaintRelativeProgressBar(ca: TCanvas; Kind, x, y, size, pos, Growth,
     82  max: integer; IndicateComplete: boolean; const T: TTexture);
     83procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     84function SetMainTextureByAge(Age: integer): boolean;
     85
     86const
     87  nGrExtmax = 64;
     88  wMainTexture = 640;
     89  hMainTexture = 480;
     90
     91  // template positions in Template.bmp
     92  xLogo = 1;
     93  yLogo = 1;
     94  wLogo = 122;
     95  hLogo = 23; // logo
     96  xBBook = 1;
     97  yBBook = 74;
     98  wBBook = 143;
     99  hBBook = 73; // big book
     100  xSBook = 72;
     101  ySBook = 37;
     102  wSBook = 72;
     103  hSBook = 36; // small book
     104  xNation = 1;
     105  yNation = 25;
     106  xCoal = 1;
     107  yCoal = 148;
     108
     109  // Icons.bmp structure
     110  xSizeBig = 56;
     111  ySizeBig = 40;
     112
     113  GlowRange = 8;
     114
     115  EmptySpaceColor = $101010;
     116
     117  // template positions in System2.bmp
     118  xOrna = 156;
     119  yOrna = 1;
     120  wOrna = 27;
     121  hOrna = 26; // ornament
     122
     123  // sound modes
     124  smOff = 0;
     125  smOn = 1;
     126  smOnAlt = 2;
     127
     128  // color matrix
     129  clkAge0 = 1;
     130  cliTexture = 0;
     131  cliBevelLight = cliTexture + 1;
     132  cliBevelShade = cliTexture + 2;
     133  cliTextLight = cliTexture + 3;
     134  cliTextShade = cliTexture + 4;
     135  cliLitText = cliTexture + 5;
     136  cliMark = cliTexture + 6;
     137  cliDimmedText = cliTexture + 7;
     138  cliRoad = 8;
     139  cliHouse = cliRoad + 1;
     140  cliImp = cliRoad + 2;
     141  cliImpProject = cliRoad + 3;
     142  cliPage = 13;
     143  cliCover = cliPage + 1;
     144  clkMisc = 5;
     145  cliPaper = 0;
     146  cliPaperText = 1;
     147  cliPaperCaption = 2;
     148  clkCity = 6;
     149  cliPlains = 0;
     150  cliPrairie = 1;
     151  cliHills = 2;
     152  cliTundra = 3;
     153  cliWater = 4;
     154
     155  // LoadGraphicFile options
     156  gfNoError = $01;
     157  gfNoGamma = $02;
     158  gfJPG = $04;
     159
     160type
     161  TGrExtDescr = record { don't use dynamic strings here! }
     162    Name: string[31];
     163    Data, Mask: TBitmap;
     164    pixUsed: array [Byte] of Byte;
     165  end;
     166
     167  TGrExtDescrSize = record { for size calculation only - must be the same as
     168      TGrExtDescr, but without pixUsed }
     169    Name: string[31];
     170    Data, Mask: TBitmap;
     171  end;
     172
     173  TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
     174
     175var
     176  Phrases, Phrases2, Sounds: TStringTable;
     177  nGrExt: integer;
     178  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
     179  HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
     180  MainTexture: TTexture;
     181  Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
     182  FullScreen, GenerateNames, InitOrnamentDone,
     183    Phrases2FallenBackToEnglish: boolean;
     184
     185  UniFont: array [TFontType] of TFont;
    189186
    190187implementation
    … …  
    14571454
    14581455Reg := TRegistry.create;
    1459 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
    14601456try
    1461   Gamma := Reg.ReadInteger('Gamma');
    1462 except
    1463   Gamma := 100;
    1464   Reg.WriteInteger('Gamma', Gamma);
    1465 end;
    1466 Reg.closekey;
    1467 Reg.Free;
     1457  Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
     1458  if Reg.ValueExists('Gamma') then
     1459    Gamma := Reg.ReadInteger('Gamma')
     1460    else begin
     1461      Gamma := 100;
     1462      Reg.WriteInteger('Gamma', Gamma);
     1463    end;
     1464finally
     1465  Reg.Free;
     1466end;
    14681467
    14691468if Gamma <> 100 then
Note: See TracChangeset for help on using the changeset viewer.