Ignore:
Timestamp:
Mar 31, 2021, 7:21:45 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Image resize tool scale up using xbrzscale tool.
  • Modified: Various improvements of generation of scaled up tiles.
File:
1 moved

Legend:

Unmodified
Added
Removed

  • tools/Image resize/UFormMain.pas

    r332 r333  
    77uses
    88  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
    9   Math, LazFileUtils, UPixelPointer;
     9  Math, LazFileUtils, UPixelPointer, Process;
    1010
    1111type
    … …  
    1414
    1515  TFormMain = class(TForm)
     16    ButtonTile: TButton;
    1617    ButtonAlpha: TButton;
    1718    ButtonResize: TButton;
    1819    procedure ButtonAlphaClick(Sender: TObject);
    1920    procedure ButtonResizeClick(Sender: TObject);
     21    procedure ButtonTileClick(Sender: TObject);
    2022    procedure FormShow(Sender: TObject);
    2123  private
    2224    function SwapColors(Color: Cardinal): Cardinal;
    23     procedure UseAlpha(SourceName: string; BBC: Boolean);
     25    procedure UseAlphaFile(SourceName: string; BBC: Boolean);
     26    procedure UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
     27    procedure RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
     28    procedure ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
     29    procedure ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
     30    procedure ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
     31    procedure ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
    2432  public
    2533    procedure ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
    … …  
    5260var
    5361  NewSize: TPoint;
    54 begin
     62  OldSize: TPoint;
     63  OldFileName: string;
     64  NewFileName: string;
     65  I: Integer;
     66const
     67  //Files: array[0..0] of string = ('Cities66x32.png');
     68  Files: array[0..0] of string = ('Cities96x48.png');
     69  //Files: array[0..0] of string = ('Terrain96x48.png');
     70  //Files: array[0..1] of string = ('Cities66x32.png', 'Terrain66x32.png');
     71  //Files: array[0..1] of string = ('Cities96x48.png', 'Terrain96x48.png');
     72  TileCount: array[0..1] of TPoint = ((X: 8; Y: 2), (X: 9; Y: 21));
     73  //TileCount: array[0..0] of TPoint = ((X: 9; Y: 21));
     74begin
     75  //OldSize := Point(66, 48);
     76  OldSize := Point(96, 72);
     77  //NewSize := Point(96, 72);
     78  //NewSize := Point(66, 48);
    5579  NewSize := Point(144, 108);
    56   //ResizeImage('../../trunk/Graphics/Cities66x32.png', Point(66, 48), Point(8, 2),
    57   //  'Cities144x72.png', NewSize);
    58   //ResizeImage('../../trunk/Graphics/Terrain66x32.png', Point(66, 48), Point(9, 21),
    59   //  'Terrain144x72.png', NewSize);
    60 {
    61   ResizeImage('../../trunk/Graphics/Cities96x48.png', Point(96, 72), Point(8, 2),
    62     'Cities144x72.png', NewSize);
    63   ResizeImage('../../trunk/Graphics/Terrain96x48.png', Point(96, 72), Point(9, 21),
    64     'Terrain144x72.png', NewSize);
    65 }  ResizeImage('../../branches/AlphaChannel/Graphics/Cities96x48.png', Point(96, 72), Point(8, 2),
    66     'Cities144x72.png', NewSize);
    67   ResizeImage('../../branches/AlphaChannel/Graphics/Terrain96x48.png', Point(96, 72), Point(9, 21),
    68     'Terrain144x72.png', NewSize);
     80  //NewSize := Point(192, 144);
     81
     82  for I := 0 to Length(Files) - 1 do begin
     83    OldFileName := Files[I];
     84    NewFileName := '_' + OldFileName;
     85    ResizeImage(OldFileName, OldSize, TileCount[I], NewFileName, NewSize);
     86  end;
     87end;
     88
     89procedure TFormMain.ButtonTileClick(Sender: TObject);
     90var
     91  Ptr: TPixelPointer;
     92  X, Y: Integer;
     93  Bitmap: TBitmap;
     94begin
     95  Bitmap := TBitmap.Create;
     96  Bitmap.LoadFromFile('tile.bmp');
     97
     98  Bitmap.BeginUpdate;
     99  Ptr := PixelPointer(Bitmap);
     100  for Y := 0 to Bitmap.Height - 1 do begin
     101    for X := 0 to Bitmap.Width - 1 do begin
     102      if Ptr.Pixel^.ARGB <> 0 then begin
     103        if ((X + Y) mod 2) = 0 then
     104          Ptr.Pixel^.ARGB := $ff7f007f
     105          else Ptr.Pixel^.ARGB := $ff000000;
     106      end else Ptr.Pixel^.ARGB := $ff7f007f;
     107      Ptr.NextPixel;
     108    end;
     109    Ptr.NextLine;
     110  end;
     111  Bitmap.EndUpdate;
     112
     113  Bitmap.SaveToFile('tile_.bmp');
     114  Bitmap.Free;
    69115end;
    70116
    … …  
    81127  I := 0;
    82128  for I := 0 to Length(Files) - 1 do
    83     UseAlpha('../../trunk/Graphics/' + Files[I], False);
    84   UseAlpha('../../trunk/Help/AdvTree.png', False);
    85   //UseAlpha('../../trunk/Graphics/Templates.png', True);
     129    UseAlphaFile('../../trunk/Graphics/' + Files[I], False);
     130  UseAlphaFile('../../trunk/Help/AdvTree.png', False);
     131  //UseAlphaFile('../../trunk/Graphics/Templates.png', True);
    86132end;
    87133
    … …  
    103149end;
    104150
    105 procedure TFormMain.UseAlpha(SourceName: string; BBC: Boolean);
     151procedure TFormMain.UseAlphaFile(SourceName: string; BBC: Boolean);
    106152var
    107153  ImageSrc: TImage;
    … …  
    124170  ImageSrc := TImage.Create(nil);
    125171  ImageSrc.Picture.LoadFromFile(SourceName);
    126   Size := Point(ImageSrc.Picture.Bitmap.Width,
    127     ImageSrc.Picture.Bitmap.Height);
    128   ImageSrc.Picture.Bitmap.BeginUpdate(True);
    129172  ImageDest := TImage.Create(nil);
    130173  ImageDest.Picture.Bitmap.PixelFormat := pf32bit;
    131   ImageDest.Picture.Bitmap.SetSize(Size.X, Size.Y);
    132   ImageDest.Picture.Bitmap.BeginUpdate(True);
     174
     175  UseAlphaBitmap(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap, BBC);
     176
     177  ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
     178  ImageSrc.Free;
     179  ImageDest.Free;
     180  BitmapSet.Free;
     181end;
     182
     183procedure TFormMain.UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean);
     184var
     185  X, Y: Integer;
     186  PtrSrc: PPixel32;
     187  PtrDest: PPixel32;
     188  C: TPixel32;
     189  Size: TPoint;
     190  Trans, Amp1, Amp2, Value: Integer;
     191  Color1, Color2: TPixel32;
     192  BitmapSet: TBitmapSet;
     193  BitmapDesc: TBitmapDesc;
     194  I: Integer;
     195begin
     196  Size := Point(SrcBitmap.Width, SrcBitmap.Height);
     197  SrcBitmap.BeginUpdate(True);
     198  DstBitmap.SetSize(Size.X, Size.Y);
     199  DstBitmap.BeginUpdate(True);
    133200  for Y := 0 to Size.Y - 1 do
    134201    for X := 0 to Size.X - 1 do begin
    135       PtrSrc := ImageSrc.Picture.Bitmap.ScanLine[Y] + X * 4;
    136       PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
     202      PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
     203      PtrDest := DstBitmap.ScanLine[Y] + X * 4;
    137204      C.ARGB := PtrSrc^.ARGB and $ffffff;
    138205      //C.ARGB := SwapColors(C.ARGB);
    … …  
    177244  end;
    178245    }
    179   ImageSrc.Picture.Bitmap.EndUpdate;
    180   ImageDest.Picture.Bitmap.EndUpdate;
    181   ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
    182   ImageSrc.Free;
    183   ImageDest.Free;
    184   BitmapSet.Free;
     246  SrcBitmap.EndUpdate;
     247  DstBitmap.EndUpdate;
     248end;
     249
     250procedure TFormMain.RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap;
     251  BBC: Boolean);
     252var
     253  X, Y: Integer;
     254  Size: TPoint;
     255  PtrSrc: PPixel32;
     256  PtrDest: PPixel32;
     257  C: TPixel32;
     258  A: Cardinal;
     259  Alpha: Byte;
     260const
     261  AlphaThreshold = $80;
     262begin
     263  Size := Point(SrcBitmap.Width, SrcBitmap.Height);
     264  SrcBitmap.BeginUpdate(True);
     265  SrcBitmap.PixelFormat := pf32bit;
     266  DstBitmap.SetSize(Size.X, Size.Y);
     267  DstBitmap.BeginUpdate(True);
     268  for Y := 0 to Size.Y - 1 do
     269    for X := 0 to Size.X - 1 do begin
     270      PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
     271      PtrDest := DstBitmap.ScanLine[Y] + X * 4;
     272      C.ARGB := PtrSrc^.ARGB;
     273      //C.ARGB := SwapColors(C.ARGB);
     274      if BBC then begin
     275        PtrDest^.R := C.R;
     276        PtrDest^.G := C.G;
     277        PtrDest^.B := 0; //C.B;
     278        PtrDest^.A := 255 - C.B; // blue channel = transparency
     279      end else begin
     280        Alpha := C.A;
     281        if Alpha < AlphaThreshold then begin
     282          PtrDest^.RGB := $7f007f
     283        end
     284        else begin
     285          A := C.ARGB and $ffffff;
     286          PtrDest^.RGB := SwapRedBlue(A);
     287        end;
     288      end;
     289    end;
     290  SrcBitmap.EndUpdate;
     291  DstBitmap.EndUpdate;
     292end;
     293
     294procedure TFormMain.ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
     295var
     296  X, Y: Integer;
     297  SrcPtr: PCardinal;
     298  DestPtr: PCardinal;
     299begin
     300  SrcBitmap.BeginUpdate(True);
     301  DstBitmap.BeginUpdate(True);
     302  for Y := 0 to DstRect.Height - 1 do begin
     303    for X := 0 to DstRect.Width - 1 do begin
     304      SrcPtr := SrcBitmap.ScanLine[SrcRect.Top + Trunc(Y / DstRect.Height * SrcRect.Height)];
     305      DestPtr := DstBitmap.ScanLine[DstRect.Top + Y];
     306      SrcPtr := SrcPtr + SrcRect.Left + Trunc(X / DstRect.Width * SrcRect.Width);
     307      DestPtr := DestPtr + DstRect.Left + X;
     308      DestPtr^ := SrcPtr^;
     309      //ImageDest.Picture.Bitmap.Canvas.Pixels[XX * (DestSize.X + 1) + 1 + X,
     310      //  YY * (DestSize.Y + 1) + 1 + Y] :=
     311      //ImageSrc.Picture.Bitmap.Canvas.Pixels[XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X),
     312      //  YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
     313    end;
     314  end;
     315  SrcBitmap.EndUpdate;
     316  DstBitmap.EndUpdate;
     317end;
     318
     319procedure ExecuteProgram(Executable: string; Parameters: array of string);
     320var
     321  Process: TProcess;
     322  I: Integer;
     323begin
     324  try
     325    Process := TProcess.Create(nil);
     326    Process.Executable := Executable;
     327    for I := 0 to Length(Parameters) - 1 do
     328      Process.Parameters.Add(Parameters[I]);
     329    Process.Options := [poNoConsole, poWaitOnExit];
     330    Process.Execute;
     331  finally
     332    Process.Free;
     333  end;
     334end;
     335
     336procedure TFormMain.ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
     337var
     338  Png: TPortableNetworkGraphic;
     339const
     340  XbrzScaleExe = 'xbrzscale'; // https://github.com/atheros/xbrzscale
     341begin
     342  SrcBitmap.SaveToFile('Input.bmp');
     343  ExecuteProgram(XbrzScaleExe, ['3', 'Input.bmp', 'Output.png']);
     344  Png := TPortableNetworkGraphic.Create;
     345  Png.PixelFormat := pf32bit;
     346  Png.LoadFromFile('Output.png');
     347  Png.PixelFormat := pf32bit;
     348  Png.SaveToFile('Output2.png');
     349  DstBitmap.SaveToFile('xxx1.bmp');
     350  BitmapStretchRect(DstBitmap, Bounds(0, 0, DstBitmap.Width, DstBitmap.Height),
     351    Png, Rect(0, 0, Png.Width, Png.Height));
     352  BitmapSwapRedBlue(DstBitmap);
     353  DstBitmap.SaveToFile('xxx.bmp');
     354  Png.Free;
     355end;
     356
     357procedure TFormMain.ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect,
     358  DstRect: TRect);
     359var
     360  Src, Dst: TBitmap;
     361  Alpha: TBitmap;
     362  Alpha2: TBitmap;
     363begin
     364  Src := TBitmap.Create;
     365  Src.SetSize(SrcRect.Width, SrcRect.Height);
     366  Src.Canvas.CopyRect(Bounds(0, 0, SrcRect.Width, SrcRect.Height), SrcBitmap.Canvas,
     367    SrcRect);
     368  Dst := TBitmap.Create;
     369  Dst.SetSize(DstRect.Width, DstRect.Height);
     370  Dst.PixelFormat := Src.PixelFormat;
     371  //Dst.Canvas.Brush.Style := bsSolid;
     372  //Dst.Canvas.Brush.Color := $757575;
     373  //Dst.Canvas.FillRect(0, 0, Dst.Width, Dst.Height);
     374  FillRectBitmap(Dst, $ff000000);
     375
     376  Alpha := TBitmap.Create;
     377  Alpha.PixelFormat := pf32bit;
     378  Alpha.SetSize(Src.Width, Src.Height);
     379  UseAlphaBitmap(Src, Alpha);
     380
     381  Alpha2 := TBitmap.Create;
     382  Alpha2.PixelFormat := pf32bit;
     383  Alpha2.SetSize(Dst.Width, Dst.Height);
     384  FillRectBitmap(Alpha2, $00000000);
     385  //Alpha2.Canvas.Brush.Style := bsSolid;
     386  //Alpha2.Canvas.Brush.Color := $000000;
     387  //Alpha2.Canvas.FillRect(0, 0, 0, 0);
     388
     389  ResizeRectXbrz(Alpha, Alpha2);
     390
     391  RestoreAlphaBitmap(Alpha2, Dst);
     392
     393  Dst.SaveToFile('Dst.bmp');
     394  DstBitmap.Canvas.CopyRect(DstRect, Dst.Canvas, Bounds(0, 0, DstRect.Width, DstRect.Height));
     395  DstBitmap.SaveToFile('DstBitmap.bmp');
     396  Src.Free;
     397  Dst.Free;
     398  Alpha.Free;
     399  Alpha2.Free;
     400end;
     401
     402function FindPosition(Bitmap: TBitmap; x, y, xmax, ymax: Integer; Mark: TColor): TPoint;
     403var
     404  xp, yp: Integer;
     405begin
     406  xp := 0;
     407  while (xp < xmax) and (Bitmap.Canvas.Pixels[x + 1 + xp, y] <> Mark) do
     408    Inc(xp);
     409  yp := 0;
     410  while (yp < ymax) and (Bitmap.Canvas.Pixels[x, y + 1 + yp] <> Mark) do
     411    Inc(yp);
     412  Result := Point(xp, yp);
     413end;
     414
     415procedure TFormMain.ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect,
     416  DstRect: TRect);
     417var
     418  P: TPoint;
     419const
     420  MarkColor: TColor = $00ffff;
     421begin
     422  P := FindPosition(SrcBitmap, SrcRect.Left, SrcRect.Top, SrcRect.Width, SrcRect.Height, MarkColor);
     423  P := Point(Round(P.X * DstRect.Width / SrcRect.Width),
     424    Round(P.Y * DstRect.Height / SrcRect.Height));
     425  DstBitmap.Canvas.Pixels[DstRect.Left + P.X, DstRect.Top] := MarkColor;
     426  DstBitmap.Canvas.Pixels[DstRect.Left, DstRect.Top + P.Y] := MarkColor;
    185427end;
    186428
    … …  
    190432  ImageSrc: TImage;
    191433  ImageDest: TImage;
    192   XX, YY: Integer;
    193   X, Y: Integer;
    194   SrcPtr: PCardinal;
    195   DestPtr: PCardinal;
     434  X, Y: Integer;
    196435begin
    197436  ImageSrc := TImage.Create(nil);
    … …  
    205444
    206445  ImageSrc.Picture.Bitmap.BeginUpdate(True);
    207   ImageDest.Picture.Bitmap.BeginUpdate(True);
     446  //ImageDest.Picture.Bitmap.BeginUpdate(True);
    208447  //ImageDest.Picture.Bitmap.Canvas.Brush.Style := bsSolid;
    209448  //ImageDest.Picture.Bitmap.Canvas.Brush.Color := $757575;
    210449  //ImageDest.Picture.Bitmap.Canvas.FillRect(0, 0, ImageDest.Picture.Bitmap.Width, ImageDest.Picture.Bitmap.Height);
    211   XX := 0;
    212   YY := 0;
    213   for YY := 0 to Count.Y - 1 do
    214     for XX := 0 to Count.X - 1 do begin
    215       for Y := 0 to DestSize.Y - 1 do
    216         for X := 0 to DestSize.X - 1 do begin
    217           SrcPtr := ImageSrc.Picture.Bitmap.ScanLine[YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
    218           DestPtr := ImageDest.Picture.Bitmap.ScanLine[YY * (DestSize.Y + 1) + 1 + Y];
    219           SrcPtr := SrcPtr + XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X);
    220           DestPtr := DestPtr + XX * (DestSize.X + 1) + 1 + X;
    221           DestPtr^ := SrcPtr^;
    222           //ImageDest.Picture.Bitmap.Canvas.Pixels[XX * (DestSize.X + 1) + 1 + X,
    223           //  YY * (DestSize.Y + 1) + 1 + Y] :=
    224           //ImageSrc.Picture.Bitmap.Canvas.Pixels[XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X),
    225           //  YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
    226         end;
     450  for Y := 0 to Count.Y - 1 do
     451    for X := 0 to Count.X - 1 do begin
     452      ProcessBitmapRect(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
     453        Bounds(X * (SourceSize.X + 1) + 1, Y * (SourceSize.Y + 1) + 1, SourceSize.X, SourceSize.Y),
     454        Bounds(X * (DestSize.X + 1) + 1, Y * (DestSize.Y + 1) + 1, DestSize.X, DestSize.Y));
     455      ResizeAuxPos(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
     456        Bounds(X * (SourceSize.X + 1), Y * (SourceSize.Y + 1), SourceSize.X, SourceSize.Y),
     457        Bounds(X * (DestSize.X + 1), Y * (DestSize.Y + 1), DestSize.X, DestSize.Y));
    227458    end;
    228459  ImageSrc.Picture.Bitmap.EndUpdate;
    229   ImageDest.Picture.Bitmap.EndUpdate;
     460  //ImageDest.Picture.Bitmap.EndUpdate;
    230461  ImageDest.Picture.SaveToFile(DestName);
    231462  ImageSrc.Free;
Note: See TracChangeset for help on using the changeset viewer.