Changeset 276 for tools

Timestamp:

Sep 5, 2020, 12:39:05 AM (4 years ago)

Author:

chronos

Message:

• Added: Action to convert magenta transparency png images to images with alpha channel.

Location:

tools/Image resize

Files:

• . (modified) (1 prop)
• ImageResize.lpi (modified) (2 diffs)
• ImageResize.lpr (modified) (2 diffs)
• Templates.txt (added)
• UBitmapSet.pas (added)
• UXMLUtils.pas (added)
• uformmain.lfm (modified) (1 diff)
• uformmain.pas (modified) (4 diffs)

tools/Image resize/ImageResize.lpi

@@ -31 +31 @@
       </Item1>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="4">
       <Unit0>
         <Filename Value="ImageResize.lpr"/>
@@ -39 +39 @@
         <Filename Value="uformmain.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
+        <ComponentName Value="FormMain"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UFormMain"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="UBitmapSet.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="UXMLUtils.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
     </Units>
   </ProjectOptions>

tools/Image resize/ImageResize.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UFormMain
+  Forms, UFormMain, UBitmapSet
   { you can add units after this };
 
@@ -17 +17 @@
   Application.Scaled:=True;
   Application.Initialize;
-  Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TFormMain, FormMain);
   Application.Run;
 end.

tools/Image resize/uformmain.lfm

@@ -1 @@
-object Form1: TForm1
+object FormMain: TFormMain
   Left = 534
-  Height = 300
+  Height = 312
   Top = 388
-  Width = 400
-  Caption = 'Form1'
-  DesignTimePPI = 120
+  Width = 417
+  Caption = 'Image resize'
+  ClientHeight = 312
+  ClientWidth = 417
+  DesignTimePPI = 125
   OnShow = FormShow
-  LCLVersion = '2.0.6.0'
+  LCLVersion = '2.0.10.0'
+  object ButtonResize: TButton
+    Left = 16
+    Height = 33
+    Top = 16
+    Width = 98
+    Caption = 'Resize'
+    OnClick = ButtonResizeClick
+    TabOrder = 0
+  end
+  object ButtonAlpha: TButton
+    Left = 16
+    Height = 33
+    Top = 64
+    Width = 144
+    Caption = 'Alpha channel'
+    OnClick = ButtonAlphaClick
+    TabOrder = 1
+  end
 end

tools/Image resize/uformmain.pas

@@ -1 +1 @@
 unit UFormMain;
 
-{$mode objfpc}{$H+}
+{$mode delphi}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  Math, LazFileUtils;
 
 type
 
-  { TForm1 }
-
-  TForm1 = class(TForm)
+  { TFormMain }
+
+  TFormMain = class(TForm)
+    ButtonAlpha: TButton;
+    ButtonResize: TButton;
+    procedure ButtonAlphaClick(Sender: TObject);
+    procedure ButtonResizeClick(Sender: TObject);
     procedure FormShow(Sender: TObject);
   private
-
+    function SwapColors(Color: Cardinal): Cardinal;
+    procedure UseAlpha(SourceName: string; BBC: Boolean);
   public
     procedure ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
@@ -21 +27 @@
   end;
 
-var
-  Form1: TForm1;
+  TColor32 = type Cardinal;
+  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
+  TPixel32 = packed record
+    case Integer of
+      0: (B, G, R, A: Byte);
+      1: (ARGB: TColor32);
+      2: (Planes: array[0..3] of Byte);
+      3: (Components: array[TColor32Component] of Byte);
+  end;
+  PPixel32 = ^TPixel32;
+
+var
+  FormMain: TFormMain;
 
 implementation
@@ -28 +45 @@
 {$R *.lfm}
 
-{ TForm1 }
-
-procedure TForm1.FormShow(Sender: TObject);
+uses
+  UBitmapSet;
+
+{ TFormMain }
+
+procedure TFormMain.FormShow(Sender: TObject);
+begin
+end;
+
+function TFormMain.SwapColors(Color: Cardinal): Cardinal;
+begin
+  Result := ((Color and $ff0000) shr 16) or (Color and $00ff00) or
+    ((Color and $ff) shl 16) or (Color and $ff000000);
+end;
+
+procedure TFormMain.ButtonResizeClick(Sender: TObject);
 var
   NewSize: TPoint;
@@ -41 +71 @@
 end;
 
