Changeset 276 for tools


Ignore:
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:
3 added
5 edited

Legend:

Unmodified
Added
Removed
  • tools/Image resize

    • Property svn:ignore set to
      lib
      ImageResize
      ImageResize.lps
      ImageResize.res
  • tools/Image resize/ImageResize.lpi

    r181 r276  
    3131      </Item1>
    3232    </RequiredPackages>
    33     <Units Count="2">
     33    <Units Count="4">
    3434      <Unit0>
    3535        <Filename Value="ImageResize.lpr"/>
     
    3939        <Filename Value="uformmain.pas"/>
    4040        <IsPartOfProject Value="True"/>
    41         <ComponentName Value="Form1"/>
     41        <ComponentName Value="FormMain"/>
     42        <HasResources Value="True"/>
    4243        <ResourceBaseClass Value="Form"/>
    4344        <UnitName Value="UFormMain"/>
    4445      </Unit1>
     46      <Unit2>
     47        <Filename Value="UBitmapSet.pas"/>
     48        <IsPartOfProject Value="True"/>
     49      </Unit2>
     50      <Unit3>
     51        <Filename Value="UXMLUtils.pas"/>
     52        <IsPartOfProject Value="True"/>
     53      </Unit3>
    4554    </Units>
    4655  </ProjectOptions>
  • tools/Image resize/ImageResize.lpr

    r181 r276  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain
     10  Forms, UFormMain, UBitmapSet
    1111  { you can add units after this };
    1212
     
    1717  Application.Scaled:=True;
    1818  Application.Initialize;
    19   Application.CreateForm(TForm1, Form1);
     19  Application.CreateForm(TFormMain, FormMain);
    2020  Application.Run;
    2121end.
  • tools/Image resize/uformmain.lfm

    r181 r276  
    1 object Form1: TForm1
     1object FormMain: TFormMain
    22  Left = 534
    3   Height = 300
     3  Height = 312
    44  Top = 388
    5   Width = 400
    6   Caption = 'Form1'
    7   DesignTimePPI = 120
     5  Width = 417
     6  Caption = 'Image resize'
     7  ClientHeight = 312
     8  ClientWidth = 417
     9  DesignTimePPI = 125
    810  OnShow = FormShow
    9   LCLVersion = '2.0.6.0'
     11  LCLVersion = '2.0.10.0'
     12  object ButtonResize: TButton
     13    Left = 16
     14    Height = 33
     15    Top = 16
     16    Width = 98
     17    Caption = 'Resize'
     18    OnClick = ButtonResizeClick
     19    TabOrder = 0
     20  end
     21  object ButtonAlpha: TButton
     22    Left = 16
     23    Height = 33
     24    Top = 64
     25    Width = 144
     26    Caption = 'Alpha channel'
     27    OnClick = ButtonAlphaClick
     28    TabOrder = 1
     29  end
    1030end
  • tools/Image resize/uformmain.pas

    r181 r276  
    11unit UFormMain;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    66
    77uses
    8   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
     8  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
     9  Math, LazFileUtils;
    910
    1011type
    1112
    12   { TForm1 }
    13 
    14   TForm1 = class(TForm)
     13  { TFormMain }
     14
     15  TFormMain = class(TForm)
     16    ButtonAlpha: TButton;
     17    ButtonResize: TButton;
     18    procedure ButtonAlphaClick(Sender: TObject);
     19    procedure ButtonResizeClick(Sender: TObject);
    1520    procedure FormShow(Sender: TObject);
    1621  private
    17 
     22    function SwapColors(Color: Cardinal): Cardinal;
     23    procedure UseAlpha(SourceName: string; BBC: Boolean);
    1824  public
    1925    procedure ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
     
    2127  end;
    2228
    23 var
    24   Form1: TForm1;
     29  TColor32 = type Cardinal;
     30  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     31  TPixel32 = packed record
     32    case Integer of
     33      0: (B, G, R, A: Byte);
     34      1: (ARGB: TColor32);
     35      2: (Planes: array[0..3] of Byte);
     36      3: (Components: array[TColor32Component] of Byte);
     37  end;
     38  PPixel32 = ^TPixel32;
     39
     40var
     41  FormMain: TFormMain;
    2542
    2643implementation
     
    2845{$R *.lfm}
    2946
    30 { TForm1 }
    31 
    32 procedure TForm1.FormShow(Sender: TObject);
     47uses
     48  UBitmapSet;
     49
     50{ TFormMain }
     51
     52procedure TFormMain.FormShow(Sender: TObject);
     53begin
     54end;
     55
     56function TFormMain.SwapColors(Color: Cardinal): Cardinal;
     57begin
     58  Result := ((Color and $ff0000) shr 16) or (Color and $00ff00) or
     59    ((Color and $ff) shl 16) or (Color and $ff000000);
     60end;
     61
     62procedure TFormMain.ButtonResizeClick(Sender: TObject);
    3363var
    3464  NewSize: TPoint;
     
    4171end;
    4272
    43 procedure TForm1.ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
     73procedure TFormMain.ButtonAlphaClick(Sender: TObject);
     74const
     75  Files: array[0..11] of string = (
     76    'Cities66x32.png', 'Cities96x48.png', 'Cities144x72.png',
     77    'Terrain66x32.png', 'Terrain96x48.png', 'Terrain144x72.png',
     78    'Nation1.png', 'Nation2.png', 'StdCities.png', 'StdUnits.png', 'System.png',
     79    'System2.png');
     80var
     81  I: Integer;
     82begin
     83  I := 0;
     84  for I := 0 to Length(Files) - 1 do
     85    UseAlpha('../../trunk/Graphics/' + Files[I], False);
     86  //UseAlpha('../../trunk/Graphics/Templates.png', True);
     87end;
     88
     89procedure TFormMain.UseAlpha(SourceName: string; BBC: Boolean);
     90var
     91  ImageSrc: TImage;
     92  ImageDest: TImage;
     93  X, Y: Integer;
     94  PtrSrc: PPixel32;
     95  PtrDest: PPixel32;
     96  C: TPixel32;
     97  Size: TPoint;
     98  Trans, Amp1, Amp2, Value: Integer;
     99  Color1, Color2: TPixel32;
     100  BitmapSet: TBitmapSet;
     101  BitmapDesc: TBitmapDesc;
     102  I: Integer;
     103begin
     104  BitmapSet := TBitmapSet.Create;
     105  if FileExists(ExtractFileNameOnly(SourceName) + '.txt') then
     106    BitmapSet.LoadFromFile(ExtractFileNameOnly(SourceName) + '.txt');
     107
     108  ImageSrc := TImage.Create(nil);
     109  ImageSrc.Picture.LoadFromFile(SourceName);
     110  Size := Point(ImageSrc.Picture.Bitmap.Width,
     111    ImageSrc.Picture.Bitmap.Height);
     112  ImageSrc.Picture.Bitmap.BeginUpdate(True);
     113  ImageDest := TImage.Create(nil);
     114  ImageDest.Picture.Bitmap.PixelFormat := pf32bit;
     115  ImageDest.Picture.Bitmap.SetSize(Size.X, Size.Y);
     116  ImageDest.Picture.Bitmap.BeginUpdate(True);
     117  for Y := 0 to Size.Y - 1 do
     118    for X := 0 to Size.X - 1 do begin
     119      PtrSrc := ImageSrc.Picture.Bitmap.ScanLine[Y] + X * 4;
     120      PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
     121      C.ARGB := PtrSrc^.ARGB and $ffffff;
     122      //C.ARGB := SwapColors(C.ARGB);
     123      if BBC then begin
     124        PtrDest^.R := C.R;
     125        PtrDest^.G := C.G;
     126        PtrDest^.B := 0; //C.B;
     127        PtrDest^.A := 255 - C.B; // blue channel = transparency
     128      end else begin
     129        if (C.ARGB = $7f007f) or (C.ARGB = $ff00ff) then
     130          PtrDest^.ARGB := $00000000
     131        else PtrDest^.ARGB := SwapColors($ff000000 or C.ARGB);
     132      end;
     133    end;
     134
     135{  if BBC then begin
     136    for I := 0 to BitmapSet.Items.Count - 1 do begin
     137      BitmapDesc := BitmapSet.Items[I];
     138      for Y := BitmapDesc.Rect.Top to BitmapDesc.Rect.Top + BitmapDesc.Rect.Height - 1 do
     139        for X := BitmapDesc.Rect.Left to BitmapDesc.Rect.Left + BitmapDesc.Rect.Width - 1 do begin
     140          Color1.ARGB := BitmapDesc.Color1;
     141          Color2.ARGB := BitmapDesc.Color2;
     142          PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
     143          C.ARGB := PtrDest^.ARGB;
     144          trans := C.A * 2;
     145          amp1 := C.G * 2;
     146          amp2 := C.R * 2;
     147          if trans <> $FF then begin
     148            Value := (0 * trans + Color2.R * amp2 + Color1.R * amp1) div $FF;
     149            PtrDest^.B := Min(Value, 255);
     150
     151            Value := (0 * trans + Color2.G * amp2 + Color1.G * amp1) div $FF;
     152            PtrDest^.G := Min(Value, 255);
     153
     154            Value := (0 * trans + Color2.B * amp2 + Color1.B * amp1) div $FF;
     155            PtrDest^.R := Min(Value, 255);
     156
     157            PtrDest^.A := 255 - Min(Trans, 255)
     158          end;
     159        end;
     160    end;
     161  end;
     162    }
     163  ImageSrc.Picture.Bitmap.EndUpdate;
     164  ImageDest.Picture.Bitmap.EndUpdate;
     165  ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
     166  ImageSrc.Free;
     167  ImageDest.Free;
     168  BitmapSet.Free;
     169end;
     170
     171procedure TFormMain.ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
    44172  DestName: string; DestSize: TPoint);
    45173var
Note: See TracChangeset for help on using the changeset viewer.