ActiveDelphi

[fausto_vaz]

Olá Pessoal,

Bem estou com uma dúvida e gostaria que vocês me ajudassem. Estou precisando desenvolver um pequeno sistema que permitiria carregar uma imagem (pode ser pelo componente TIMAGE)e após carregado permitisse fazer zoom na mesma.
O sistema funcionário da seguinte forma:
Dada um imagem JPEG de um mapa, o sistema permitiria fazer zoom e também quando clicasse em um botão (por exemplo botão esquerdo) eu pudesse navegar através dela (fazendo uma espécie de scroll) para esquerda.
Amigos, se tiverem idéias a respeito ficaria muito agradecido se vocês postassem elas aqui..


Muito obrigado,
Fausto Vaz.

[fausto_vaz]

Alguma idéia....????

[danielbuona]

ae broder... pegai:

----------------------DFM-------------------------
[code]
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = \'Form1\'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = \'MS Sans Serif\'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 160
Top = 80
Width = 96
Height = 37
Caption = \'ZOOM\'
Font.Charset = DEFAULT_CHARSET
Font.Color = clNavy
Font.Height = -32
Font.Name = \'MS Sans Serif\'
Font.Style = []
ParentFont = False
end
object Button1: TButton
Left = 160
Top = 112
Width = 41
Height = 25
Caption = \'+\'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 208
Top = 112
Width = 41
Height = 25
Caption = \'-\'
TabOrder = 1
OnClick = Button2Click
end
object Panel1: TPanel
Left = 168
Top = 152
Width = 265
Height = 217
BevelOuter = bvNone
TabOrder = 2
object Image1: TImage
Left = 1
Top = 1
Width = 263
Height = 215
Stretch = True
end
end
object Button3: TButton
Left = 160
Top = 40
Width = 129
Height = 25
Caption = \'Abrir Imagem\'
TabOrder = 3
OnClick = Button3Click
end
object Edit1: TEdit
Left = 256
Top = 116
Width = 57
Height = 21
TabOrder = 4
Text = \'10\'
end
object Button4: TButton
Left = 168
Top = 384
Width = 81
Height = 25
Caption = \'Stretch\'
TabOrder = 5
OnClick = Button4Click
end
object Button5: TButton
Left = 256
Top = 384
Width = 113
Height = 25
Caption = \'Tamanho Original\'
TabOrder = 6
OnClick = Button5Click
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 296
Top = 40
end
end
[/code]

-------------------------PAS----------------------------
[code]
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
Image1: TImage;
Button3: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Edit1: TEdit;
Label1: TLabel;
Button4: TButton;
Button5: TButton;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile( OpenPictureDialog1.FileName );
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Height := Image1.Height + StrToInt( Edit1.Text );
Image1.Width := Image1.Width + StrToInt( Edit1.Text );

Image1.Top := Image1.Top - Trunc( StrToInt( Edit1.Text ) / 2 ); // Isso é para ir dando zoom pelo centro da imagem...
Image1.Left := Image1.Left - Trunc( StrToInt( Edit1.Text ) / 2 );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Image1.Height := Image1.Height - StrToInt( Edit1.Text );
Image1.Width := Image1.Width - StrToInt( Edit1.Text );

Image1.Top := Image1.Top + Trunc( StrToInt( Edit1.Text ) / 2 );
Image1.Left := Image1.Left + Trunc( StrToInt( Edit1.Text ) / 2 );
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Image1.Top := 0;
Image1.Left := 0;

Image1.Height := Panel1.Height;
Image1.Width := Panel1.Width;

Image1.Stretch := True;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Image1.Top := 0;
Image1.Left := 0;

Image1.Height := Panel1.Height;
Image1.Width := Panel1.Width;

Image1.Stretch := False;
end;

end.
[/code]
_________________
Daniel Buona - danielbuona@hotmail.com
www.aflsistemas.com.br/blog

[Carioca]

cara, naum entendi qnto a navegação o que vc quer. Mas qnto ao zoom, vc pode utilizar um timage. coloque sua propriedade autosize para false e strech para true. ai vc faz um redimensionamento da imagem para fazer o zoom. Por exemplo: crie um formulário e coloque um tpanel nele. Ai nele coloque o timage. O panel atuara como um limitador para a maxima imagem visivel e vc podera fazer um scroll nele. Crie tres var globais chamadas alturaNormal, larguraNormal e zoom do tipo inteiro. Coloque um botao para abrir uma imagem e no onClick dele faça:

if openPictureDialog1.execute then
begin
image1.autosize := true;
Image1.picture.bitmap.loadfromfile(openpicturedialog1.filename);
alturaNormal := image1.height;
larguranormal := image1.width;
image1.autosize := false;
zoom := 100;
end;

