Changeset 333


Ignore:
Timestamp:
Mar 31, 2021, 7:21:45 PM (10 months ago)
Author:
chronos
Message:
  • Modified: Image resize tool scale up using xbrzscale tool.
  • Modified: Various improvements of generation of scaled up tiles.
Location:
tools/Image resize
Files:
2 edited
2 moved

Legend:

Unmodified
Added
Removed
  • tools/Image resize/ImageResize.lpi

    r280 r333  
    3737      </Unit0>
    3838      <Unit1>
    39         <Filename Value="uformmain.pas"/>
     39        <Filename Value="UFormMain.pas"/>
    4040        <IsPartOfProject Value="True"/>
    4141        <ComponentName Value="FormMain"/>
    4242        <HasResources Value="True"/>
    4343        <ResourceBaseClass Value="Form"/>
    44         <UnitName Value="UFormMain"/>
    4544      </Unit1>
    4645      <Unit2>
  • tools/Image resize/UFormMain.lfm

    r332 r333  
    11object FormMain: TFormMain
    22  Left = 534
    3   Height = 312
     3  Height = 359
    44  Top = 388
    5   Width = 417
     5  Width = 480
    66  Caption = 'Image resize'
    7   ClientHeight = 312
    8   ClientWidth = 417
    9   DesignTimePPI = 125
     7  ClientHeight = 359
     8  ClientWidth = 480
     9  DesignTimePPI = 144
    1010  OnShow = FormShow
    11   LCLVersion = '2.0.10.0'
     11  LCLVersion = '2.0.12.0'
    1212  object ButtonResize: TButton
    13     Left = 16
    14     Height = 33
    15     Top = 16
    16     Width = 98
     13    Left = 18
     14    Height = 38
     15    Top = 18
     16    Width = 113
    1717    Caption = 'Resize'
    1818    OnClick = ButtonResizeClick
     19    ParentFont = False
    1920    TabOrder = 0
    2021  end
    2122  object ButtonAlpha: TButton
    22     Left = 16
    23     Height = 33
    24     Top = 64
    25     Width = 144
     23    Left = 18
     24    Height = 38
     25    Top = 74
     26    Width = 166
    2627    Caption = 'Alpha channel'
    2728    OnClick = ButtonAlphaClick
     29    ParentFont = False
    2830    TabOrder = 1
    2931  end
     32  object ButtonTile: TButton
     33    Left = 18
     34    Height = 38
     35    Top = 126
     36    Width = 153
     37    Caption = 'Process tile'
     38    OnClick = ButtonTileClick
     39    TabOrder = 2
     40  end
    3041end
  • 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;
  • tools/Image resize/UPixelPointer.pas

    r280 r333  
    99  TColor32 = type Cardinal;
    1010  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     11
     12  { TPixel32 }
     13
    1114  TPixel32 = packed record
     15  private
     16    procedure SetRGB(AValue: Cardinal);
     17  public
     18    function GetRGB: Cardinal;
     19    property RGB: Cardinal read GetRGB write SetRGB;
    1220    case Integer of
    1321      0: (B, G, R, A: Byte);
     
    3745
    3846  function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;
    39 
     47  function SwapRedBlue(Color: TColor32): TColor32;
     48  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
     49  procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
     50    SrcBitmap: TRasterImage; SrcRect: TRect);
     51  procedure BitmapFill(Bitmap:TRasterImage; Color: TColor32);
     52  procedure BitmapFillRect(Bitmap:TRasterImage; Color: TColor32; Rect: TRect);
     53  procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
    4054
    4155implementation
     56
     57{ TPixel32 }
     58
     59function TPixel32.GetRGB: Cardinal;
     60begin
     61  Result := ARGB and $ffffff;
     62end;
     63
     64procedure TPixel32.SetRGB(AValue: Cardinal);
     65begin
     66  R := (AValue shr 16) and $ff;
     67  G := (AValue shr 8) and $ff;
     68  B := (AValue shr 0) and $ff;
     69end;
    4270
    4371{ TPixelPointer }
     
    74102begin
    75103  Pixel := Pointer(Line) + X * BytesPerPixel;
     104end;
     105
     106procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
     107  SrcBitmap: TRasterImage; SrcPos: TPoint);
     108var
     109  SrcPtr, DstPtr: TPixelPointer;
     110  X, Y: Integer;
     111begin
     112  SrcBitmap.BeginUpdate(True);
     113  DstBitmap.BeginUpdate(True);
     114  SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);
     115  DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     116  for Y := 0 to DstRect.Height - 1 do begin
     117    for X := 0 to DstRect.Width - 1 do begin
     118      DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
     119      SrcPtr.NextPixel;
     120      DstPtr.NextPixel;
     121    end;
     122    SrcPtr.NextLine;
     123    DstPtr.NextLine;
     124  end;
     125  SrcBitmap.EndUpdate;
     126  DstBitmap.EndUpdate;
     127end;
     128
     129procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
     130  SrcBitmap: TRasterImage; SrcRect: TRect);
     131var
     132  SrcPtr, DstPtr: TPixelPointer;
     133  SubPtr: TPixelPointer;
     134  X, Y: Integer;
     135  XX, YY: Integer;
     136  R: TRect;
     137  C: TColor32;
     138begin
     139  if (DstRect.Width = SrcRect.Width) and (DstRect.Height = SrcRect.Height) then begin
     140    BitmapCopyRect(DstBitmap, DstRect, SrcBitmap, Point(SrcRect.Left, SrcRect.Top));
     141    Exit;
     142  end;
     143  SrcBitmap.BeginUpdate(True);
     144  DstBitmap.BeginUpdate(True);
     145  SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);
     146  DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     147  for Y := 0 to DstRect.Height - 1 do begin
     148    for X := 0 to DstRect.Width - 1 do begin
     149      R := Rect(Trunc(X * SrcRect.Width / DstRect.Width),
     150        Trunc(Y * SrcRect.Height / DstRect.Height),
     151        Trunc((X + 1) * SrcRect.Width / DstRect.Width),
     152        Trunc((Y + 1) * SrcRect.Height / DstRect.Height));
     153      DstPtr.SetXY(X, Y);
     154      SrcPtr.SetXY(R.Left, R.Top);
     155      C := SrcPtr.Pixel^.ARGB;
     156      DstPtr.Pixel^.ARGB := C;
     157      for YY := 0 to R.Height - 1 do begin
     158        for XX := 0 to R.Width - 1 do begin
     159          DstPtr.Pixel^.ARGB := C;
     160          DstPtr.NextPixel;
     161        end;
     162        DstPtr.NextLine;
     163      end;
     164    end;
     165  end;
     166  SrcBitmap.EndUpdate;
     167  DstBitmap.EndUpdate;
     168end;
     169
     170procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
     171var
     172  X, Y: Integer;
     173  Ptr: TPixelPointer;
     174begin
     175  Bitmap.BeginUpdate(True);
     176  Ptr := PixelPointer(Bitmap);
     177  for Y := 0 to Bitmap.Height - 1 do begin
     178    for X := 0 to Bitmap.Width - 1 do begin
     179      Ptr.Pixel^.ARGB := Color;
     180      Ptr.NextPixel;
     181    end;
     182    Ptr.NextLine;
     183  end;
     184  Bitmap.EndUpdate;
     185end;
     186
     187procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
     188var
     189  X, Y: Integer;
     190  Ptr: TPixelPointer;
     191begin
     192  Bitmap.BeginUpdate(True);
     193  Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);
     194  for Y := 0 to Rect.Height - 1 do begin
     195    for X := 0 to Rect.Width - 1 do begin
     196      Ptr.Pixel^.ARGB := Color;
     197      Ptr.NextPixel;
     198    end;
     199    Ptr.NextLine;
     200  end;
     201  Bitmap.EndUpdate;
     202end;
     203
     204procedure BitmapSwapRedBlue(Bitmap: TRasterImage);
     205var
     206  X, Y: Integer;
     207  Ptr: TPixelPointer;
     208begin
     209  Bitmap.BeginUpdate(True);
     210  Ptr := PixelPointer(Bitmap);
     211  for Y := 0 to Bitmap.Height - 1 do begin
     212    for X := 0 to Bitmap.Width - 1 do begin
     213      Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
     214      Ptr.NextPixel;
     215    end;
     216    Ptr.NextLine;
     217  end;
     218  Bitmap.EndUpdate;
    76219end;
    77220
     
    86229end;
    87230
     231function SwapRedBlue(Color: TColor32): TColor32;
     232begin
     233  Result := (Color and $ff00ff00) or ((Color and $ff) shl 16) or ((Color shr 16) and $ff);
     234end;
     235
    88236
    89237end.
Note: See TracChangeset for help on using the changeset viewer.