Changeset 163 for trunk


Ignore:
Timestamp:
May 26, 2019, 12:14:41 PM (5 years ago)
Author:
chronos
Message:
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Components/ScreenTools.pas

    r155 r163  
    5252procedure PreparePlay(Item: string; Index: integer = -1);
    5353procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
    54 function turntoyear(Turn: integer): integer;
     54function TurnToYear(Turn: integer): integer;
    5555function TurnToString(Turn: integer): string;
    5656function MovementToString(Movement: integer): string;
    5757procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
    5858procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
    59 function HexStringToColor(s: string): integer;
     59function HexStringToColor(S: string): integer;
    6060function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer = 0): boolean;
    6161function LoadGraphicSet(const Name: string): integer;
     
    226226  {$ENDIF}
    227227
    228   Gamma: integer; // global gamma correction (cent)
    229   GammaLUT: array [0 .. 255] of byte;
     228  Gamma: Integer; // global gamma correction (cent)
     229  GammaLookupTable: array [0 .. 255] of Byte;
    230230
    231231{$IFDEF WINDOWS}
     
    260260{$IFNDEF DEBUG}
    261261var
    262   WAVFileName: string;
     262  WavFileName: string;
    263263{$ENDIF}
    264264begin
     
    268268  begin
    269269    Result := True;
    270     exit;
    271   end;
    272   WAVFileName := Sounds.Lookup(Item, Index);
    273   assert(WAVFileName[1] <> '[');
    274   Result := (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*');
     270    Exit;
     271  end;
     272  WavFileName := Sounds.Lookup(Item, Index);
     273  Assert(WavFileName[1] <> '[');
     274  Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
    275275  if Result then
    276     // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WAVFileName+'.wav'),SND_ASYNC)
    277     PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName);
     276    // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)
     277    PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    278278{$ENDIF}
    279279end;
    280280
    281 procedure PreparePlay(Item: string; Index: integer = -1);
     281procedure PreparePlay(Item: string; Index: Integer = -1);
    282282{$IFNDEF DEBUG}
    283283var
    284   WAVFileName: string;
     284  WavFileName: string;
    285285{$ENDIF}
    286286begin
    287287{$IFNDEF DEBUG}
    288288  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    289     exit;
    290   WAVFileName := Sounds.Lookup(Item, Index);
    291   assert(WAVFileName[1] <> '[');
    292   if (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*') then
    293     PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WAVFileName);
     289    Exit;
     290  WavFileName := Sounds.Lookup(Item, Index);
     291  Assert(WavFileName[1] <> '[');
     292  if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
     293    PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    294294{$ENDIF}
    295295end;
     
    306306end;
    307307
    308 function turntoyear(Turn: integer): integer;
    309 var
    310   i: integer;
     308function TurnToYear(Turn: Integer): Integer;
     309var
     310  I: Integer;
    311311begin
    312312  Result := -4000;
    313   for i := 1 to Turn do
    314     if Result < -1000 then
    315       Inc(Result, 50) // 0..60
    316     else if Result < 0 then
    317       Inc(Result, 25) // 60..100
    318     else if Result < 1500 then
    319       Inc(Result, 20) // 100..175
    320     else if Result < 1750 then
    321       Inc(Result, 10) // 175..200
    322     else if Result < 1850 then
    323       Inc(Result, 2) // 200..250
    324     else
    325       Inc(Result);
    326 end;
    327 
    328 function TurnToString(Turn: integer): string;
    329 var
    330   year: integer;
     313  for I := 1 to Turn do
     314    if Result < -1000 then Inc(Result, 50) // 0..60
     315    else if Result < 0 then Inc(Result, 25) // 60..100
     316    else if Result < 1500 then Inc(Result, 20) // 100..175
     317    else if Result < 1750 then Inc(Result, 10) // 175..200
     318    else if Result < 1850 then Inc(Result, 2) // 200..250
     319    else Inc(Result);
     320end;
     321
     322function TurnToString(Turn: Integer): string;
     323var
     324  Year: Integer;
    331325begin
    332326  if GenerateNames then
    333327  begin
    334     year := turntoyear(Turn);
    335     if year < 0 then
    336       Result := Format(Phrases.Lookup('BC'), [-year])
     328    Year := TurnToYear(Turn);
     329    if Year < 0 then
     330      Result := Format(Phrases.Lookup('BC'), [-Year])
    337331    else
    338       Result := Format(Phrases.Lookup('AD'), [year]);
     332      Result := Format(Phrases.Lookup('AD'), [Year]);
    339333  end
    340334  else
     
    342336end;
    343337
    344 function MovementToString(Movement: integer): string;
     338function MovementToString(Movement: Integer): string;
    345339begin
    346340  if Movement >= 1000 then
    347341  begin
    348     Result := char(48 + Movement div 1000);
     342    Result := Char(48 + Movement div 1000);
    349343    Movement := Movement mod 1000;
    350344  end
    351345  else
    352346    Result := '';
    353   Result := Result + char(48 + Movement div 100);
     347  Result := Result + Char(48 + Movement div 100);
    354348  Movement := Movement mod 100;
    355349  if Movement > 0 then
    356350  begin
    357     Result := Result + '.' + char(48 + Movement div 10);
     351    Result := Result + '.' + Char(48 + Movement div 10);
    358352    Movement := Movement mod 10;
    359353    if Movement > 0 then
    360       Result := Result + char(48 + Movement);
     354      Result := Result + Char(48 + Movement);
    361355  end;
    362356end;
     
    377371end;
    378372
    379 function HexStringToColor(s: string): integer;
    380 
    381   function HexCharToInt(x: char): integer;
    382   begin
    383     case x of
    384       '0' .. '9':
    385         Result := Ord(x) - 48;
    386       'A' .. 'F':
    387         Result := Ord(x) - 65 + 10;
    388       'a' .. 'f':
    389         Result := Ord(x) - 97 + 10;
    390       else
    391         Result := 0
    392     end;
    393   end;
    394 
    395 begin
    396   while (Length(s) > 0) and (s[1] = ' ') do
    397     Delete(s, 1, 1);
    398   s := s + '000000';
     373function HexCharToInt(X: Char): Integer;
     374begin
     375  case x of
     376    '0' .. '9': Result := Ord(X) - Ord('0');
     377    'A' .. 'F': Result := Ord(X) - Ord('A') + 10;
     378    'a' .. 'f': Result := Ord(X) - Ord('a') + 10;
     379    else Result := 0
     380  end;
     381end;
     382
     383function HexStringToColor(S: string): Integer;
     384begin
     385  while (Length(S) > 0) and (S[1] = ' ') do
     386    Delete(S, 1, 1);
     387  S := S + '000000';
    399388  if Gamma = 100 then
    400     Result := $10 * HexCharToInt(s[1]) + $1 * HexCharToInt(s[2]) +
    401       $1000 * HexCharToInt(s[3]) + $100 * HexCharToInt(s[4]) + $100000 *
    402       HexCharToInt(s[5]) + $10000 * HexCharToInt(s[6])
     389    Result := $10 * HexCharToInt(S[1]) + $1 * HexCharToInt(S[2]) +
     390      $1000 * HexCharToInt(S[3]) + $100 * HexCharToInt(S[4]) +
     391      $100000 * HexCharToInt(S[5]) + $10000 * HexCharToInt(S[6])
    403392  else
    404     Result := GammaLUT[$10 * HexCharToInt(s[1]) + HexCharToInt(s[2])] +
    405       $100 * GammaLUT[$10 * HexCharToInt(s[3]) + HexCharToInt(s[4])] +
    406       $10000 * GammaLUT[$10 * HexCharToInt(s[5]) + HexCharToInt(s[6])];
     393    Result := GammaLookupTable[$10 * HexCharToInt(S[1]) + HexCharToInt(S[2])] +
     394      $100 * GammaLookupTable[$10 * HexCharToInt(S[3]) + HexCharToInt(S[4])] +
     395      $10000 * GammaLookupTable[$10 * HexCharToInt(S[5]) + HexCharToInt(S[6])];
     396end;
     397
     398function ApplyGammaToPixel(Pixel: TPixel32): TPixel32;
     399begin
     400  Result.R := GammaLookupTable[Pixel.R];
     401  Result.G := GammaLookupTable[Pixel.G];
     402  Result.B := GammaLookupTable[Pixel.B];
    407403end;
    408404
     
    410406var
    411407  PixelPtr: TPixelPointer;
    412   X, Y: integer;
     408  X, Y: Integer;
    413409begin
    414410  Bitmap.BeginUpdate;
    415411  PixelPtr.Init(Bitmap);
    416   for Y := 0 to Bitmap.Height - 1 do
    417   begin
    418     for X := 0 to Bitmap.Width - 1 do
    419     begin
    420       PixelPtr.Pixel^.B := GammaLUT[PixelPtr.Pixel^.B];
    421       PixelPtr.Pixel^.G := GammaLUT[PixelPtr.Pixel^.G];
    422       PixelPtr.Pixel^.R := GammaLUT[PixelPtr.Pixel^.R];
     412  for Y := 0 to Bitmap.Height - 1 do begin
     413    for X := 0 to Bitmap.Width - 1 do begin
     414      PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
    423415      PixelPtr.NextPixel;
    424416    end;
     
    431423var
    432424  SrcPtr, DstPtr: TPixelPointer;
    433   X, Y: integer;
     425  X, Y: Integer;
    434426begin
    435427  //Dst.SetSize(Src.Width, Src.Height);
    436428  SrcPtr.Init(Src);
    437429  DstPtr.Init(Dst);
    438   for Y := 0 to Src.Height - 1 do
    439   begin
    440     for X := 0 to Src.Width - 1 do
    441     begin
     430  for Y := 0 to Src.Height - 1 do begin
     431    for X := 0 to Src.Width - 1 do begin
    442432      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    443433      DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
     
    451441end;
    452442
    453 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer): boolean;
    454 var
    455   jtex: tjpegimage;
     443function LoadGraphicFile(bmp: TBitmap; Path: string; Options: Integer): Boolean;
     444var
     445  jtex: TJpegImage;
    456446  Png: TPortableNetworkGraphic;
    457447begin
     
    459449  if ExtractFileExt(Path) = '' then
    460450    Path := Path + '.png';
    461   if ExtractFileExt(Path) = '.jpg' then
    462   begin
     451  if ExtractFileExt(Path) = '.jpg' then begin
    463452    jtex := tjpegimage.Create;
    464453    try
     
    477466  end
    478467  else
    479   if ExtractFileExt(Path) = '.png' then
    480   begin
     468  if ExtractFileExt(Path) = '.png' then begin
    481469    Png := TPortableNetworkGraphic.Create;
    482470    Png.PixelFormat := Bmp.PixelFormat;
     
    503491  end
    504492  else
    505   if ExtractFileExt(Path) = '.bmp' then
    506   begin
     493  if ExtractFileExt(Path) = '.bmp' then begin
    507494    try
    508495      bmp.LoadFromFile(Path);
     
    510497      Result := False;
    511498    end;
    512     if Result then
    513     begin
     499    if Result then begin
    514500      if Options and gfNoGamma = 0 then
    515501        bmp.PixelFormat := pf24bit;
     
    519505    raise Exception.Create('Unsupported image file type ' + ExtractFileExt(Path));
    520506
    521   if not Result then
    522   begin
     507  if not Result then begin
    523508    if Options and gfNoError = 0 then
    524509      raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [Path]));
     
    529514end;
    530515
    531 function LoadGraphicSet(const Name: string): integer;
    532 var
    533   I, x, y, xmax, OriginalColor: integer;
     516function LoadGraphicSet(const Name: string): Integer;
     517var
     518  I, x, y, xmax, OriginalColor: Integer;
    534519  FileName: string;
    535520  Source: TBitmap;
     
    540525    Inc(I);
    541526  Result := I;
    542   if I = nGrExt then
    543   begin
     527  if I = nGrExt then begin
    544528    Source := TBitmap.Create;
    545529    Source.PixelFormat := pf24bit;
    546530    FileName := HomeDir + 'Graphics' + DirectorySeparator + Name;
    547     if not LoadGraphicFile(Source, FileName) then
    548     begin
     531    if not LoadGraphicFile(Source, FileName) then begin
    549532      Result := -1;
    550533      Exit;
     
    568551    DataPixel.Init(GrExt[nGrExt].Data);
    569552    MaskPixel.Init(GrExt[nGrExt].Mask);
    570     for y := 0 to Source.Height - 1 do
    571     begin
    572       for x := 0 to xmax - 1 do
    573       begin
     553    for y := 0 to Source.Height - 1 do begin
     554      for x := 0 to xmax - 1 do begin
    574555        OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
    575556        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
     
    578559          DataPixel.Pixel^.ARGB := DataPixel.Pixel^.ARGB and $FF000000;
    579560        end
    580         else
    581         begin
     561        else begin
    582562          MaskPixel.Pixel^.ARGB := $000000; // non-transparent
    583563          if Gamma <> 100 then
    584           begin
    585             DataPixel.Pixel^.B := GammaLUT[DataPixel.Pixel^.B];
    586             DataPixel.Pixel^.G := GammaLUT[DataPixel.Pixel^.G];
    587             DataPixel.Pixel^.R := GammaLUT[DataPixel.Pixel^.R];
    588           end;
     564            DataPixel.Pixel^ := ApplyGammaToPixel(DataPixel.Pixel^);
    589565        end;
    590566        DataPixel.NextPixel;
     
    615591  Dst.BeginUpdate;
    616592  PixelPtr.Init(Dst, X, Y);
    617   for yy := 0 to h - 1 do
    618   begin
    619     for xx := 0 to w - 1 do
    620     begin
     593  for yy := 0 to h - 1 do begin
     594    for xx := 0 to w - 1 do begin
    621595      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    622596      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
     
    629603end;
    630604
    631 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     605procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
    632606// Src is template
    633607// X channel = background amp (old Dst content), 128=original brightness
    634608var
    635   X, Y: integer;
    636   Brightness, Test: integer;
     609  X, Y: Integer;
     610  Brightness, Test: Integer;
    637611  PixelSrc: TPixelPointer;
    638612  PixelDst: TPixelPointer;
     
    640614  //Assert(Src.PixelFormat = pf8bit);
    641615  Assert(dst.PixelFormat = pf24bit);
    642   if xDst < 0 then
    643   begin
     616  if xDst < 0 then begin
    644617    w := w + xDst;
    645618    xSrc := xSrc - xDst;
    646619    xDst := 0;
    647620  end;
    648   if yDst < 0 then
    649   begin
     621  if yDst < 0 then begin
    650622    h := h + yDst;
    651623    ySrc := ySrc - yDst;
     
    663635  PixelDst.Init(Dst, xDst, yDst);
    664636  PixelSrc.Init(Src, xSrc, ySrc);
    665   for Y := 0 to h - 1 do
    666   begin
    667     for X := 0 to w - 1 do
    668     begin
     637  for Y := 0 to h - 1 do begin
     638    for X := 0 to w - 1 do  begin
    669639      Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color
    670640      test := (PixelDst.Pixel^.R * Brightness) shr 7;
     
    703673  SrcPixel, DstPixel: TPixelPointer;
    704674begin
    705   if xDst < 0 then
    706   begin
     675  if xDst < 0 then begin
    707676    w := w + xDst;
    708677    xSrc := xSrc - xDst;
    709678    xDst := 0;
    710679  end;
    711   if yDst < 0 then
    712   begin
     680  if yDst < 0 then begin
    713681    h := h + yDst;
    714682    ySrc := ySrc - yDst;
     
    726694  SrcPixel.Init(Src, xSrc, ySrc);
    727695  DstPixel.Init(Dst, xDst, yDst);
    728   for iy := 0 to h - 1 do
    729   begin
    730     for ix := 0 to w - 1 do
    731     begin
     696  for iy := 0 to h - 1 do begin
     697    for ix := 0 to w - 1 do begin
    732698      trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
    733699      amp1 := SrcPixel.Pixel^.G * 2;
    734700      amp2 := SrcPixel.Pixel^.R * 2;
    735       if trans <> $FF then
    736       begin
     701      if trans <> $FF then begin
    737702        Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) *
    738703          amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF;
     
    764729end;
    765730
    766 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
     731procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
    767732// Bmp is template
    768733// B channel = Color0 amp, 128=original brightness
     
    770735// R channel = Color2 amp, 128=original brightness
    771736var
    772   i, Red, Green: integer;
     737  i, Red, Green: Integer;
    773738  PixelPtr: TPixelPointer;
    774739begin
     
    777742  h := y + h;
    778743  PixelPtr.Init(Bmp, x, y);
    779   while y < h do
    780   begin
    781     for i := 0 to w - 1 do
    782     begin
     744  while y < h do begin
     745    for i := 0 to w - 1 do begin
    783746      Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
    784747        (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
     
    826789procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    827790begin
    828   with ca do
    829   begin
     791  with ca do begin
    830792    Pen.Color := cl;
    831793    MoveTo(x0, y);
     
    836798procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    837799begin
    838   with ca do
    839   begin
     800  with ca do begin
    840801    Pen.Color := cl0;
    841802    MoveTo(x0, y);
     
    851812procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    852813begin
    853   with ca do
    854   begin
     814  with ca do begin
    855815    MoveTo(x0, y1);
    856816    Pen.Color := cl0;
     
    865825procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    866826begin
    867   with ca do
    868   begin
     827  with ca do begin
    869828    Pen.Color := cl0;
    870829    MoveTo(x0, y0 + 1);
     
    882841procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    883842begin
    884   with ca do
    885   begin
     843  with ca do begin
    886844    Pen.Color := cl;
    887845    MoveTo(x0, y0 + Corner - 1);
     
    903861  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    904862begin
    905   if IsControl then
    906   begin
     863  if IsControl then begin
    907864    Frame(ca, x - 1, y - 1, x + Width, y + Height, $B0B0B0, $FFFFFF);
    908865    RFrame(ca, x - 2, y - 2, x + Width + 1, y + Height + 1, $FFFFFF, $B0B0B0);
    909   end
    910   else
     866  end else
    911867    Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000);
    912868  BitBlt(ca.Handle, x, y, Width, Height, Src.Canvas.Handle, xSrc, ySrc,
     
    914870end;
    915871
    916 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
    917 var
    918   x, y, ch, r: integer;
     872procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
     873var
     874  x, y, ch, r: Integer;
    919875  DstPtr: TPixelPointer;
    920876begin
    921877  dst.BeginUpdate;
    922878  DstPtr.Init(dst, x0, y0);
    923   for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do
    924   begin
    925     for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do
    926     begin
     879  for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do begin
     880    for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do begin
    927881      DstPtr.SetXY(x, y);
    928882      if x < 0 then
     
    960914procedure InitOrnament;
    961915var
    962   x, y, p, light, shade: integer;
    963 begin
    964   if InitOrnamentDone then
    965     exit;
    966   light := MainTexture.clBevelLight;
     916  x, y, p, Light, Shade: Integer;
     917begin
     918  if InitOrnamentDone then Exit;
     919  Light := MainTexture.clBevelLight;
    967920  // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2;
    968   shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
     921  Shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
    969922    MainTexture.clBevelLight and $FCFCFC shr 2;
    970923  for x := 0 to wOrna - 1 do
    971     for y := 0 to hOrna - 1 do
    972     begin
     924    for y := 0 to hOrna - 1 do begin
    973925      p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y];
    974926      if p = $0000FF then
    975         GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := light
     927        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light
    976928      else if p = $FF0000 then
    977         GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := shade;
     929        GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;
    978930    end;
    979931  InitOrnamentDone := True;
     
    982934procedure InitCityMark(const T: TTexture);
    983935var
    984   x, y, intensity: integer;
     936  x, y, intensity: Integer;
    985937begin
    986938  for x := 0 to 9 do
     
    999951end;
    1000952
    1001 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
     953procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
    1002954begin
    1003955  Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
     
    1007959end;
    1008960
    1009 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    1010 
    1011   function band(i: integer): integer;
     961procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
     962
     963  function Band(I: Integer): Integer;
    1012964  var
    1013965    n: integer;
    1014966  begin
    1015967    n := ((hMainTexture div 2) div (y1 - y0)) * 2;
    1016     while hMainTexture div 2 + (i + 1) * (y1 - y0) > hMainTexture do
    1017       Dec(i, n);
    1018     while hMainTexture div 2 + i * (y1 - y0) < 0 do
    1019       Inc(i, n);
    1020     Result := i;
    1021   end;
    1022 
    1023 var
    1024   i: integer;
    1025 begin
    1026   for i := 0 to (x1 - xm) div wMainTexture - 1 do
    1027     BitBlt(ca.Handle, xm + i * wMainTexture, y0, wMainTexture, y1 - y0,
    1028       MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(i) *
     968    while hMainTexture div 2 + (I + 1) * (y1 - y0) > hMainTexture do
     969      Dec(I, n);
     970    while hMainTexture div 2 + I * (y1 - y0) < 0 do
     971      Inc(I, n);
     972    Result := I;
     973  end;
     974
     975var
     976  I: Integer;
     977begin
     978  for I := 0 to (x1 - xm) div wMainTexture - 1 do
     979    BitBlt(ca.Handle, xm + I * wMainTexture, y0, wMainTexture, y1 - y0,
     980      MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + Band(I) *
    1029981      (y1 - y0), SRCCOPY);
    1030982  BitBlt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
    1031983    x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0,
    1032     MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(
     984    MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + Band(
    1033985    (x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY);
    1034   for i := 0 to (xm - x0) div wMainTexture - 1 do
    1035     BitBlt(ca.Handle, xm - (i + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
     986  for I := 0 to (xm - x0) div wMainTexture - 1 do
     987    BitBlt(ca.Handle, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
    1036988      MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 +
    1037       band(-i - 1) * (y1 - y0), SRCCOPY);
     989      Band(-I - 1) * (y1 - y0), SRCCOPY);
    1038990  BitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) *
    1039991    wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas.Handle,
    1040992    ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0),
    1041     hMainTexture div 2 + band(-(xm - x0) div wMainTexture - 1) * (y1 - y0), SRCCOPY);
    1042 end;
    1043 
    1044 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
     993    hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0), SRCCOPY);
     994end;
     995
     996procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
    1045997  const Texture: TBitmap);
    1046998var
    1047   x, y, x0cut, y0cut, x1cut, y1cut: integer;
     999  x, y, x0cut, y0cut, x1cut, y1cut: Integer;
    10481000begin
    10491001  while xOffset < 0 do
     
    10771029end;
    10781030
    1079 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
     1031procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    10801032  const Texture: TBitmap);
    10811033begin
     
    10831035end;
    10841036
    1085 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
     1037procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
    10861038begin
    10871039  Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div
     
    10891041end;
    10901042
    1091 procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
     1043procedure Corner(ca: TCanvas; x, y, Kind: Integer; const T: TTexture);
    10921044begin
    10931045  { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
     
    10971049end;
    10981050
    1099 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    1100 
    1101   procedure PaintIcon(x, y, Kind: integer);
     1051procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
     1052
     1053  procedure PaintIcon(x, y, Kind: Integer);
    11021054  begin
    11031055    BitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas.Handle,
     
    11081060
    11091061var
    1110   p, xp: integer;
     1062  p, xp: Integer;
    11111063  sp: string;
    1112   shadow: boolean;
     1064  shadow: Boolean;
    11131065begin
    11141066  Inc(x);
     
    11301082          begin
    11311083            ca.Textout(xp, y, sp);
    1132             break;
     1084            Break;
    11331085          end
    11341086          else
     
    11381090            if not shadow then
    11391091              case sp[p + 1] of
    1140                 'c':
    1141                   PaintIcon(xp + 1, y, 6);
    1142                 'f':
    1143                   PaintIcon(xp + 1, y, 0);
    1144                 'l':
    1145                   PaintIcon(xp + 1, y, 8);
    1146                 'm':
    1147                   PaintIcon(xp + 1, y, 17);
    1148                 'n':
    1149                   PaintIcon(xp + 1, y, 7);
    1150                 'o':
    1151                   PaintIcon(xp + 1, y, 16);
    1152                 'p':
    1153                   PaintIcon(xp + 1, y, 2);
    1154                 'r':
    1155                   PaintIcon(xp + 1, y, 12);
    1156                 't':
    1157                   PaintIcon(xp + 1, y, 4);
    1158                 'w':
    1159                   PaintIcon(xp + 1, y, 13);
     1092                'c': PaintIcon(xp + 1, y, 6);
     1093                'f': PaintIcon(xp + 1, y, 0);
     1094                'l': PaintIcon(xp + 1, y, 8);
     1095                'm': PaintIcon(xp + 1, y, 17);
     1096                'n': PaintIcon(xp + 1, y, 7);
     1097                'o': PaintIcon(xp + 1, y, 16);
     1098                'p': PaintIcon(xp + 1, y, 2);
     1099                'r': PaintIcon(xp + 1, y, 12);
     1100                't': PaintIcon(xp + 1, y, 4);
     1101                'w': PaintIcon(xp + 1, y, 13);
    11601102              end;
    11611103            Inc(xp, 10);
    11621104            Delete(sp, 1, p + 1);
    1163           end
     1105          end;
    11641106        until False;
    11651107        Dec(x);
     
    11681110end;
    11691111
    1170 function BiColorTextWidth(ca: TCanvas; s: string): integer;
    1171 var
    1172   p: integer;
     1112function BiColorTextWidth(ca: TCanvas; s: string): Integer;
     1113var
     1114  P: Integer;
    11731115begin
    11741116  Result := 1;
    11751117  repeat
    1176     p := pos('%', s);
    1177     if (p = 0) or (p = Length(s)) then
     1118    P := Pos('%', s);
     1119    if (P = 0) or (P = Length(s)) then
    11781120    begin
    11791121      Inc(Result, ca.TextWidth(s));
    1180       break;
     1122      Break;
    11811123    end
    11821124    else
    11831125    begin
    1184       if not (s[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
     1126      if not (s[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
    11851127      then
    1186         Inc(Result, ca.TextWidth(copy(s, 1, p + 1)))
     1128        Inc(Result, ca.TextWidth(copy(s, 1, P + 1)))
    11871129      else
    1188         Inc(Result, ca.TextWidth(copy(s, 1, p - 1)) + 10);
    1189       Delete(s, 1, p + 1);
    1190     end
     1130        Inc(Result, ca.TextWidth(copy(s, 1, P - 1)) + 10);
     1131      Delete(s, 1, P + 1);
     1132    end;
    11911133  until False;
    11921134end;
    11931135
    11941136procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    1195   x, y: integer; s: string);
     1137  x, y: Integer; s: string);
    11961138begin
    11971139  if cl = -2 then
     
    12091151end;
    12101152
    1211 procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: integer;
     1153procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: Integer;
    12121154  Brightness: array of integer);
    12131155var
    1214   i, r, g, b: integer;
     1156  i, r, g, b: Integer;
    12151157begin
    12161158  begin
     
    12431185end;
    12441186
    1245 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     1187procedure LightGradient(ca: TCanvas; x, y, Width, Color: Integer);
    12461188const
    12471189  Brightness: array [0 .. 15] of integer =
     
    12511193end;
    12521194
    1253 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     1195procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: Integer);
    12541196const
    12551197  Brightness: array [0 .. 15] of integer =
     
    12601202end;
    12611203
    1262 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     1204procedure VLightGradient(ca: TCanvas; x, y, Height, Color: Integer);
    12631205const
    12641206  Brightness: array [0 .. 15] of integer =
     
    12681210end;
    12691211
    1270 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     1212procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: Integer);
    12711213const
    12721214  Brightness: array [0 .. 15] of integer =
     
    12781220
    12791221procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;
    1280   val: integer; const T: TTexture);
     1222  val: Integer; const T: TTexture);
    12811223var
    12821224  s: string;
     
    12931235end;
    12941236
    1295 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
    1296   Cap: string; val: integer; const T: TTexture);
    1297 var
    1298   i, sd, ld, cl, xIcon, yIcon: integer;
     1237procedure CountBar(dst: TBitmap; x, y, w: Integer; Kind: Integer;
     1238  Cap: string; val: Integer; const T: TTexture);
     1239var
     1240  i, sd, ld, cl, xIcon, yIcon: Integer;
    12991241  s: string;
    13001242begin
    13011243  // val:=random(40); //!!!
    13021244  if val = 0 then
    1303     exit;
    1304   assert(Kind >= 0);
     1245    Exit;
     1246  Assert(Kind >= 0);
    13051247  with dst.Canvas do
    13061248  begin
     
    13871329    end;
    13881330  end;
    1389 end; // CountBar
    1390 
    1391 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     1331end;
     1332
     1333procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: Integer;
    13921334  const T: TTexture);
    13931335var
    1394   i: integer;
     1336  i: Integer;
    13951337begin
    13961338  if pos > max then
     
    14431385// pos and growth are relative to max, set size independent
    14441386procedure PaintRelativeProgressBar(ca: TCanvas;
    1445   Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
     1387  Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;
    14461388  const T: TTexture);
    14471389begin
     
    14561398end;
    14571399
    1458 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     1400procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: Integer);
    14591401begin
    14601402  BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
     
    14661408end;
    14671409
    1468 function SetMainTextureByAge(Age: integer): boolean;
     1410function SetMainTextureByAge(Age: Integer): Boolean;
    14691411begin
    14701412  if Age <> MainTextureAge then
    1471     with MainTexture do
    1472     begin
     1413    with MainTexture do begin
    14731414      MainTextureAge := Age;
    14741415      LoadGraphicFile(Image, HomeDir + 'Graphics' + DirectorySeparator +
     
    15011442end;
    15021443
    1503 procedure TPixelPointer.SetXY(X, Y: integer); inline;
     1444procedure TPixelPointer.SetXY(X, Y: Integer); inline;
    15041445begin
    15051446  Line := Pointer(Base) + Y * BytesPerLine;
     
    15071448end;
    15081449
    1509 procedure TPixelPointer.SetX(X: integer); inline;
     1450procedure TPixelPointer.SetX(X: Integer); inline;
    15101451begin
    15111452  Pixel := Pointer(Line) + X * BytesPerPixel;
    15121453end;
    15131454
    1514 procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: integer = 0;
     1455procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: Integer = 0;
    15151456  BaseY: integer = 0); inline;
    15161457begin
     
    15691510  try
    15701511    Reset(fontscript);
    1571     while not EOF(FontScript) do
    1572     begin
     1512    while not EOF(FontScript) do begin
    15731513      ReadLn(FontScript, s);
    15741514      if s <> '' then
    1575         if s[1] = '#' then
    1576         begin
     1515        if s[1] = '#' then begin
    15771516          s := TrimRight(s);
    15781517          if s = '#SMALL' then
     
    15861525          else
    15871526            Section := ftNormal;
    1588         end
    1589         else
    1590         begin
     1527        end else begin
    15911528          p := Pos(',', s);
    1592           if p > 0 then
    1593           begin
     1529          if p > 0 then begin
    15941530            UniFont[section].Name := Trim(Copy(s, 1, p - 1));
    15951531            Size := 0;
     
    16221558end;
    16231559
     1560procedure InitGammaLookupTable;
     1561var
     1562  I: Integer;
     1563  P: Integer;
     1564begin
     1565  GammaLookupTable[0] := 0;
     1566  for I := 1 to 255 do begin
     1567    P := Round(255.0 * Exp(Ln(I / 255.0) * 100.0 / Gamma));
     1568    Assert((P >= 0) and (P < 256));
     1569    GammaLookupTable[I] := P;
     1570  end;
     1571end;
     1572
    16241573procedure UnitInit;
    16251574var
    1626   I: integer;
    1627   P: integer;
    16281575  Reg: TRegistry;
    16291576begin
     
    16471594    end;
    16481595
    1649   if Gamma <> 100 then
    1650   begin
    1651     GammaLUT[0] := 0;
    1652     for i := 1 to 255 do
    1653     begin
    1654       p := Round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma));
    1655       Assert((p >= 0) and (p < 256));
    1656       GammaLUT[i] := p;
    1657     end;
    1658   end;
     1596  if Gamma <> 100 then InitGammaLookupTable;
    16591597
    16601598  {$IFDEF WINDOWS}
     
    17101648
    17111649  RestoreResolution;
    1712   for I := 0 to nGrExt - 1 do
    1713   begin
     1650  for I := 0 to nGrExt - 1 do begin
    17141651    GrExt[I].Data.Free;
    17151652    GrExt[I].Mask.Free;
     
    17311668end;
    17321669
    1733 
    1734 initialization
    1735 
    1736   //UnitInit;
    1737 
    1738 finalization
    1739 
    1740   //UnitDone;
    1741 
    17421670end.
  • trunk/Integrated.lpi

    r146 r163  
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="10"/>
     4    <Version Value="11"/>
    55    <PathDelim Value="\"/>
    66    <General>
     
    8181    </PublishOptions>
    8282    <RunParams>
    83       <local>
    84         <FormatVersion Value="1"/>
    85       </local>
     83      <FormatVersion Value="2"/>
     84      <Modes Count="1">
     85        <Mode0 Name="default"/>
     86      </Modes>
    8687    </RunParams>
    8788    <RequiredPackages Count="2">
Note: See TracChangeset for help on using the changeset viewer.