Ignore:
Timestamp:
May 30, 2023, 11:31:10 AM (19 months ago)
Author:
chronos
Message:
  • Modified: Removed U prefix from unit names.
Location:
trunk/Packages/CevoComponents
Files:
3 edited
2 moved

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/CevoComponents.lpk

    r396 r456  
    11<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <PathDelim Value="\"/>
    55    <Name Value="CevoComponents"/>
    … …  
    103103      </Item14>
    104104      <Item15>
    105         <Filename Value="UGraphicSet.pas"/>
    106         <UnitName Value="UGraphicSet"/>
     105        <Filename Value="GraphicSet.pas"/>
     106        <UnitName Value="GraphicSet"/>
    107107      </Item15>
    108108      <Item16>
    109         <Filename Value="UTexture.pas"/>
    110         <UnitName Value="UTexture"/>
     109        <Filename Value="Texture.pas"/>
     110        <UnitName Value="Texture"/>
    111111      </Item16>
    112112    </Files>
     113    <CompatibilityMode Value="True"/>
    113114    <RequiredPkgs Count="3">
    114115      <Item1>

  • trunk/Packages/CevoComponents/CevoComponents.pas

    r447 r456  
    1010uses
    1111  Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
    12   Sound, BaseWin, AsyncProcess2, UGraphicSet, UTexture, LazarusPackageIntf;
     12  Sound, BaseWin, AsyncProcess2, GraphicSet, Texture, LazarusPackageIntf;
    1313
    1414implementation
    … …  
    2929  RegisterPackage('CevoComponents', @Register);
    3030end.
    31 

  • trunk/Packages/CevoComponents/GraphicSet.pas

    r455 r456  
    1 unit UGraphicSet;
     1unit GraphicSet;
    22
    33interface
    44
    55uses
    6   Classes, SysUtils, Graphics, Generics.Collections, LCLType, UPixelPointer, DOM,
    7   XMLRead, XMLWrite, UXMLUtils;
     6  Classes, SysUtils, Graphics, Generics.Collections, LCLType, DOM,
     7  XMLRead, XMLWrite, XML;
    88
    99type

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r447 r456  
    88  {$ENDIF}
    99  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
    10   Forms, Menus, GraphType, UGraphicSet, LazFileUtils, UTexture;
     10  Forms, Menus, GraphType, GraphicSet, LazFileUtils, Texture;
    1111
    1212type
    … …  
    2424function TurnToString(Turn: Integer): string;
    2525function MovementToString(Movement: Integer): string;
    26 procedure BtnFrame(ca: TCanvas; P: TRect; T: TTexture);
    27 procedure EditFrame(ca: TCanvas; P: TRect; T: TTexture);
     26procedure BtnFrame(Canvas: TCanvas; P: TRect; T: TTexture);
     27procedure EditFrame(Canvas: TCanvas; P: TRect; T: TTexture);
    2828function HexStringToColor(S: string): Integer;
    2929function ExtractFileNameWithoutExt(const Filename: string): string;
    … …  
    5454function BitBltBitmap(Dest: TBitmap; DestRect: TRect;
    5555  Src: TBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
    56 procedure SLine(ca: TCanvas; x0, x1, Y: Integer; cl: TColor);
    57 procedure DLine(ca: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor);
    58 procedure Frame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
    59 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
    60 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor);
    61 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     56procedure SLine(Canvas: TCanvas; x0, x1, Y: Integer; cl: TColor);
     57procedure DLine(Canvas: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor);
     58procedure Frame(Canvas: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
     59procedure RFrame(Canvas: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
     60procedure CFrame(Canvas: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor);
     61procedure FrameImage(Canvas: TCanvas; Src: TBitmap;
    6262  X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False);
    6363procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
    6464procedure InitOrnament;
    65 procedure InitCityMark(T: TTexture);
    66 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); overload;
     65procedure InitCityMark(Texture: TTexture);
     66procedure Fill(Canvas: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); overload;
    6767procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint); overload;
    68 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
    69 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
     68procedure FillLarge(Canvas: TCanvas; x0, y0, x1, y1, xm: Integer);
     69procedure FillSeamless(Canvas: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
    7070  const Texture: TBitmap);
    71 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
     71procedure FillRectSeamless(Canvas: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    7272  const Texture: TBitmap);
    7373procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
    74 procedure Corner(ca: TCanvas; X, Y, Kind: Integer; T: TTexture);
    75 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
    76 procedure LoweredTextOut(ca: TCanvas; cl: TColor; T: TTexture;
     74procedure Corner(Canvas: TCanvas; X, Y, Kind: Integer; T: TTexture);
     75procedure BiColorTextOut(Canvas: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
     76procedure LoweredTextOut(Canvas: TCanvas; cl: TColor; T: TTexture;
    7777  X, Y: Integer; S: string);
    78 function BiColorTextWidth(ca: TCanvas; S: string): Integer;
    79 procedure RisedTextOut(ca: TCanvas; X, Y: Integer; S: string);
    80 procedure LightGradient(ca: TCanvas; X, Y, Width, Color: Integer);
    81 procedure DarkGradient(ca: TCanvas; X, Y, Width, Kind: Integer);
    82 procedure VLightGradient(ca: TCanvas; X, Y, Height, Color: Integer);
    83 procedure VDarkGradient(ca: TCanvas; X, Y, Height, Kind: Integer);
     78function BiColorTextWidth(Canvas: TCanvas; S: string): Integer;
     79procedure RisedTextOut(Canvas: TCanvas; X, Y: Integer; S: string);
     80procedure LightGradient(Canvas: TCanvas; X, Y, Width, Color: Integer);
     81procedure DarkGradient(Canvas: TCanvas; X, Y, Width, Kind: Integer);
     82procedure VLightGradient(Canvas: TCanvas; X, Y, Height, Color: Integer);
     83procedure VDarkGradient(Canvas: TCanvas; X, Y, Height, Kind: Integer);
    8484procedure UnderlinedTitleValue(Canvas: TCanvas; Title, Value: string; X, Y, Width: Integer);
    8585procedure NumberBar(dst: TBitmap; X, Y: Integer; Cap: string; val: Integer;
    … …  
    8787procedure CountBar(dst: TBitmap; X, Y, W: Integer; Kind: Integer;
    8888  Cap: string; val: Integer; T: TTexture);
    89 procedure PaintProgressBar(ca: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer;
     89procedure PaintProgressBar(Canvas: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer;
    9090  T: TTexture);
    91 procedure PaintRelativeProgressBar(ca: TCanvas;
     91procedure PaintRelativeProgressBar(Canvas: TCanvas;
    9292  Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean;
    9393  T: TTexture);
    … …  
    199199
    200200uses
    201   Directories, Sound, UPixelPointer;
     201  Directories, Sound, PixelPointer;
    202202
    203203var
    … …  
    318318end;
    319319
    320 procedure BtnFrame(ca: TCanvas; P: TRect; T: TTexture);
    321 begin
    322   RFrame(ca, P.Left - 1, P.Top - 1, P.Right, P.Bottom, T.ColorBevelShade,
     320procedure BtnFrame(Canvas: TCanvas; P: TRect; T: TTexture);
     321begin
     322  RFrame(Canvas, P.Left - 1, P.Top - 1, P.Right, P.Bottom, T.ColorBevelShade,
    323323    T.ColorBevelLight);
    324324end;
    325325
    326 procedure EditFrame(ca: TCanvas; P: TRect; T: TTexture);
    327 begin
    328   Frame(ca, P.Left - 1, P.Top - 1, P.Right, P.Bottom, $000000, $000000);
    329   Frame(ca, P.Left - 2, P.Top - 2, P.Right + 1, P.Bottom + 1, $000000, $000000);
    330   Frame(ca, P.Left - 3, P.Top - 3, P.Right + 2, P.Bottom + 1, $000000, $000000);
    331   RFrame(ca, P.Left - 4, P.Top - 4, P.Right + 3, P.Bottom + 2, T.ColorBevelShade,
     326procedure EditFrame(Canvas: TCanvas; P: TRect; T: TTexture);
     327begin
     328  Frame(Canvas, P.Left - 1, P.Top - 1, P.Right, P.Bottom, $000000, $000000);
     329  Frame(Canvas, P.Left - 2, P.Top - 2, P.Right + 1, P.Bottom + 1, $000000, $000000);
     330  Frame(Canvas, P.Left - 3, P.Top - 3, P.Right + 2, P.Bottom + 1, $000000, $000000);
     331  RFrame(Canvas, P.Left - 4, P.Top - 4, P.Right + 3, P.Bottom + 2, T.ColorBevelShade,
    332332    T.ColorBevelLight);
    333333end;
    … …  
    371371begin
    372372  Bitmap.BeginUpdate;
    373   PixelPtr := PixelPointer(Bitmap);
     373  PixelPtr := TPixelPointer.Create(Bitmap);
    374374  for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
    375375    for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    … …  
    388388begin
    389389  //Dst.SetSize(Src.Width, Src.Height);
    390   SrcPtr := PixelPointer(Src);
    391   DstPtr := PixelPointer(Dst);
     390  SrcPtr := TPixelPointer.Create(Src);
     391  DstPtr := TPixelPointer.Create(Dst);
    392392  for Y := 0 to ScaleToNative(Src.Height - 1) do begin
    393393    for X := 0 to ScaleToNative(Src.Width - 1) do begin
    … …  
    520520      Result.Data.BeginUpdate;
    521521      Result.Mask.BeginUpdate;
    522       DataPixel := PixelPointer(Result.Data);
    523       MaskPixel := PixelPointer(Result.Mask);
     522      DataPixel := TPixelPointer.Create(Result.Data);
     523      MaskPixel := TPixelPointer.Create(Result.Mask);
    524524      for Y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin
    525525        for X := 0 to ScaleToNative(Result.Data.Width) - 1 do begin
    … …  
    564564begin
    565565  Dst.BeginUpdate;
    566   PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     566  PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y));
    567567  for YY := 0 to ScaleToNative(Height) - 1 do begin
    568568    for XX := 0 to ScaleToNative(Width) - 1 do begin
    … …  
    583583begin
    584584  Dst.BeginUpdate;
    585   PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     585  PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y));
    586586  for yy := 0 to ScaleToNative(Height) - 1 do begin
    587587    for xx := 0 to ScaleToNative(Width) - 1 do begin
    … …  
    603603begin
    604604  Dst.BeginUpdate;
    605   PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     605  PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y));
    606606  for YY := 0 to ScaleToNative(Height) - 1 do begin
    607607    for XX := 0 to ScaleToNative(Width) - 1 do begin
    … …  
    654654  dst.BeginUpdate;
    655655  Src.BeginUpdate;
    656   PixelDst := PixelPointer(Dst, xDst, yDst);
    657   PixelSrc := PixelPointer(Src, xSrc, ySrc);
     656  PixelDst := TPixelPointer.Create(Dst, xDst, yDst);
     657  PixelSrc := TPixelPointer.Create(Src, xSrc, ySrc);
    658658  for Y := 0 to Height - 1 do begin
    659659    for X := 0 to Width - 1 do  begin
    … …  
    720720  Src.BeginUpdate;
    721721  dst.BeginUpdate;
    722   SrcPixel := PixelPointer(Src, xSrc, ySrc);
    723   DstPixel := PixelPointer(Dst, xDst, yDst);
     722  SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc);
     723  DstPixel := TPixelPointer.Create(Dst, xDst, yDst);
    724724  for iy := 0 to Height - 1 do begin
    725725    for ix := 0 to Width - 1 do begin
    … …  
    777777  Src.BeginUpdate;
    778778  Dst.BeginUpdate;
    779   SrcPixel := PixelPointer(Src, xSrc, ySrc);
    780   DstPixel := PixelPointer(Dst, xDst, yDst);
     779  SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc);
     780  DstPixel := TPixelPointer.Create(Dst, xDst, yDst);
    781781  for iy := 0 to Height - 1 do begin
    782782    for ix := 0 to Width - 1 do begin
    … …  
    823823  Assert(bmp.PixelFormat = pf24bit);
    824824  Height := Y + Height;
    825   PixelPtr := PixelPointer(Bmp, X, Y);
     825  PixelPtr := TPixelPointer.Create(Bmp, X, Y);
    826826  while Y < Height do begin
    827827    for I := 0 to Width - 1 do begin
    … …  
    890890end;
    891891
    892 procedure SLine(ca: TCanvas; x0, x1, Y: Integer; cl: TColor);
    893 begin
    894   with ca do begin
     892procedure SLine(Canvas: TCanvas; x0, x1, Y: Integer; cl: TColor);
     893begin
     894  with Canvas do begin
    895895    Pen.Color := cl;
    896896    MoveTo(x0, Y);
    … …  
    899899end;
    900900
    901 procedure DLine(ca: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor);
    902 begin
    903   with ca do begin
     901procedure DLine(Canvas: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor);
     902begin
     903  with Canvas do begin
    904904    Pen.Color := cl0;
    905905    MoveTo(x0, Y);
    … …  
    913913end;
    914914
    915 procedure Frame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
    916 begin
    917   with ca do begin
     915procedure Frame(Canvas: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
     916begin
     917  with Canvas do begin
    918918    MoveTo(x0, y1);
    919919    Pen.Color := cl0;
    … …  
    926926end;
    927927
    928 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
    929 begin
    930   with ca do begin
     928procedure RFrame(Canvas: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor);
     929begin
     930  with Canvas do begin
    931931    Pen.Color := cl0;
    932932    MoveTo(x0, y0 + 1);
    … …  
    942942end;
    943943
    944 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor);
    945 begin
    946   with ca do begin
     944procedure CFrame(Canvas: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor);
     945begin
     946  with Canvas do begin
    947947    Pen.Color := cl;
    948948    MoveTo(x0, y0 + Corner - 1);
    … …  
    961961end;
    962962
    963 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     963procedure FrameImage(Canvas: TCanvas; Src: TBitmap;
    964964  X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False);
    965965begin
    966966  if IsControl then begin
    967     Frame(ca, X - 1, Y - 1, X + Width, Y + Height, $B0B0B0, $FFFFFF);
    968     RFrame(ca, X - 2, Y - 2, X + Width + 1, Y + Height + 1, $FFFFFF, $B0B0B0);
     967    Frame(Canvas, X - 1, Y - 1, X + Width, Y + Height, $B0B0B0, $FFFFFF);
     968    RFrame(Canvas, X - 2, Y - 2, X + Width + 1, Y + Height + 1, $FFFFFF, $B0B0B0);
    969969  end else
    970     Frame(ca, X - 1, Y - 1, X + Width, Y + Height, $000000, $000000);
    971   BitBltCanvas(ca, X, Y, Width, Height, Src.Canvas, xSrc, ySrc);
     970    Frame(Canvas, X - 1, Y - 1, X + Width, Y + Height, $000000, $000000);
     971  BitBltCanvas(Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc);
    972972end;
    973973
    … …  
    984984  Height := ScaleToNative(Height);
    985985  Dst.BeginUpdate;
    986   DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1);
     986  DstPtr := TPixelPointer.Create(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1);
    987987  for Y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
    988988    for X := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
    … …  
    10361036    MainTexture.ColorBevelLight and $FCFCFC shr 2);
    10371037  HGrSystem2.Data.BeginUpdate;
    1038   PixelPtr := PixelPointer(HGrSystem2.Data, ScaleToNative(Ornament.Left),
     1038  PixelPtr := TPixelPointer.Create(HGrSystem2.Data, ScaleToNative(Ornament.Left),
    10391039    ScaleToNative(Ornament.Top));
    10401040  if PixelPtr.BytesPerPixel = 3 then begin
    … …  
    10631063end;
    10641064
    1065 procedure InitCityMark(T: TTexture);
     1065procedure InitCityMark(Texture: TTexture);
    10661066var
    10671067  X: Integer;
    … …  
    10761076          X, CityMark1.Top + Y] and $FF;
    10771077        HGrSystem.Data.Canvas.Pixels[CityMark2.Left + X, CityMark2.Top + Y] :=
    1078           T.ColorMark and $FF * Intensity div $FF + T.ColorMark shr 8 and
    1079           $FF * Intensity div $FF shl 8 + T.ColorMark shr 16 and
     1078          Texture.ColorMark and $FF * Intensity div $FF + Texture.ColorMark shr 8 and
     1079          $FF * Intensity div $FF shl 8 + Texture.ColorMark shr 16 and
    10801080          $FF * Intensity div $FF shl 16;
    10811081      end;
    … …  
    10861086end;
    10871087
    1088 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
    1089 begin
    1090   Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= MainTexture.Width) and
    1091     (Top + yOffset >= 0) and (Top + yOffset + Height <= MainTexture.Height));
    1092   BitBltCanvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas,
     1088procedure Fill(Canvas: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
     1089begin
     1090  //Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= MainTexture.Width) and
     1091  //  (Top + yOffset >= 0) and (Top + yOffset + Height <= MainTexture.Height));
     1092  BitBltCanvas(Canvas, Left, Top, Width, Height, MainTexture.Image.Canvas,
    10931093    Left + xOffset, Top + yOffset);
    10941094end;
    … …  
    10991099end;
    11001100
    1101 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
     1101procedure FillLarge(Canvas: TCanvas; x0, y0, x1, y1, xm: Integer);
    11021102
    11031103  function Band(I: Integer): Integer;
    … …  
    11171117begin
    11181118  for I := 0 to (x1 - xm) div MainTexture.Width - 1 do
    1119     BitBltCanvas(ca, xm + I * MainTexture.Width, y0, MainTexture.Width, y1 - y0,
     1119    BitBltCanvas(Canvas, xm + I * MainTexture.Width, y0, MainTexture.Width, y1 - y0,
    11201120      MainTexture.Image.Canvas, 0, MainTexture.Height div 2 + Band(I) *
    11211121      (y1 - y0));
    1122   BitBltCanvas(ca, xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width, y0,
     1122  BitBltCanvas(Canvas, xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width, y0,
    11231123    x1 - (xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width), y1 - y0,
    11241124    MainTexture.Image.Canvas, 0, MainTexture.Height div 2 + Band(
    11251125    (x1 - xm) div MainTexture.Width) * (y1 - y0));
    11261126  for I := 0 to (xm - x0) div MainTexture.Width - 1 do
    1127     BitBltCanvas(ca, xm - (I + 1) * MainTexture.Width, y0, MainTexture.Width, y1 - y0,
     1127    BitBltCanvas(Canvas, xm - (I + 1) * MainTexture.Width, y0, MainTexture.Width, y1 - y0,
    11281128      MainTexture.Image.Canvas, 0, MainTexture.Height div 2 +
    11291129      Band(-I - 1) * (y1 - y0));
    1130   BitBltCanvas(ca, x0, y0, xm - ((xm - x0) div MainTexture.Width) *
     1130  BitBltCanvas(Canvas, x0, y0, xm - ((xm - x0) div MainTexture.Width) *
    11311131    MainTexture.Width - x0, y1 - y0, MainTexture.Image.Canvas,
    11321132    ((xm - x0) div MainTexture.Width + 1) * MainTexture.Width - (xm - x0),
    … …  
    11341134end;
    11351135
    1136 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
     1136procedure FillSeamless(Canvas: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
    11371137  const Texture: TBitmap);
    11381138var
    … …  
    11611161      if x1cut < 0 then
    11621162        x1cut := 0;
    1163       BitBltCanvas(ca, X * Texture.Width + x0cut - xOffset,
     1163      BitBltCanvas(Canvas, X * Texture.Width + x0cut - xOffset,
    11641164        Y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,
    11651165        Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut);
    … …  
    11681168end;
    11691169
    1170 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
     1170procedure FillRectSeamless(Canvas: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    11711171  const Texture: TBitmap);
    11721172begin
    1173   FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
     1173  FillSeamless(Canvas, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
    11741174end;
    11751175
    … …  
    11801180end;
    11811181
    1182 procedure Corner(ca: TCanvas; X, Y, Kind: Integer; T: TTexture);
    1183 begin
    1184   { BitBltCanvas(ca,x,y,8,8,T.HGr.Mask.Canvas,
     1182procedure Corner(Canvas: TCanvas; X, Y, Kind: Integer; T: TTexture);
     1183begin
     1184  { BitBltCanvas(Canvas,x,y,8,8,T.HGr.Mask.Canvas,
    11851185    T.xGr+29+Kind*9,T.yGr+89,SRCAND);
    1186     BitBltCanvas(ca,X,Y,8,8,T.HGr.Data.Canvas,
     1186    BitBltCanvas(Canvas,X,Y,8,8,T.HGr.Data.Canvas,
    11871187    T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); }
    11881188end;
    11891189
    1190 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
     1190procedure BiColorTextOut(Canvas: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
    11911191
    11921192  procedure PaintIcon(X, Y, Kind: Integer);
    11931193  begin
    1194     BitBltCanvas(ca, X, Y + 6, 10, 10, HGrSystem.Mask.Canvas,
     1194    BitBltCanvas(Canvas, X, Y + 6, 10, 10, HGrSystem.Mask.Canvas,
    11951195      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND);
    1196     BitBltCanvas(ca, X, Y + 6, 10, 10, HGrSystem.Data.Canvas,
     1196    BitBltCanvas(Canvas, X, Y + 6, 10, 10, HGrSystem.Data.Canvas,
    11971197      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT);
    11981198  end;
    … …  
    12071207  Inc(Y);
    12081208  for shadow := True downto False do
    1209     with ca do
     1209    with Canvas do
    12101210      if not shadow or (clBack <> $7F007F) then
    12111211      begin
    … …  
    12211221            (sp[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then
    12221222          begin
    1223             ca.Textout(xp, Y, sp);
     1223            Canvas.Textout(xp, Y, sp);
    12241224            Break;
    12251225          end
    … …  
    12281228            Text := Copy(sp, 1, P - 1);
    12291229            Textout(xp, Y, Text);
    1230             Inc(xp, ca.TextWidth(Text));
     1230            Inc(xp, Canvas.TextWidth(Text));
    12311231            if not shadow then
    12321232              case sp[P + 1] of
    … …  
    12511251end;
    12521252
    1253 function BiColorTextWidth(ca: TCanvas; S: string): Integer;
     1253function BiColorTextWidth(Canvas: TCanvas; S: string): Integer;
    12541254var
    12551255  P: Integer;
    … …  
    12601260    if (P = 0) or (P = Length(S)) then
    12611261    begin
    1262       Inc(Result, ca.TextWidth(S));
     1262      Inc(Result, Canvas.TextWidth(S));
    12631263      Break;
    12641264    end
    … …  
    12671267      if not (S[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
    12681268      then
    1269         Inc(Result, ca.TextWidth(Copy(S, 1, P + 1)))
     1269        Inc(Result, Canvas.TextWidth(Copy(S, 1, P + 1)))
    12701270      else
    1271         Inc(Result, ca.TextWidth(Copy(S, 1, P - 1)) + 10);
     1271        Inc(Result, Canvas.TextWidth(Copy(S, 1, P - 1)) + 10);
    12721272      Delete(S, 1, P + 1);
    12731273    end;
    … …  
    12751275end;
    12761276
    1277 procedure LoweredTextOut(ca: TCanvas; cl: TColor; T: TTexture;
     1277procedure LoweredTextOut(Canvas: TCanvas; cl: TColor; T: TTexture;
    12781278  X, Y: Integer; S: string);
    12791279begin
    12801280  if cl = -2 then
    1281     BiColorTextOut(ca, (T.ColorBevelShade and $FEFEFE) shr 1,
     1281    BiColorTextOut(Canvas, (T.ColorBevelShade and $FEFEFE) shr 1,
    12821282      T.ColorBevelLight, X, Y, S)
    12831283  else if cl < 0 then
    1284     BiColorTextOut(ca, T.ColorTextShade, T.ColorTextLight, X, Y, S)
     1284    BiColorTextOut(Canvas, T.ColorTextShade, T.ColorTextLight, X, Y, S)
    12851285  else
    1286     BiColorTextOut(ca, cl, T.ColorTextLight, X, Y, S);
    1287 end;
    1288 
    1289 procedure RisedTextOut(ca: TCanvas; X, Y: Integer; S: string);
    1290 begin
    1291   BiColorTextOut(ca, $FFFFFF, $000000, X, Y, S);
    1292 end;
    1293 
    1294 procedure Gradient(ca: TCanvas; X, Y, dx, dy, Width, Height, Color: Integer;
     1286    BiColorTextOut(Canvas, cl, T.ColorTextLight, X, Y, S);
     1287end;
     1288
     1289procedure RisedTextOut(Canvas: TCanvas; X, Y: Integer; S: string);
     1290begin
     1291  BiColorTextOut(Canvas, $FFFFFF, $000000, X, Y, S);
     1292end;
     1293
     1294procedure Gradient(Canvas: TCanvas; X, Y, dx, dy, Width, Height, Color: Integer;
    12951295  Brightness: array of Integer);
    12961296var
    … …  
    13131313    else if B >= 256 then
    13141314      B := 255;
    1315     ca.Pen.Color := R + G shl 8 + B shl 16;
    1316     ca.MoveTo(X + dx * I, Y + dy * I);
    1317     ca.LineTo(X + dx * I + Width, Y + dy * I + Height);
    1318   end;
    1319   ca.Pen.Color := $000000;
    1320   ca.MoveTo(X + 1, Y + 16 * dy + Height);
    1321   ca.LineTo(X + 16 * dx + Width, Y + 16 * dy + Height);
    1322   ca.LineTo(X + 16 * dx + Width, Y);
    1323 end;
    1324 
    1325 procedure LightGradient(ca: TCanvas; X, Y, Width, Color: Integer);
     1315    Canvas.Pen.Color := R + G shl 8 + B shl 16;
     1316    Canvas.MoveTo(X + dx * I, Y + dy * I);
     1317    Canvas.LineTo(X + dx * I + Width, Y + dy * I + Height);
     1318  end;
     1319  Canvas.Pen.Color := $000000;
     1320  Canvas.MoveTo(X + 1, Y + 16 * dy + Height);
     1321  Canvas.LineTo(X + 16 * dx + Width, Y + 16 * dy + Height);
     1322  Canvas.LineTo(X + 16 * dx + Width, Y);
     1323end;
     1324
     1325procedure LightGradient(Canvas: TCanvas; X, Y, Width, Color: Integer);
    13261326const
    13271327  Brightness: array [0 .. 15] of Integer =
    13281328    (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
    13291329begin
    1330   Gradient(ca, X, Y, 0, 1, Width, 0, Color, Brightness);
    1331 end;
    1332 
    1333 procedure DarkGradient(ca: TCanvas; X, Y, Width, Kind: Integer);
     1330  Gradient(Canvas, X, Y, 0, 1, Width, 0, Color, Brightness);
     1331end;
     1332
     1333procedure DarkGradient(Canvas: TCanvas; X, Y, Width, Kind: Integer);
    13341334const
    13351335  Brightness: array [0 .. 15] of Integer =
    13361336    (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
    13371337begin
    1338   Gradient(ca, X, Y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels
     1338  Gradient(Canvas, X, Y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels
    13391339    [187, 137 + Kind], Brightness);
    13401340end;
    13411341
    1342 procedure VLightGradient(ca: TCanvas; X, Y, Height, Color: Integer);
     1342procedure VLightGradient(Canvas: TCanvas; X, Y, Height, Color: Integer);
    13431343const
    13441344  Brightness: array [0 .. 15] of Integer =
    13451345    (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
    13461346begin
    1347   Gradient(ca, X, Y, 1, 0, 0, Height, Color, Brightness);
    1348 end;
    1349 
    1350 procedure VDarkGradient(ca: TCanvas; X, Y, Height, Kind: Integer);
     1347  Gradient(Canvas, X, Y, 1, 0, 0, Height, Color, Brightness);
     1348end;
     1349
     1350procedure VDarkGradient(Canvas: TCanvas; X, Y, Height, Kind: Integer);
    13511351const
    13521352  Brightness: array [0 .. 15] of Integer =
    13531353    (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
    13541354begin
    1355   Gradient(ca, X, Y, 1, 0, 0, Height,
     1355  Gradient(Canvas, X, Y, 1, 0, 0, Height,
    13561356    HGrSystem.Data.Canvas.Pixels[187, 137 + Kind], Brightness);
    13571357end;
    … …  
    14761476end;
    14771477
    1478 procedure PaintProgressBar(ca: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer;
     1478procedure PaintProgressBar(Canvas: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer;
    14791479  T: TTexture);
    14801480var
    … …  
    14941494  else if Pos + Growth > Max then
    14951495    Growth := Max - Pos;
    1496   Frame(ca, X - 1, Y - 1, X + Max, Y + 7, $000000, $000000);
    1497   RFrame(ca, X - 2, Y - 2, X + Max + 1, Y + 8, T.ColorBevelShade,
     1496  Frame(Canvas, X - 1, Y - 1, X + Max, Y + 7, $000000, $000000);
     1497  RFrame(Canvas, X - 2, Y - 2, X + Max + 1, Y + 8, T.ColorBevelShade,
    14981498    T.ColorBevelLight);
    1499   with ca do
     1499  with Canvas do
    15001500  begin
    15011501    for I := 0 to Pos div 8 - 1 do
    1502       BitBltCanvas(ca, X + I * 8, Y, 8, 7,
     1502      BitBltCanvas(Canvas, X + I * 8, Y, 8, 7,
    15031503        HGrSystem.Data.Canvas, 104, 9 + 8 * Kind);
    1504     BitBltCanvas(ca, X + 8 * (Pos div 8), Y, Pos - 8 * (Pos div 8), 7,
     1504    BitBltCanvas(Canvas, X + 8 * (Pos div 8), Y, Pos - 8 * (Pos div 8), 7,
    15051505      HGrSystem.Data.Canvas, 104, 9 + 8 * Kind);
    15061506    if Growth > 0 then
    15071507    begin
    15081508      for I := 0 to Growth div 8 - 1 do
    1509         BitBltCanvas(ca, X + Pos + I * 8, Y, 8, 7,
     1509        BitBltCanvas(Canvas, X + Pos + I * 8, Y, 8, 7,
    15101510          HGrSystem.Data.Canvas, 112, 9 + 8 * Kind);
    1511       BitBltCanvas(ca, X + Pos + 8 * (Growth div 8), Y,
     1511      BitBltCanvas(Canvas, X + Pos + 8 * (Growth div 8), Y,
    15121512        Growth - 8 * (Growth div 8), 7, HGrSystem.Data.Canvas,
    15131513        112, 9 + 8 * Kind);
    … …  
    15161516    begin
    15171517      for I := 0 to -Growth div 8 - 1 do
    1518         BitBltCanvas(ca, X + Pos + I * 8, Y, 8, 7,
     1518        BitBltCanvas(Canvas, X + Pos + I * 8, Y, 8, 7,
    15191519          HGrSystem.Data.Canvas, 104, 1);
    1520       BitBltCanvas(ca, X + Pos + 8 * (-Growth div 8), Y, -Growth -
     1520      BitBltCanvas(Canvas, X + Pos + 8 * (-Growth div 8), Y, -Growth -
    15211521        8 * (-Growth div 8), 7,
    15221522        HGrSystem.Data.Canvas, 104, 1);
    … …  
    15291529
    15301530// pos and growth are relative to max, set size independent
    1531 procedure PaintRelativeProgressBar(ca: TCanvas;
     1531procedure PaintRelativeProgressBar(Canvas: TCanvas;
    15321532  Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean;
    15331533  T: TTexture);
    15341534begin
    15351535  if Growth > 0 then
    1536     PaintProgressBar(ca, Kind, X, Y, Pos * size div Max,
     1536    PaintProgressBar(Canvas, Kind, X, Y, Pos * size div Max,
    15371537      (Growth * size + Max div 2) div Max, size, T)
    15381538  else
    1539     PaintProgressBar(ca, Kind, X, Y, Pos * size div Max,
     1539    PaintProgressBar(Canvas, Kind, X, Y, Pos * size div Max,
    15401540      (Growth * size - Max div 2) div Max, size, T);
    15411541  if IndicateComplete and (Pos + Growth >= Max) then
    1542     Sprite(ca, HGrSystem, X + size - 10, Y - 7, 23, 16, 1, 129);
     1542    Sprite(Canvas, HGrSystem, X + size - 10, Y - 7, 23, 16, 1, 129);
    15431543end;
    15441544
    … …  
    15911591  TexWidth := Texture.Width;
    15921592  TexHeight := Texture.Height;
    1593   DstPixel := PixelPointer(Dest);
    1594   SrcPixel := PixelPointer(Texture);
     1593  DstPixel := TPixelPointer.Create(Dest);
     1594  SrcPixel := TPixelPointer.Create(Texture);
    15951595  for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin
    15961596    for X := 0 to ScaleToNative(Dest.Width) - 1 do begin
    … …  
    16141614begin
    16151615  Bitmap.BeginUpdate;
    1616   PicturePixel := PixelPointer(Bitmap);
     1616  PicturePixel := TPixelPointer.Create(Bitmap);
    16171617  for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
    16181618    for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin

  • trunk/Packages/CevoComponents/Texture.pas

    r455 r456  
    1 unit UTexture;
    2 
    3 {$mode objfpc}{$H+}
     1unit Texture;
    42
    53interface
Note: See TracChangeset for help on using the changeset viewer.