No onMouseDown da imagem faça:

if ssCtrl in shift then
Dec(Zoom, 50)
else
Inc(Zoom, 50);
if Zoom<50 then
Zoom := 50
else if Zoom >1000 then
Zoom := 1000;
Image1.width := larguranormal*Zoom/100;
image1.height := alturanormal*zoom/100;

Vc pode configurar do jeito que achar melhor. Espero ter ajudado. flw
_________________
{celitojr@gmail.com | http://useweknow.com.br/}

+ Seja educado. Se a ajuda foi proveitosa, responda e agradeça.
+ Leia as regras antes de postar.
+ Use a pesquisa do fórum antes de postar novos tópicos.

[adriano_servitec]

Desculpe usar o seu topico amigo fausto_vaz, mais gostei da função ai resolvi postar aqui mesmo..


Fiz um teste aqui e gostei da função que o colega Carioca passou, mais tive que colocar um TRUNC() para poder compilar, e preferi usar um ScrollBox no lugar de um Panel (No projeto que estou desenvolvendo fica melhor).

[code]procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in shift then
Dec(Zoom, 50)
else
Inc(Zoom, 50);
if Zoom<50 then
Zoom := 50
else if Zoom >1000 then
Zoom := 1000;
Image1.width := larguranormal*trunc(Zoom/100); //um trunc aqui
image1.height := alturanormal*trunc(zoom/100); // outro trunc aqui

end;[/code]

Agora gostaria de saber amigo se tem como fazer este codigo funcionaro em um PopupMenu

Tipo no PopupMenu colocar
zoom (+) //ai o codigo para dar o zoom

e
zoom (-) // este tambem gostaria de saber como fazer para diminuir.


Se puder me ajudar
Estou no aguardo.

Abraços
Adriano.
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree

[adriano_servitec]

Achei um codigo mais nao eh o que eu quero, mesmo assim vou deixar postado aqui

Arquivo DFM
[code]object Form1: TForm1
Left = 279
Top = 198
AutoScroll = False
BorderIcons = [biSystemMenu, biMinimize]
Caption = \'gZoom\'
ClientHeight = 347
ClientWidth = 402
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = \'MS Sans Serif\'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = True
Position = poScreenCenter
OnDestroy = FormDestroy
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 0
Top = 0
Width = 402
Height = 347
Align = alClient
Visible = False
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 150
Height = 150
BevelInner = bvRaised
BevelOuter = bvNone
TabOrder = 0
object GroupBox1: TGroupBox
Left = 8
Top = 8
Width = 133
Height = 69
Caption = \' Zoom factor \'
TabOrder = 0
object Label1: TLabel
Left = 12
Top = 48
Width = 14
Height = 13
Caption = \'2 x\'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = \'MS Sans Serif\'
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 44
Top = 48
Width = 14
Height = 13
Caption = \'4 x\'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = \'MS Sans Serif\'
Font.Style = []
ParentFont = False
end
object Label3: TLabel
Left = 76
Top = 48
Width = 14
Height = 13
Caption = \'6 x\'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = \'MS Sans Serif\'
Font.Style = []
ParentFont = False
end
object Label4: TLabel
Left = 105
Top = 48
Width = 14
Height = 13
Caption = \'8 x\'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = \'MS Sans Serif\'
Font.Style = []
ParentFont = False
end
object Slider: TTrackBar
Left = 9
Top = 16
Width = 115
Height = 33
Max = 4
Min = 1
Orientation = trHorizontal
PageSize = 1
Frequency = 1
Position = 1
SelEnd = 0
SelStart = 0
TabOrder = 0
TickMarks = tmBottomRight
TickStyle = tsAuto
end
end
object BitBtn1: TBitBtn
Left = 28
Top = 112
Width = 95
Height = 30
Caption = \'&Click Here\'
TabOrder = 1
OnClick = BitBtn1Click
Kind = bkAll
end
object cbSrediste: TCheckBox
Left = 8
Top = 84
Width = 109
Height = 21
Caption = \'Show crosshair\'
Checked = True
State = cbChecked
TabOrder = 2
end
end
object Timer1: TTimer
Interval = 25
OnTimer = Timer1Timer
end
end[/code]

Arquivo PAS
[code]{
Zoom
http://delphi.about.com/library/weekly/aa120198.htm
Zoom in portion of your desktop screen like a loope.

********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
********************************************
}

unit uZoom;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ExtCtrls, Buttons, JvGIF;

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
Panel1: TPanel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Slider: TTrackBar;
BitBtn1: TBitBtn;
cbSrediste: TCheckBox;
Image2: TImage;
procedure FormResize(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
end;

var
Form1: TForm1;

implementation
uses uAbout;
{$R *.DFM}

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
Msg.MinMaxInfo^.ptMinTrackSize := Point(158, 177); // min form size
Msg.MinMaxInfo^.ptMaxTrackSize := Point(350, 350); // max form size (width, height)
end;


procedure TForm1.FormResize(Sender: TObject);
begin
// panel in the middle of the form
Panel1.Left:=(Form1.ClientWidth Div 2) - Panel1.Width div 2;
Panel1.Top:=(Form1.ClientHeight Div 2) - Panel1.Height div 2;
Image1.Picture:=nil;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Form1.FormStyle:=fsNormal;
with TAboutBox.Create(nil) do
try
Timer1.Interval:=0;
ShowModal;
finally
Timer1.Interval:=25;
Free;
end;
Form1.FormStyle:=fsStayOnTop;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Interval:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Srect,Drect,PosForme:TRect;
iWidth,iHeight,DmX,DmY:Integer;
iTmpX,iTmpY:Real;
C:TCanvas;
hDesktop: Hwnd;
Kursor:TPoint;
begin
If not IsIconic(Application.Handle) then begin
hDesktop:= GetDesktopWindow;
GetCursorPos(Kursor);
PosForme:=Rect(Form1.Left,Form1.Top,Form1.Left+Form1.Width,Form1.Top+Form1.Height);
If not PtInRect(PosForme,Kursor) then begin

If Panel1.Visible=True then Panel1.Visible:=False;
If Image1.Visible=False then Image1.Visible:=True;

iWidth:=Image1.Width;
iHeight:=Image1.Height;
Drect:=Rect(0,0,iWidth,iHeight);

iTmpX:=iWidth / (Slider.Position * 4);
iTmpY:=iHeight / (Slider.Position * 4);

Srect:=Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);
InflateRect(Srect,Round(iTmpX),Round(iTmpY));
// move Srect if outside visible area of the screen
If Srect.Left<0 then OffsetRect(Srect,-Srect.Left,0);
If Srect.Top<0 then OffsetRect(Srect,0,-Srect.Top);
If Srect.Right>Screen.Width then OffsetRect(Srect,-(Srect.Right-Screen.Width),0);
If Srect.Bottom>Screen.Height then OffsetRect(Srect,0,-(Srect.Bottom-Screen.Height));

C:=TCanvas.Create;
try
C.Handle:=GetDC(GetDesktopWindow);
Image1.Canvas.CopyRect(Drect,C,Srect);
finally
ReleaseDC(hDesktop, C.Handle);
C.Free;
end;
If cbSrediste.Checked=True then begin // show crosshair
with Image1.Canvas do begin
DmX:=Slider.Position * 2 * (Kursor.X-Srect.Left);
DmY:=Slider.Position * 2 * (Kursor.Y-Srect.Top);
MoveTo(DmX - (iWidth div 4),DmY); // -
LineTo(DmX + (iWidth div 4),DmY); // -
MoveTo(DmX,DmY - (iHeight div 4)); // |
LineTo(DmX,DmY + (iHeight div 4)); // |
end; // with image1.Canvas
end; // show crosshair
Application.ProcessMessages;
end // Cursor not inside form
else begin // cursor inside form
If Panel1.Visible=False then Panel1.Visible:=True;
If Image1.Visible=True then Image1.Visible:=False;
end;
end; // IsIconic
end;

end.[/code]

De qualquer forma estou procurando, quero almentar e diminuir o zoom.


_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree

[Carioca]

No codigo q eu postei eh possivel diminuir. Basta clicar na imagem com o botao CTRL pressionado. Tenta ai. Qnto ao fato de vc utilizar um scrollbox ou panel ou qqr outra coisa, vai de sua preferncia. Sobre o popup, creio que td q vc deva fazer eh colocar o codigo de clique da imagem no correspondente clicque de menu. Por exemplo:

procedure TForm1.ZoomMenosClick;
begin
Dec(Zoom, 50);
Atualiza;
end;

procedure TForm1.ZoomMaisClick;
begin
Inc(Zoom, 50);
Atualiza;
end;

procedure Atualiza;
begin
{aqui foi erro meu, eu quis usar um DIV, assim:}
Image1.width := larguranormal * Zoom div 100;
image1.height := alturanormal * Zoom div 100;
end;

creio que isso lhe ajude. Bom naum li todo o codigo que vc postou ai. Eh bastante gnd. Creio que ele faça extamente isso, naum?? Soh naum entendi se vc ainda precisa do codigo de rolagem ou se vc vai utilizar um scrollbox. Posta ai. vlw
_________________
{celitojr@gmail.com | http://useweknow.com.br/}

+ Seja educado. Se a ajuda foi proveitosa, responda e agradeça.
+ Leia as regras antes de postar.
+ Use a pesquisa do fórum antes de postar novos tópicos.

[adriano_servitec]

Ai Carioca, blz, o codigo que vc postou perfeito para o meu projeto.

Sobre rolagem, tambem acho que vou usa-lo, mais de outro jeito.

O codigo que postei eh um pouco diferente fica um TImage e conforme vou passando o mouse sobre a tela vai me mostrando o zoom.

Realmente o Ctrl faz o inverso, nao tinha reparado

Ficou show agora usando um PopupMenu, do jeito que eu preciso no meu projeto, só que nao estou conseguindo diminuir ou seja zoom (-) ((dec) DECREMENTO) nao esta funcionando.

[code]procedure TForm1.ZoomMenos1Click(Sender: TObject);
begin
Dec(Zoom, 50);
Atualiza;

end;[/code]

este codigo nao consigo fazer funcionar


Obrigado amigo
Valeu sua ajuda


Abraços
Adriano.








[Editado em 12/7/2006 por adriano_servitec]
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree

[Carioca]

Cara, naum sei pq. Testei aqui e tah funcionado corretamente. Tenta issu ai:

[code]unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, GIFImage, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure Atualiza;

var
Form1: TForm1;
zoom, larguranormal, alturanormal: integer;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Inc(Zoom, 50);
Atualiza;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Dec(Zoom, 50);
Atualiza;
end;

procedure Atualiza;
begin
form1.Image1.width := larguranormal * Zoom div 100;
form1.image1.height := alturanormal * Zoom div 100;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
larguranormal := image1.width;
alturanormal := image1.height;
zoom := 100;
end;

end.
[/code]

se naum funcionar posta ai. vlw
_________________
{celitojr@gmail.com | http://useweknow.com.br/}

+ Seja educado. Se a ajuda foi proveitosa, responda e agradeça.
+ Leia as regras antes de postar.
+ Use a pesquisa do fórum antes de postar novos tópicos.

[adriano_servitec]

Engraçado, dentro do popupmenu nao funciona, mais dentro de um bitbtn ou um button funciona.

Vou deixar com um BitBtn mesmo.


Valeu
Obriogado

Abraços
Adriano.

[Editado em 12/7/2006 por adriano_servitec]
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree

[fausto_vaz]

E aí moçada,
primeiramente deixo meus agradecimentos pelos tópicos postados. Valeu..
fiz testes com a função que faz zoom postada pelo amigo carioca e também pelo amigo adriano_servitec, funcionou tudo certinho...
e enquanto a navegação da imagem, o problema seria mais ou menos assim: Dada uma imagem JPEG, tenho que fazer um procedimento que mostra só uma parte desse arquivo e quando eu clicasse em botões (por exemplo botão esquerdo, direito, cima e baixo) ele iria mostrando as outras partes do arquivo de forma a fornecer uma navegação na imagem.
Estou com algumas idéias, talvez usando a classe TCanvas...
mas se os colegas tiveram idéia de como posso fazer isso, ficaria agradecido pela ajuda....

abraços,
Fausto.

[fausto_vaz]

Usei o aplicativo que o amigo carioca passou aqui no forum e já resolvi quase todos os problemas. Usando o mesmo image e adicionando ao onclick dos botões esquerdo, direito, para cima e para baixo as linhas:

image1.top := image1.top + 10; // Para botão esquerdo
image1.top := image1.top - 10; // Para botão direito

Image1.top := Image1.Top + 10; // Para cima
Image1.top := Image1.Top - 10;// Para baixo

Caros colegas seria complicado navegar na imagem através do mouse? Usando aquelas maozinhas típicas do Adobe Reader?
Alguma idéia de como seria?

Se tiverem idéias, agradeço se postarem..

abraços a todos,
Fausto

[Aldebaran]

Carioca vc poderia postar o Code inteiro para nos?
_________________

[fausto_vaz]

Amigos,
Existe um projeto open source de um editor de imagem chamado Estampe,
lá tem várias funções como: Zoom, recorte de imagens. função do baldinho, píncel e várias outras...
dá pra aproveitar e aprender várias coisas para tratar imagens...
se alguem se interessar eu posso enviar ou marcar algum lugar onde posso postar os aquivos...

é isso aí amigos,

abraços

[Aldebaran]

Poste o arquivo no Turbo Upload e mande o link para nos blza?
_________________