Changeset 380 for trunk/Packages

Timestamp:

Apr 25, 2021, 10:39:00 AM (4 years ago)

Author:

chronos

Message:

• Modified: TTexture class moved to seprate unit.

Location:

trunk/Packages/CevoComponents

Files:

• CevoComponents.lpk (modified) (2 diffs)
• CevoComponents.pas (modified) (1 diff)
• ScreenTools.pas (modified) (2 diffs)
• UTexture.pas (added)

trunk/Packages/CevoComponents/CevoComponents.lpk

@@ -37 +37 @@
     <Description Value="C-evo components"/>
     <Version Major="1" Minor="2"/>
-    <Files Count="17">
+    <Files Count="18">
       <Item1>
         <Filename Value="Area.pas"/>
@@ -114 +114 @@
         <UnitName Value="UXMLUtils"/>
       </Item17>
+      <Item18>
+        <Filename Value="UTexture.pas"/>
+        <UnitName Value="UTexture"/>
+      </Item18>
     </Files>
     <RequiredPkgs Count="2">

trunk/Packages/CevoComponents/CevoComponents.pas

@@ -11 +11 @@
   Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 
   Sound, BaseWin, UPixelPointer, AsyncProcess2, UGraphicSet, UXMLUtils, 
-  LazarusPackageIntf;
+  UTexture, LazarusPackageIntf;
 
 implementation

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -8 +8 @@
   {$ENDIF}
   StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
-  Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils;
+  Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils, UTexture;
 
 type
-
-  { TTexture }
-
-  TTexture = class
-  private
-    FAge: Integer;
-    function GetHeight: Integer;
-    function GetWidth: Integer;
-    procedure SetAge(AValue: Integer);
-  public
-    Image: TBitmap;
-    ColorBevelLight: TColor;
-    ColorBevelShade: TColor;
-    ColorTextLight: TColor;
-    ColorTextShade: TColor;
-    ColorLitText: TColor;
-    ColorMark: TColor;
-    ColorPage: TColor;
-    ColorCover: TColor;
-    constructor Create;
-    destructor Destroy; override;
-    procedure Assign(Source: TTexture);
-    property Age: Integer read FAge write SetAge;
-    property Width: Integer read GetWidth;
-    property Height: Integer read GetHeight;
-  end;
-
   TLoadGraphicFileOption = (gfNoError, gfNoGamma);
   TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
@@ -1844 +1817 @@
 end;
 
-{ TTexture }
-
-procedure TTexture.SetAge(AValue: Integer);
-begin
-  if FAge = AValue then Exit;
-  FAge := AValue;
-  LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator +
-    'Texture' + IntToStr(Age + 1) + '.jpg');
-  ColorBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
-  ColorBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
-  ColorTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
-  ColorTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
-  ColorLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
-  ColorMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
-  ColorPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
-  ColorCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
-end;
-
-function TTexture.GetHeight: Integer;
-begin
-  Result := Image.Height;
-end;
-
-function TTexture.GetWidth: Integer;
-begin
-  Result := Image.Width;
-end;
-
-constructor TTexture.Create;
-begin
-  Image := TBitmap.Create;
-  FAge := -2;
-end;
-
-destructor TTexture.Destroy;
-begin
-  FreeAndNil(Image);
-  inherited;
-end;
-
-procedure TTexture.Assign(Source: TTexture);
-begin
-  FAge := Source.FAge;
-  Image.Assign(Image);
-  ColorBevelLight := Source.ColorBevelLight;
-  ColorBevelShade := Source.ColorBevelShade;
-  ColorTextLight := Source.ColorTextLight;
-  ColorTextShade := Source.ColorTextShade;
-  ColorLitText := Source.ColorLitText;
-  ColorMark := Source.ColorMark;
-  ColorPage := Source.ColorPage;
-  ColorCover := Source.ColorCover;
-end;
-
 end.