Cita:
Empezado por chinnamasta
hola club delphi.
deseo realizar un programa que dependiendo la imagen que introduzca por medio de un Timage que me regrese la información de histograma de los niveles de los colores R,G,B. con el código que tengo. en varias funciones la imagen es descompuesta pixel por pixel para aplicarles filtros que cambian el color de la imagen y dentro de esos procedimientos mi imagen es vuelta a componer pixel por pixel ya sea que el histograma aparezca por medio de un botón en el menú desplegable o desde un principio el histograma lea los niveles de la imagen.
De antemano muchas gracias a quien me ayude. anexo una imagen de mi interfaz y mi codigo
|
Código Delphi
[-]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtDlgs, ExtCtrls, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Archivo1: TMenuItem;
Abrir1: TMenuItem;
OPD1: TOpenPictureDialog;
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
Image1: TImage;
Basicos1: TMenuItem;
Negativo1: TMenuItem;
StatusBar2: TStatusBar;
Label1: TLabel;
ProgressBar1: TProgressBar;
Grises1: TMenuItem;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
ranformaciones1: TMenuItem;
raslacion1: TMenuItem;
Rotacion1: TMenuItem;
Escalacion1: TMenuItem;
Edit5: TEdit;
Label6: TLabel;
Label7: TLabel;
Edit6: TEdit;
Label8: TLabel;
Label9: TLabel;
Edit7: TEdit;
Edit8: TEdit;
procedure Abrir1Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Negativo1Click(Sender: TObject);
procedure Grises1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure raslacion1Click(Sender: TObject);
procedure Escalacion1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
nomarch:string;
ancho, alto:integer;
X1,X2,Y1,Y2:integer;
implementation
{$R *.dfm}
procedure TForm1.Abrir1Click(Sender: TObject);
begin
if OPD1.Execute then begin
nomarch:=OPD1.FileName;
image1.Picture.LoadFromFile(nomarch);
ancho:=Image1.Width;
alto:=Image1.Height;
Edit1.Text:='0';
Edit2.Text:='0';
Edit3.Text:=IntToStr(ancho);
Edit4.Text:=IntToStr(alto);
StatusBar2.Panels[1].Text:=IntToStr(ancho);
StatusBar2.Panels[3].Text:=IntToStr(alto);
StatusBar2.Panels[4].Text:=nomarch;
end;
end;
procedure TForm1.Escalacion1Click(Sender: TObject);
var
pix,r,g,b:integer;
i,j:integer;
incrementarx,incrementary:integer;
begin
X1:=StrToInt(edit1.Text);
X2:=StrToInt(edit3.Text);
Y1:=StrToInt(edit2.Text);
Y2:=StrToInt(edit4.Text);
incrementarx:=StrToInt(edit7.Text);
incrementary:=StrToInt(edit8.Text);
ProgressBar1.Max:=X2-X1;
for i := X1 to X2 do begin
for j := Y1 to Y2 do begin
pix:=Image1.Canvas.Pixels[i,j];
Image1.Height:=incrementarx;
Image1.Width:=incrementary;
Image1.Canvas.Pixels[i,j]:=pix;
end;
ProgressBar1.StepIt;
end;
end;
procedure TForm1.Grises1Click(Sender: TObject);
var
pix,r,g,b,gris:integer;
i,j:integer;
begin
X1:=StrToInt(edit1.Text);
X2:=StrToInt(edit3.Text);
Y1:=StrToInt(edit2.Text);
Y2:=StrToInt(edit4.Text);
ProgressBar1.Max:=X2-X1;
for i := X1 to X2 do begin
for j := Y1 to Y2 do begin
pix:=Image1.Canvas.Pixels[i,j];
r:=pix and $FF;
g:=(pix and $FF00) shr 8;
b:=(pix and $FF0000) shr 16;
gris:=round((r+g+b)/3);
r:=gris;
g:=gris;
b:=gris;
pix:=r or (g shl 8) or (b shl 16);
Image1.Canvas.Pixels[i,j]:=pix;
end;
ProgressBar1.StepIt;
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if RadioButton1.Checked then begin
Edit1.Text:=IntToStr(x);
Edit2.Text:=IntToStr(y);
end
else begin
Edit3.Text:=IntToStr(x);
Edit4.Text:=IntToStr(y);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
pix,r,g,b:integer;
begin
pix:=Image1.Canvas.Pixels[x,y];
r:=pix and $FF;
g:=(pix and $FF00) shr 8;
b:=(pix and $FF0000) shr 16;
StatusBar1.Panels[1].Text:=IntToStr(X);
StatusBar1.Panels[3].Text:=IntToStr(Y);
StatusBar1.Panels[5].Text:=IntToStr(R);
StatusBar1.Panels[6].Text:=IntToStr(G);
StatusBar1.Panels[7].Text:=IntToStr(B);
end;
procedure TForm1.Negativo1Click(Sender: TObject);
var
pix,r,g,b:integer;
i,j:integer;
begin
X1:=StrToInt(edit1.Text);
X2:=StrToInt(edit3.Text);
Y1:=StrToInt(edit2.Text);
Y2:=StrToInt(edit4.Text);
ProgressBar1.Max:=X2-X1;
for i := X1 to X2 do begin
for j := Y1 to Y2 do begin
pix:=Image1.Canvas.Pixels[i,j];
r:=pix and $FF;
g:=(pix and $FF00) shr 8;
b:=(pix and $FF0000) shr 16;
r:=255-r;
g:=255-g;
b:=255-b;
pix:=r or (g shl 8) or (b shl 16);
Image1.Canvas.Pixels[i,j]:=pix;
end;
ProgressBar1.StepIt;
end;
end;
procedure TForm1.raslacion1Click(Sender: TObject);
var
pix,r,g,b,trasladar1,trasladar2,trasladar3,trasladar4:integer;
i,j,h,y:integer;
trasladarx,trasladary:integer;
begin
X1:=StrToInt(edit1.Text);
X2:=StrToInt(edit3.Text);
Y1:=StrToInt(edit2.Text);
Y2:=StrToInt(edit4.Text);
trasladarx:=StrToInt(edit5.Text);
trasladary:=StrToInt(edit6.Text);
ProgressBar1.Max:=X2-X1;
for i := X1 to X2 do begin
for j := Y1 to Y2 do begin
pix:=Image1.Canvas.Pixels[i,j];
Image1.Left:=trasladarx;
Image1.Top:=trasladary;
Image1.Canvas.Pixels[i,j]:=pix;
end;
ProgressBar1.StepIt;
end;
end;
end.
la imagen de mi interfaz esta anexa al mensaje
28-06-2012
Temas Similares
Mode Lineal