-procedure TForm1.ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
+procedure TFormMain.ButtonAlphaClick(Sender: TObject);
+const
+  Files: array[0..11] of string = (
+    'Cities66x32.png', 'Cities96x48.png', 'Cities144x72.png',
+    'Terrain66x32.png', 'Terrain96x48.png', 'Terrain144x72.png',
+    'Nation1.png', 'Nation2.png', 'StdCities.png', 'StdUnits.png', 'System.png',
+    'System2.png');
+var
+  I: Integer;
+begin
+  I := 0;
+  for I := 0 to Length(Files) - 1 do
+    UseAlpha('../../trunk/Graphics/' + Files[I], False);
+  //UseAlpha('../../trunk/Graphics/Templates.png', True);
+end;
+
+procedure TFormMain.UseAlpha(SourceName: string; BBC: Boolean);
+var
+  ImageSrc: TImage;
+  ImageDest: TImage;
+  X, Y: Integer;
+  PtrSrc: PPixel32;
+  PtrDest: PPixel32;
+  C: TPixel32;
+  Size: TPoint;
+  Trans, Amp1, Amp2, Value: Integer;
+  Color1, Color2: TPixel32;
+  BitmapSet: TBitmapSet;
+  BitmapDesc: TBitmapDesc;
+  I: Integer;
+begin
+  BitmapSet := TBitmapSet.Create;
+  if FileExists(ExtractFileNameOnly(SourceName) + '.txt') then
+    BitmapSet.LoadFromFile(ExtractFileNameOnly(SourceName) + '.txt');
+
+  ImageSrc := TImage.Create(nil);
+  ImageSrc.Picture.LoadFromFile(SourceName);
+  Size := Point(ImageSrc.Picture.Bitmap.Width,
+    ImageSrc.Picture.Bitmap.Height);
+  ImageSrc.Picture.Bitmap.BeginUpdate(True);
+  ImageDest := TImage.Create(nil);
+  ImageDest.Picture.Bitmap.PixelFormat := pf32bit;
+  ImageDest.Picture.Bitmap.SetSize(Size.X, Size.Y);
+  ImageDest.Picture.Bitmap.BeginUpdate(True);
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do begin
+      PtrSrc := ImageSrc.Picture.Bitmap.ScanLine[Y] + X * 4;
+      PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
+      C.ARGB := PtrSrc^.ARGB and $ffffff;
+      //C.ARGB := SwapColors(C.ARGB);
+      if BBC then begin
+        PtrDest^.R := C.R;
+        PtrDest^.G := C.G;
+        PtrDest^.B := 0; //C.B;
+        PtrDest^.A := 255 - C.B; // blue channel = transparency
+      end else begin
+        if (C.ARGB = $7f007f) or (C.ARGB = $ff00ff) then
+          PtrDest^.ARGB := $00000000
+        else PtrDest^.ARGB := SwapColors($ff000000 or C.ARGB);
+      end;
+    end;
+
+{  if BBC then begin
+    for I := 0 to BitmapSet.Items.Count - 1 do begin
+      BitmapDesc := BitmapSet.Items[I];
+      for Y := BitmapDesc.Rect.Top to BitmapDesc.Rect.Top + BitmapDesc.Rect.Height - 1 do
+        for X := BitmapDesc.Rect.Left to BitmapDesc.Rect.Left + BitmapDesc.Rect.Width - 1 do begin
+          Color1.ARGB := BitmapDesc.Color1;
+          Color2.ARGB := BitmapDesc.Color2;
+          PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
+          C.ARGB := PtrDest^.ARGB;
+          trans := C.A * 2;
+          amp1 := C.G * 2;
+          amp2 := C.R * 2;
+          if trans <> $FF then begin
+            Value := (0 * trans + Color2.R * amp2 + Color1.R * amp1) div $FF;
+            PtrDest^.B := Min(Value, 255);
+
+            Value := (0 * trans + Color2.G * amp2 + Color1.G * amp1) div $FF;
+            PtrDest^.G := Min(Value, 255);
+
+            Value := (0 * trans + Color2.B * amp2 + Color1.B * amp1) div $FF;
+            PtrDest^.R := Min(Value, 255);
+
+            PtrDest^.A := 255 - Min(Trans, 255)
+          end;
+        end;
+    end;
+  end;
+    }
+  ImageSrc.Picture.Bitmap.EndUpdate;
+  ImageDest.Picture.Bitmap.EndUpdate;
+  ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
+  ImageSrc.Free;
+  ImageDest.Free;
+  BitmapSet.Free;
+end;
+
+procedure TFormMain.ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
   DestName: string; DestSize: TPoint);
 var