[chinnamasta]

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
    { Private declarations }
  public
    { Public declarations }
  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