Convert BMP image to grayscale using track bar lazarus / 39-Graphics ---------------------------------------------------------------------- AjL0ra · 2022-02-25 05:08 hi a have a project with multiple tasks and the first step is to convert a bmp image using a trackbar form here is the code I tried to use but its showing a lot of errors in the Trackbar1Change, it would be nice if some of you could help me Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  ExtDlgs, LCLintf, ComCtrls, Menus; type   { TForm1 }   MATRGB = array of array of array of byte;   //definir tips propios   TForm1 = class(TForm)    Button1: TButton;    Image1: TImage;    MainMenu1: TMainMenu;    MenuItem1: TMenuItem;    MenuItem2: TMenuItem;    MenuItem3: TMenuItem;    MenuItem4: TMenuItem;    OpenPictureDialog1: TOpenPictureDialog;    ScrollBox1: TScrollBox;    StatusBar1: TStatusBar;    TrackBar1: TTrackBar;     procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer      );    procedure MenuItem3Click(Sender: TObject);    procedure MenuItem4Click(Sender: TObject);    procedure TrackBar1Change(Sender: TObject);  private   public   procedure BtoM (Al,An:Integer; var M: MATRGB; B:Tbitmap); //copiar de Imagen .BMP a MAtriz usando Scanline   procedure MtoB (Al,An:Integer; M: MATRGB; var B:Tbitmap); // copiar MAtriz a Bitmap    end; var  Form1: TForm1;  ALTO, ANCHO : Integer;   MatIm : MATRGB;   BMAP  : TBitmap;  //manipular imagenes BMP, se debe crear antes usar implementation {$R *.lfm} { TForm1 } procedure tform1.MtoB (Al,An:Integer; M: MATRGB; var B:Tbitmap);vari,j,k  : Integer;p      :Pbyte;begin   //copiar contenido de MatIm al Bitmap --> escribir sobre la imagen    for i:=0 to Al-1 do begin     B.BeginUpdate;     p:=B.ScanLine[i];     B.EndUpdate;    for j:=0 to An-1 do begin       k:=3*j;        p[k+2]:= M[i,j,0];       p[k+1]:= M[i,j,1];       p[k]:= M[i,j,2];     end;//j   end;  //i   end; procedure tform1.BtoM (Al,An:Integer; var M: MATRGB; B:Tbitmap);vari,j,k   :  Integer;p     :  Pbyte;  //arreglo dinámico de tipos byte begin   for i:=0 to Al-1 do begin      B.BeginUpdate;     p:=B.ScanLine[i];     B.EndUpdate;       {       p alamacena todo el renglon y sus valores RGB        NxN     N´2 -   N      }     for j:=0 to An-1 do begin      //copiar a MatIm      k:=3*j;     M[i,j,0]:=p[k+2];     M[i,j,1]:=p[k+1];     M[i,j,2]:=p[k];      end;   end; //i   end; procedure TForm1.Button1Click(Sender: TObject);var i,j  :  Integer;c1   : Tcolor; begin   {  sintaxis general de if    if (condicion) then     begin       end      else       begin        end  }     If OpenPictureDialog1.Execute then   //abrir cuadro de dialogo/archivo    begin         Image1.Enabled:=True;         Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);         ALTO:= Image1.Height;         ANCHO:= Image1.Width;          SetLength(MatIm,ALTO,ANCHO,3);    //matriz en que copiamos contenido RGB de cada pixel           {              LA dimensión 3 de MatIm respecta a los canales RGB,  R=0, G=1 , B=2                MatIm[fila,columna,canal]              }         //leer toda la información de la imagen           for i:=0 to ALTO-1 do          begin             for j:=0 to ANCHO-1 do             begin             c1:=Image1.Canvas.Pixels[j,i];                 //extraer la composicion RGB del pixel i,j  y almacenar en MatIm              MatIm[i,j,0]:= GetRvalue(c1);              MatIm[i,j,1]:= GetGvalue(c1);              MatIm[i,j,2]:= GetBvalue(c1);                 end; //j           end; //i         end; end; procedure TForm1.FormCreate(Sender: TObject);begin   BMAP:=Tbitmap.Create;  //crear variabal para acceso a canvasend; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);begin   StatusBar1.Panels[1].Text:=IntToStr(X);  StatusBar1.Panels[2].Text:=IntToStr(Y);  StatusBar1.Panels[4].Text:=IntToStr(MatIm[y,x,0]);  StatusBar1.Panels[5].Text:=IntToStr(MatiM[y,x,1]);  StatusBar1.Panels[6].Text:=IntToStr(MatiM[y,x,2]);  end; procedure TForm1.MenuItem3Click(Sender: TObject);begin  //abrir imagen con Scanline  if OpenPictureDialog1.execute then begin        Image1.Enabled:=True;       BMAP.LoadFromFile(OpenPictureDialog1.FileName); //cargar archivo       if BMAP.PixelFormat <> Pf24bit then  //si no es de 8 bits por canal          begin             BMAP.PixelFormat:=Pf24bit;          end;         ALTO:=BMAP.Height;       ANCHO:=BMAP.Width;        Setlength(MatIm,ALTO,ANCHO,3);       BtoM(ALTO,ANCHO,MatIm,BMAP);   //copiar la informacion a MAtIm        Image1.Picture.Assign(BMAP);       end;  end; procedure TForm1.MenuItem4Click(Sender: TObject);vari,j       : Integer;k       : byte; begin   //aplicar el filtro negativo a la imagen   for i:=0 to ALTO-1 do begin    for j:=0 to ANCHO-1 do begin     for k:=0 to 2 do begin           MatIm[i,j,k]:=  255 - MatIm[i,j,k];      end; //k     end;  //j   end;  //i  MtoB(ALTO,ANCHO,MatIm,BMAP);  //copiar resultado a imagen  Image1.Picture.Assign(BMAP);   end; procedure TForm1.TrackBar1Change(Sender: TObject);  Var  ScanData, ResultData: PRGBQuad;  ValR, ValG, ValB, monoByte : Byte;  X, Y: Integer;begin  if openpicturedialog1.Execute then     Begin       Image1.Picture.LoadFromFile(openpicturedialog1.FileName);     end;  Image1.Picture.Bitmap.Width := Image1.Picture.Width;  Image1.Picture.Bitmap.Height := Image1.Picture.Height;  image1.Picture.Bitmap.PixelFormat := image1.Picture.Bitmap.PixelFormat;  Image1.Picture.Bitmap.BeginUpdate;   For Y:=0 To Image1.Height-1 Do  Begin    ScanData := Image1.Picture.Bitmap.ScanLine[Y];    ResultData := Image1.Picture.Bitmap.ScanLine[Y];    For X:=0 To Image1.Width-1 Do    Begin      //   X, Y, TotalTime, DistCurve: Integer;Point to the pixel location      // Get RGB value of the pixel      ValR := ScanData^.rgbRed;      ValG := ScanData^.rgbGreen;      ValB := ScanData^.rgbBlue;       MonoByte := round(0.2125 * ValR + 0.7154 * ValG + 0.0721 * ValB);       ResultData^.rgbRed:=MonoByte;      ResultData^.rgbGreen:=MonoByte;      ResultData^.rgbBlue:=MonoByte;     Inc(ScanData);      Inc(ResultData);    end;  end;  Image1.Picture.Bitmap.EndUpdate;end; end. ---------------------------------------------------------------------- Ally · 2022-02-25 07:58 Hello AjL0ra, your code is quite complex. Attached is an example that is a bit simpler. ---------------------------------------------------------------------- winni · 2022-02-25 12:24 Hi! To make it realy simple use BGRAbitmap. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i uses .....,BGRAbitmap;....procedure TForm1.Button2Click(Sender: TObject);var bmp: TBGRAbitmap;begin  bmp := TBGRAbitmap.create (Image1.Picture.Bitmap);  bmp.InplaceGrayscale;  bmp.Draw(Image1.Canvas,0,0);  bmp.free;end;           Winni ---------------------------------------------------------------------- ADMGNS · 2022-02-25 18:34 hello you mean progressbar? if so, yet another example.. pls see attachment. regs ---------------------------------------------------------------------- flowCRANE · 2022-02-27 14:01 And the example of using TBitmap.ScanLine: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i procedure ConvertToGrayscale(ASource, AResult: TBitmap; ALevel: UInt8);type  PBitmapPixel = ^TBitmapPixel;  TBitmapPixel = packed record B, G, R: UInt8 end;type  PBitmapLine = ^TBitmapLine;  TBitmapLine = packed array [UInt16] of TBitmapPixel;var  LineSource, LineResult: PBitmapLine;  PixelSource, PixelResult: PBitmapPixel;var  LineIndex, PixelIndex: Integer;  GrayShade: UInt8;begin  AResult.BeginUpdate();  try    for LineIndex := 0 to ASource.Height - 1 do    begin      LineSource := ASource.ScanLine[LineIndex];      LineResult := AResult.ScanLine[LineIndex];       for PixelIndex := 0 to ASource.Width - 1 do      begin        PixelSource := @LineSource^[PixelIndex];        PixelResult := @LineResult^[PixelIndex];         GrayShade := Round(PixelSource^.R * 0.299 + PixelSource^.G * 0.587 + PixelSource^.B * 0.114);         PixelResult^.R := Round(PixelSource^.R + (GrayShade - PixelSource^.R) / 255 * ALevel);        PixelResult^.G := Round(PixelSource^.G + (GrayShade - PixelSource^.G) / 255 * ALevel);        PixelResult^.B := Round(PixelSource^.B + (GrayShade - PixelSource^.B) / 255 * ALevel);    end;    end;  finally    AResult.EndUpdate();  end;end; Test project in the attachment. ---------------------------------------------------------------------- Ally · 2022-02-28 11:19 Hello ADMGNS and furious programming, your examples don't seem to work with images that can contain transparent image parts (for example .png or .ico). ---------------------------------------------------------------------- flowCRANE · 2022-02-28 17:49 @Ally: what did you expect? They will not work, because these are just simple examples operating on the TBitmap class containing a 24-bit image, as the author of this thread wanted. If you need an algorithm that will allow you to perform such operations on a 32-bit image, note that the pixel is represented by 32 bits, not 24 bits, so the structure describing the pixel must also contain a field for the alpha channel. The calculation is exactly the same, except that the alpha channel data should not be modified as it does not contain color information. Example for 32-bit PNG image: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i procedure TMainForm.ConvertToGrayscale(ASource, AResult: TPortableNetworkGraphic; ALevel: UInt8);type  PPNGPixel = ^TPNGPixel;  TPNGPixel = packed record B, G, R, A: UInt8 end;type  PPNGLine = ^TPNGLine;  TPNGLine = packed array [UInt16] of TPNGPixel;var  LineSource, LineResult: PPNGLine;  PixelSource, PixelResult: PPNGPixel;var  LineIndex, PixelIndex: Integer;  GrayShade: UInt8;begin  AResult.BeginUpdate();  try    for LineIndex := 0 to ASource.Height - 1 do    begin      LineSource := ASource.ScanLine[LineIndex];      LineResult := AResult.ScanLine[LineIndex];       for PixelIndex := 0 to ASource.Width - 1 do      begin        PixelSource := @LineSource^[PixelIndex];        PixelResult := @LineResult^[PixelIndex];         GrayShade := Round(PixelSource^.R * 0.299 + PixelSource^.G * 0.587 + PixelSource^.B * 0.114);         PixelResult^.R := Round(PixelSource^.R + (GrayShade - PixelSource^.R) / 255 * ALevel);        PixelResult^.G := Round(PixelSource^.G + (GrayShade - PixelSource^.G) / 255 * ALevel);        PixelResult^.B := Round(PixelSource^.B + (GrayShade - PixelSource^.B) / 255 * ALevel);    end;    end;  finally    AResult.EndUpdate();  end;end; Modified example in the attachment. ---------------------------------------------------------------------- AjL0ra · 2022-02-28 19:26 furious programming, thank you with your examples, you my friend are life saver. ---------------------------------------------------------------------- flowCRANE · 2022-02-28 20:07 Keep in mind that you cannot create a 32-bit TBitmap and TPortableNetworkGraphic. I don't know why but setting PixelFormat to pf32bit do nothing — pixel format stays 24-bit still. That's why in the second example program, the 32-bit source PNG is loaded to the main object and then it is assigned to the other two objects. The Assign method changes the pixel format of the destination image, so it is possible to modify them as 32-bit images via ScanLine. There are many solutions to avoid this problem, AFAIR such as using TFPImage and then copy it to the TPortableNetworkGraphic, but this is a waste of memory and CPU time (such a solutions are not very efficient). ---------------------------------------------------------------------- AjL0ra · 2022-02-28 20:25 another doubt though how can change its color base using color modeling HSI and/or YUV ---------------------------------------------------------------------- winni · 2022-02-28 20:51 Hi! Use BGRAbitmap. HSLA is one of the basics. YUV is in the webp unit. Winni ---------------------------------------------------------------------- AjL0ra · 2022-03-05 02:10 @furiousprogramming could you please show how to put the algorithm of hsi in the code Im tryin but failling tremendously ---------------------------------------------------------------------- ADMGNS · 2022-03-07 07:36 hello, Quote from: Ally on February 28, 2022, 12:19:11 pmHello ADMGNS and furious programming, your examples don't seem to work with images that can contain transparent image parts (for example .png or .ico). another example is here, see attchment.. it supports alpha channel i.e. it seperates alpha channel by direct access to BGRABitmap's bitmap data.. regs ---------------------------------------------------------------------- flowCRANE · 2022-03-07 17:48 @AjL0ra: standard images uses RGB(A) pixels, so if you need to use HSI, you need functions to convert color to HSI and vice versa. Use Google and find examples or even code snippets with proper calculations. Then all you need to do is read pixel data, convert is to HSI color space, do whatever you want, convert color back to RGB format and store new values in the result image. So the template is as the same as previous: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i procedure RGBToHSI(AR, AG, AB: UInt8; out AH, AS, AI: UInt16);begin  // implement calculationsend; procedure HSIToRGB(AH, AS, AI: UInt16; out AR, AG, AB: UInt8);begin  // implement calculationsend; procedure DoSomethingWith32BitImage(ASource, AResult: TPortableNetworkGraphic);type  PPNGPixel = ^TPNGPixel;  TPNGPixel = packed record B, G, R, A: UInt8 end;type  PPNGLine = ^TPNGLine;  TPNGLine = packed array [UInt16] of TPNGPixel;var  LineSource, LineResult: PPNGLine;  PixelSource, PixelResult: PPNGPixel;var  LineIndex, PixelIndex: Integer;  H, S, I: UInt16;begin  AResult.BeginUpdate();  try    for LineIndex := 0 to ASource.Height - 1 do    begin      LineSource := ASource.ScanLine[LineIndex];      LineResult := AResult.ScanLine[LineIndex];       for PixelIndex := 0 to ASource.Width - 1 do      begin        PixelSource := @LineSource^[PixelIndex];        PixelResult := @LineResult^[PixelIndex];         // translate RGB to HSI and store it in H, S and I variables        RGBToHSI(PixelSource^.R, PixelSource^.G, PixelSource^.B, H, S, I);                // do whatever you want with H, S, and I variables                // translate HSI to RGB and write result to the target image        HSIToRGB(H, S, I, PixelResult^.R, PixelResult^.G, PixelResult^.B);    end;    end;  finally    AResult.EndUpdate();  end;end; ---------------------------------------------------------------------- ADMGNS · 2022-03-09 08:20 updated version, incremental progressing.. see attachment pls.. ---------------------------------------------------------------------- flowCRANE · 2022-03-09 15:31 This topic is about using TrackBar, not ProgressBar. ---------------------------------------------------------------------- winni · 2022-03-09 16:41 Hi! The TTrackbar is a TWinControl. This means that there is no  canvas. You can only draw on it with some hacks. Winni ---------------------------------------------------------------------- ADMGNS · 2022-03-10 16:06 Quote from: furious programming on March 09, 2022, 04:31:38 pmThis topic is about using TrackBar, not ProgressBar. ok.. but, extra information is not harmful ---------------------------------------------------------------------- AjL0ra · 2022-03-14 20:08 @furious programming thank you so much your are undoubtedly an uncaped hero