Tema: Mover Imagen
Ver Mensaje Individual
  #1  
Antiguo 22-06-2012
chinnamasta chinnamasta is offline
Registrado
NULL
 
Registrado: jun 2012
Posts: 6
Reputación: 0
chinnamasta Va por buen camino
Mover Imagen

hola club delphi

deseo trasladar una imagen que tengo alojada en un timage y deseo trasladarla con información dada en dos tlabel uno para la posición en "x" y otro para la posición en "y". ya lo intente de varias maneras sin tener exito la ultima manera en la que si se mueve la imagen so se detiene se mueve de manera infinita

despues quiero hacer que rote y que se escale pero estas no las e intentado
espero que se resuelva mi problema pronto gracias

les anexo el prog que tengo:
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;
    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);

  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.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:=Image1.Left + trasladarx;
        Image1.Top:=Image1.Top + trasladary;
      Image1.Canvas.Pixels[i,j]:=pix;
        end;
      ProgressBar1.StepIt;
    end;
  end;
end.

como pueden ver el programa tiene filtros y tendra mas filtros

Última edición por Casimiro Notevi fecha: 22-06-2012 a las 14:38:38.
Responder Con Cita