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);
var
i,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);
var
i,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 canvas
end;
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);
var
i,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.
Recent
