Changeset 192 for trunk/Packages/CevoComponents/ScreenTools.pas

Timestamp:

May 7, 2020, 12:30:04 PM (5 years ago)

Author:

chronos

Message:

• Modified: Code cleanup.
• Modified: Simplified initialization of brain pictures.
• Modified: Use GetAiDir function for AI subdirectory.

File:

• trunk/Packages/CevoComponents/ScreenTools.pas (modified) (10 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -7 +7 @@
   Windows,
   {$ENDIF}
-  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls,
+  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
   Forms, Menus, GraphType;
 
@@ -35 +35 @@
 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
   overload;
-procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
+procedure MakeBlue(dst: TBitmap; x, y, Width, Height: Integer);
 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
 procedure ImageOp_BCC(dst, Src: TBitmap;
@@ -41 +41 @@
 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer;
-  SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+  SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
+function BitBltCanvas(Dest: TCanvas; DestRect: TRect;
+  Src: TCanvas; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
+function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
+  Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
+function BitBltBitmap(Dest: TBitmap; DestRect: TRect;
+  Src: TBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
@@ -52 +58 @@
 procedure InitOrnament;
 procedure InitCityMark(const T: TTexture);
-procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
+procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload;
+procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint); overload;
 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
@@ -82 +89 @@
 procedure LoadPhrases;
 procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Integer);
+procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
 
 const
@@ -527 +535 @@
 end;
 
-procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
+procedure MakeBlue(dst: TBitmap; x, y, Width, Height: Integer);
 var
   XX, YY: integer;
@@ -534 +542 @@
   Dst.BeginUpdate;
   PixelPtr.Init(Dst, X, Y);
-  for yy := 0 to h - 1 do begin
-    for xx := 0 to w - 1 do begin
+  for yy := 0 to Height - 1 do begin
+    for xx := 0 to Width - 1 do begin
       PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
       PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
@@ -730 +738 @@
     Result := True;
   end else Result := BitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
+end;
+
+function BitBltCanvas(Dest: TCanvas; DestRect: TRect; Src: TCanvas;
+  SrcPos: TPoint; Rop: DWORD): Boolean;
+begin
+  Result := BitBltCanvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height,
+    Src, SrcPos.X, SrcPos.Y, Rop);
+end;
+
+function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
+  Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := BitBltCanvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop);
+end;
+
+function BitBltBitmap(Dest: TBitmap; DestRect: TRect; Src: TBitmap;
+  SrcPos: TPoint; Rop: DWORD): Boolean;
+begin
+  Result := BitBltCanvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop);
 end;
 
@@ -901 +928 @@
   BitBltCanvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas,
     Left + xOffset, Top + yOffset);
+end;
+
+procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint);
+begin
+  Fill(Canvas, Rect.Left, Rect.Top, Rect.Width, Rect.Height, Offset.X, Offset.Y);
 end;
 
@@ -1426 +1458 @@
 end;
 
+procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
+var
+  x, y: integer;
+  PicturePixel: TPixelPointer;
+begin
+  Bitmap.BeginUpdate;
+  PicturePixel.Init(Bitmap);
+  for y := 0 to Bitmap.Height - 1 do begin
+    for x := 0 to Bitmap.Width - 1 do begin
+      PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
+      PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
+      PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - Change, 0);
+      PicturePixel.NextPixel;
+    end;
+    PicturePixel.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
 procedure LoadFonts;
 var