Q&A
HOME
Tips & Tech
Q&A
Discuss
Download
자유게시판
홍보 / 광고
구인 / 구직
LOGIN
회원가입
이미지 스크롤은 어떻게 하나요?
폼에 이미지 컴포넌트를 넣고
이미지를 불러 들였습니다만,
화면크기보다 이미지가 더 크기 때문에
아래 부분은 보이지 않습니다.
원본을 축소시키지 않고 보고싶기 때문에
스크롤을 사용하여 아래,좌우로 이동하여
보고 싶은데...
기본적으로 지원되는 컴포넌트를 이용하여
그림 스크롤을 만들수있는지요???
1
COMMENTS
전철호
•
1999.06.07 20:06
chobo 께서 말씀하시기를...
>
> 폼에 이미지 컴포넌트를 넣고
> 이미지를 불러 들였습니다만,
>
> 화면크기보다 이미지가 더 크기 때문에
> 아래 부분은 보이지 않습니다.
>
> 원본을 축소시키지 않고 보고싶기 때문에
> 스크롤을 사용하여 아래,좌우로 이동하여
> 보고 싶은데...
>
> 기본적으로 지원되는 컴포넌트를 이용하여
> 그림 스크롤을 만들수있는지요???
다음은 이미지를 스크롤하는 콤포넌트 소스입니다.
참고하시면 위의 문제를 해결 하시는 데 도움이 될것입니다.
[소스]
unit ZImage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TZImage = class(TGraphicControl)
private
FBitmap : TBitmap;
PicRect : TRect;
ShowRect : TRect;
FShowBorder : boolean;
FBorderWidth : integer;
FForceRepaint : boolean;
FMouse : (mNone, mDrag, mZoom);
FProportional : boolean;
FDblClkEnable : boolean;
startx, starty,
oldx, oldy : integer;
procedure SetShowBorder(s:boolean);
procedure SetBitmap(b:TBitmap);
procedure SetBorderWidth(w:integer);
procedure SetProportional(b:boolean);
protected
procedure Paint; override;
procedure DblClick; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property ShowBorder : boolean
read FShowBorder
write SetShowBorder default true;
property KeepAspect : boolean
read FProportional
write SetProportional default true;
property Bitmap : TBitmap
read FBitmap
write SetBitmap;
property BorderWidth : integer
read FBorderWidth
write SetBorderWidth default 7;
property ForceRepaint : boolean
read FForceRepaint
write FForceRepaint default true;
property DblClkEnable : boolean
read FDblClkEnable
write FDblClkEnable default False;
property Align;
property Width;
property Height;
property Top;
property Left;
property Visible;
property Hint;
property ShowHint;
end;
procedure Register;
implementation
constructor TZImage.Create(AOwner:TComponent);
begin
inherited;
FShowBorder:=True;
FBorderWidth:=7;
FMouse:=mNone;
FForceRepaint:=True;
FDblClkEnable:=False;
FProportional:=True;
Width:=100; Height:=100;
FBitmap:=TBitmap.Create;
FBitmap.Width:=Width;
FBitmap.Height:=Height;
ControlStyle:=ControlStyle+[csOpaque];
end;
destructor TZImage.Destroy;
begin
FBitmap.Free;
inherited;
end;
procedure TZImage.Paint;
var buf:TBitmap;
coef,asps,aspp:Double;
sz,a : integer;
begin
buf:=TBitmap.Create;
buf.Width:=Width;
buf.Height:=Height;
if not FShowBorder
then ShowRect:=ClientRect
else ShowRect:=Rect(ClientRect.Left,ClientRect.Top,
ClientRect.Right-FBorderWidth,
ClientRect.Bottom-FBorderWidth);
with PicRect do begin
if Right=0 then Right:=FBitmap.Width;
if Bottom=0 then Bottom:=FBitmap.Height;
end;
if FProportional then begin
asps:=ShowRect.Bottom/ShowRect.Right;
//IF added in v.1.2 to avoid zero-divide
if (PicRect.Right=PicRect.Left)
then
aspp := 1
else
aspp := (PicRect.Bottom-PicRect.Top)/(PicRect.Right-PicRect.Left);
if asps>aspp then begin //PicRect is wider
sz:=Round((PicRect.Bottom-PicRect.Top)/asps);
a:=PicRect.Right-PicRect.Left;
PicRect.Left:=PicRect.Left+(a-sz) div 2;
PicRect.Right:=PicRect.Left+sz;
end else begin //PicRect is taller
sz:=Round((PicRect.Right-PicRect.Left)*asps);
a:=PicRect.Bottom-PicRect.Top;
PicRect.Top:=PicRect.Top+(a-sz) div 2;
PicRect.Bottom:=PicRect.Top+sz;
end;
if PicRect.Left<0 then MessageBeep(0);
if PicRect.Top<0 then MessageBeep(0);
end;
buf.Canvas.CopyMode:=cmSrcCopy;
buf.Canvas.CopyRect(ShowRect,FBitmap.Canvas,PicRect);
if FShowBorder then begin
buf.Canvas.Brush.Color:=clWhite;
buf.Canvas.Rectangle(Width-BorderWidth,0,Width,Height-BorderWidth);
buf.Canvas.Rectangle(0,Height-BorderWidth,Width-BorderWidth,Height);
buf.Canvas.Brush.Color:=clSilver;
buf.Canvas.Rectangle(Width-BorderWidth-1,Height-BorderWidth-1,buf.Width,Height);
//horizontal zoom indicator
coef:=(Width-BorderWidth)/FBitmap.Width;
buf.Canvas.Rectangle(
Round(PicRect.Left*coef)+2, Height-BorderWidth+2,
Round(PicRect.Right*coef)-2, Height-2);
//vertical zoom indicator
coef:=(Height-BorderWidth)/FBitmap.Height;
buf.Canvas.Rectangle(
Width-BorderWidth+2,Round(PicRect.Top*coef)+2,
Width-2, Round(PicRect.Bottom*coef)-2);
end;
Canvas.CopyMode:=cmSrcCopy;
Canvas.Draw(0,0,buf);
buf.Free;
end;
procedure TZImage.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if not PtInRect(ShowRect,Point(X,Y)) and
not PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then Exit;
if PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then begin
DblClick;
Exit;
end;
startx:=x; oldx:=x;
starty:=y; oldy:=y;
if mbRight=Button then begin
MouseCapture:=True;
FMouse:=mZoom;
Canvas.Pen.Mode:=pmNot;
end else begin
FMouse:=mDrag;
Screen.Cursor:=crHandPoint;
end;
end;
function Min(a,b:integer):integer;
begin
if a
end;
function Max(a,b:integer):integer;
begin
if a
end;
procedure TZImage.MouseMove(Shift: TShiftState; X, Y: Integer);
var d,s:integer;
coef:Double;
begin
if FMouse=mNone then Exit;
if FMouse=mZoom then begin
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
oldx:=x; oldy:=y;
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
end;
if FMouse=mDrag then begin
//horizontal movement
coef:=(PicRect.Right-PicRect.Left)/(ShowRect.Right-ShowRect.Left);
d:=Round(coef*(x-oldx));
s:=PicRect.Right-PicRect.Left;
if d>0 then begin
if PicRect.Left>=d then begin
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Left:=0;
PicRect.Right:=PicRect.Left+s;
end;
end;
if d<0 then begin
if PicRect.Right
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Right:=FBitmap.Width;
PicRect.Left:=PicRect.Right-s;
end;
end;
//vertical movement
coef:=(PicRect.Bottom-PicRect.Top)/(ShowRect.Bottom-ShowRect.Top);
d:=Round(coef*(y-oldy));
s:=PicRect.Bottom-PicRect.Top;
if d>0 then begin
if PicRect.Top>=d then begin
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Top:=0;
PicRect.Bottom:=PicRect.Top+s;
end;
end;
if d<0 then begin
if PicRect.Bottom
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Bottom:=FBitmap.Height;
PicRect.Top:=PicRect.Bottom-s;
end;
end;
oldx:=x; oldy:=y;
if FForceRepaint then Repaint
else Invalidate;
end;
end;
procedure TZImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var coef:Double;
t:integer;
begin
if FMouse=mNone then Exit;
if x>ShowRect.Right then x:=ShowRect.Right;
if y>ShowRect.Bottom then y:=ShowRect.Bottom;
if FMouse=mZoom then begin //calculate new PicRect
t:=startx;
startx:=Min(startx,x);
x:=Max(t,x);
t:=starty;
starty:=Min(starty,y);
y:=Max(t,y);
FMouse:=mNone;
MouseCapture:=False;
if Abs(x-startx)<5 then Exit;
if (PicRect.Right=PicRect.Left)
then
coef := 100000
else
coef:=ShowRect.Right/(PicRect.Right-PicRect.Left);
PicRect.Left:=Round(PicRect.Left+startx/coef);
PicRect.Right:=PicRect.Left+Round((x-startx)/coef);
if (PicRect.Bottom=PicRect.Top)
then
coef := 100000
else
coef:=ShowRect.Bottom/(PicRect.Bottom-PicRect.Top);
PicRect.Top:=Round(PicRect.Top+starty/coef);
PicRect.Bottom:=PicRect.Top+Round((y-starty)/coef);
end;
if FMouse=mDrag then begin
FMouse:=mNone;
Canvas.Pen.Mode:=pmCopy;
Screen.Cursor:=crDefault;
end;
Invalidate;
end;
procedure TZImage.DblClick;
begin
PicRect:=Rect(0,0,FBitmap.Width,FBitmap.Height);
Invalidate;
end;
procedure TZImage.SetBitmap(b:TBitmap);
begin
FBitmap.Assign(b);
PicRect:=Rect(0,0,b.Width, b.Height);
Invalidate;
end;
procedure TZImage.SetBorderWidth(w:integer);
begin
FBorderWidth:=w;
Invalidate;
end;
procedure TZImage.SetShowBorder(s:boolean);
begin
FShowBorder:=s;
Invalidate;
end;
procedure TZImage.SetProportional(b:boolean);
begin
FProportional:=b;
Invalidate;
end;
procedure Register;
begin
RegisterComponents('Custom', [TZImage]);
end;
0
0
삭제
수정
댓글
(NOTICE) You must be
logged in
to comment on this post.
이승윤
•
1999.06.07 22:27
1
COMMENTS
/
0
LIKES
SQLServer7.0의 DB를 백업하는 방법좀...
김태균
•
1999.06.07 23:48
이승윤 께서 말씀하시기를... > SQLServer7.0을 처음 사용합니다. > 서버에 설치된 DB를 디스켓으로 받아...
초보
•
1999.06.07 22:06
6
COMMENTS
/
0
LIKES
함수 사용볍에 대해서
안치봉
•
1999.06.08 00:46
초보
•
1999.06.09 02:39
초보
•
1999.06.09 02:44
안치봉
•
1999.06.09 03:26
초보
•
1999.06.09 19:14
안치봉
•
1999.06.09 19:24
권인혁
1999.06.07 19:42
0
COMMENTS
/
0
LIKES
사용자 정의 메세지 받기가 잘 안됩니다.
chobo
•
1999.06.07 19:31
1
COMMENTS
/
0
LIKES
이미지 스크롤은 어떻게 하나요?
폼에 이미지 컴포넌트를 넣고 이미지를 불러 들였습니다만, 화면크기보다 이미지가 더 크기 때문에 아래 부분은 보이지 않습니다. 원본을 축소시키지 않고 보고싶기 때문에 스크롤을 사용하여 아래,좌우로 이동하여 보고 싶은데... 기본적...
전철호
•
1999.06.07 20:06
chobo 께서 말씀하시기를... > > 폼에 이미지 컴포넌트를 넣고 > 이미지를 불러 들였습니다만, > >...
세림
•
1999.06.07 19:28
1
COMMENTS
/
0
LIKES
웹서버응용을 테스트하려고하는데..
안치봉
•
1999.06.08 00:35
세림 께서 말씀하시기를... > 간단한 웹서버 응용을 테스트하고 있는데 > 처음에는 익스플러어에서 실행...
성관
•
1999.06.07 19:04
1
COMMENTS
/
0
LIKES
indexname에 대해
델사랑
•
1999.06.07 19:45
성관 께서 말씀하시기를... > 안녕하세요.. > 날씨가 무척이나 무덥지요,,,,, > 무더운 여름을 잘 보내...
조진희
•
1999.06.07 18:51
2
COMMENTS
/
0
LIKES
DBgrid에서 선택된 데이타 입력폼에 표시되도록
박성훈
•
1999.06.11 02:15
조진희 께서 말씀하시기를... > 안녕들 하셨어요.. > 저희가 입력된 데이타 수정작업을 하려던 중에 dggr...
초보
•
1999.06.12 20:25
박성훈 께서 말씀하시기를... > dbgrid를 선택하신 곳이 현재 레코드의 위치가 됩니다. 그러니까 사원테...
정성호
•
1999.06.07 18:47
1
COMMENTS
/
0
LIKES
꾸벅.. nil 이라는 예약어의 용도는 어케되나요..???^^
전철호
•
1999.06.07 20:01
정성호 께서 말씀하시기를... > 안녕하세요.. 많은 도움을 받고 있는 신삥입니당... > 쩝 전 도와드릴 일...
김재휘
1999.06.07 17:39
0
COMMENTS
/
0
LIKES
"At end of the table" Error 보셨나요?
김재휘
1999.06.07 17:34
0
COMMENTS
/
0
LIKES
DataModule과 DLL 질문, 예제소스부탁..
Hans
1999.06.07 12:51
0
COMMENTS
/
0
LIKES
serial 통신 예제
조종탁
1999.06.07 08:33
0
COMMENTS
/
0
LIKES
pardox graphic field
이영호
1999.06.06 11:58
0
COMMENTS
/
0
LIKES
인스톨쉘드에서 셀프 extract 기능.......
김영남
•
1999.06.06 02:01
2
COMMENTS
/
0
LIKES
html 콤포넌트를 써써 프로그램을 만들었는데...
류성호
•
1999.06.07 20:11
설치 프로그램을 만들어 주는 인스톨쉴드 프로그램은 여러가지가 있습니다. Windows용 설치프로그램 말고...
이정욱
•
1999.06.06 04:19
델파이 헬프에서 'Distributable Files'라는 색인으로 보세요. 이부분이 글씨가 작아서 잘 안보이니 인쇄...
희
•
1999.06.05 23:45
1
COMMENTS
/
0
LIKES
stored procedure사용법좀 갈키주세요
신호성
•
1999.06.07 08:58
희 께서 말씀하시기를... > 델파이에서 내장프로시저를 사용할때 한 묶음의 결과값을 얻고자 할때는 어떻...
황영일
1999.06.05 20:13
0
COMMENTS
/
0
LIKES
win98에서 bde 알리어스를 인식하지 못함
이현신
•
1999.06.05 19:23
3
COMMENTS
/
0
LIKES
특정폴더를 열어서 특정화일을 선택되게 하려면?
이정욱
•
1999.06.05 20:12
무슨 말씀이신지...? 다시 정확히 질문 바랍니다. 이현신 께서 말씀하시기를... > 윈도우에서 특정 폴...
이현신
•
1999.06.05 22:30
이정욱 께서 말씀하시기를... > 무슨 말씀이신지...? 다시 정확히 질문 바랍니다. 그러니깐 PC '내 컴...
김태균
•
1999.06.07 17:49
이현신 께서 말씀하시기를... > 이정욱 께서 말씀하시기를... > > 무슨 말씀이신지...? 다시 정확히 질문...
한 재
•
1999.06.05 17:33
1
COMMENTS
/
0
LIKES
DBGrid Memofield로 내용 출력하기..
전철호
•
1999.06.07 20:11
한 재 께서 말씀하시기를... > DBGrid에 Memo필드의 내용 출력하기 예제(아래의 소스)의 DatabaseName은 '...
하명훈
1999.06.05 10:32
0
COMMENTS
/
0
LIKES
QR에서 에러가....(delphi4.0)
조성윤
•
1999.06.05 08:08
1
COMMENTS
/
0
LIKES
DBComboBox에대하여...
김태균
•
1999.06.07 18:01
조성윤 께서 말씀하시기를... > DBComboBox에서 item추가를 1개 필드의 전체 레코드값을 집어너어 리스트...
chobo
1999/06/07 19:31
Views
292
Likes
0
Comments
1
Reports
0
Tag List
수정
삭제
목록으로
한델 로그인 하기
로그인 상태 유지
아직 회원이 아니세요? 가입하세요!
암호를 잊어버리셨나요?
>
> 폼에 이미지 컴포넌트를 넣고
> 이미지를 불러 들였습니다만,
>
> 화면크기보다 이미지가 더 크기 때문에
> 아래 부분은 보이지 않습니다.
>
> 원본을 축소시키지 않고 보고싶기 때문에
> 스크롤을 사용하여 아래,좌우로 이동하여
> 보고 싶은데...
>
> 기본적으로 지원되는 컴포넌트를 이용하여
> 그림 스크롤을 만들수있는지요???
다음은 이미지를 스크롤하는 콤포넌트 소스입니다.
참고하시면 위의 문제를 해결 하시는 데 도움이 될것입니다.
[소스]
unit ZImage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TZImage = class(TGraphicControl)
private
FBitmap : TBitmap;
PicRect : TRect;
ShowRect : TRect;
FShowBorder : boolean;
FBorderWidth : integer;
FForceRepaint : boolean;
FMouse : (mNone, mDrag, mZoom);
FProportional : boolean;
FDblClkEnable : boolean;
startx, starty,
oldx, oldy : integer;
procedure SetShowBorder(s:boolean);
procedure SetBitmap(b:TBitmap);
procedure SetBorderWidth(w:integer);
procedure SetProportional(b:boolean);
protected
procedure Paint; override;
procedure DblClick; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property ShowBorder : boolean
read FShowBorder
write SetShowBorder default true;
property KeepAspect : boolean
read FProportional
write SetProportional default true;
property Bitmap : TBitmap
read FBitmap
write SetBitmap;
property BorderWidth : integer
read FBorderWidth
write SetBorderWidth default 7;
property ForceRepaint : boolean
read FForceRepaint
write FForceRepaint default true;
property DblClkEnable : boolean
read FDblClkEnable
write FDblClkEnable default False;
property Align;
property Width;
property Height;
property Top;
property Left;
property Visible;
property Hint;
property ShowHint;
end;
procedure Register;
implementation
constructor TZImage.Create(AOwner:TComponent);
begin
inherited;
FShowBorder:=True;
FBorderWidth:=7;
FMouse:=mNone;
FForceRepaint:=True;
FDblClkEnable:=False;
FProportional:=True;
Width:=100; Height:=100;
FBitmap:=TBitmap.Create;
FBitmap.Width:=Width;
FBitmap.Height:=Height;
ControlStyle:=ControlStyle+[csOpaque];
end;
destructor TZImage.Destroy;
begin
FBitmap.Free;
inherited;
end;
procedure TZImage.Paint;
var buf:TBitmap;
coef,asps,aspp:Double;
sz,a : integer;
begin
buf:=TBitmap.Create;
buf.Width:=Width;
buf.Height:=Height;
if not FShowBorder
then ShowRect:=ClientRect
else ShowRect:=Rect(ClientRect.Left,ClientRect.Top,
ClientRect.Right-FBorderWidth,
ClientRect.Bottom-FBorderWidth);
with PicRect do begin
if Right=0 then Right:=FBitmap.Width;
if Bottom=0 then Bottom:=FBitmap.Height;
end;
if FProportional then begin
asps:=ShowRect.Bottom/ShowRect.Right;
//IF added in v.1.2 to avoid zero-divide
if (PicRect.Right=PicRect.Left)
then
aspp := 1
else
aspp := (PicRect.Bottom-PicRect.Top)/(PicRect.Right-PicRect.Left);
if asps>aspp then begin //PicRect is wider
sz:=Round((PicRect.Bottom-PicRect.Top)/asps);
a:=PicRect.Right-PicRect.Left;
PicRect.Left:=PicRect.Left+(a-sz) div 2;
PicRect.Right:=PicRect.Left+sz;
end else begin //PicRect is taller
sz:=Round((PicRect.Right-PicRect.Left)*asps);
a:=PicRect.Bottom-PicRect.Top;
PicRect.Top:=PicRect.Top+(a-sz) div 2;
PicRect.Bottom:=PicRect.Top+sz;
end;
if PicRect.Left<0 then MessageBeep(0);
if PicRect.Top<0 then MessageBeep(0);
end;
buf.Canvas.CopyMode:=cmSrcCopy;
buf.Canvas.CopyRect(ShowRect,FBitmap.Canvas,PicRect);
if FShowBorder then begin
buf.Canvas.Brush.Color:=clWhite;
buf.Canvas.Rectangle(Width-BorderWidth,0,Width,Height-BorderWidth);
buf.Canvas.Rectangle(0,Height-BorderWidth,Width-BorderWidth,Height);
buf.Canvas.Brush.Color:=clSilver;
buf.Canvas.Rectangle(Width-BorderWidth-1,Height-BorderWidth-1,buf.Width,Height);
//horizontal zoom indicator
coef:=(Width-BorderWidth)/FBitmap.Width;
buf.Canvas.Rectangle(
Round(PicRect.Left*coef)+2, Height-BorderWidth+2,
Round(PicRect.Right*coef)-2, Height-2);
//vertical zoom indicator
coef:=(Height-BorderWidth)/FBitmap.Height;
buf.Canvas.Rectangle(
Width-BorderWidth+2,Round(PicRect.Top*coef)+2,
Width-2, Round(PicRect.Bottom*coef)-2);
end;
Canvas.CopyMode:=cmSrcCopy;
Canvas.Draw(0,0,buf);
buf.Free;
end;
procedure TZImage.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if not PtInRect(ShowRect,Point(X,Y)) and
not PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then Exit;
if PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then begin
DblClick;
Exit;
end;
startx:=x; oldx:=x;
starty:=y; oldy:=y;
if mbRight=Button then begin
MouseCapture:=True;
FMouse:=mZoom;
Canvas.Pen.Mode:=pmNot;
end else begin
FMouse:=mDrag;
Screen.Cursor:=crHandPoint;
end;
end;
function Min(a,b:integer):integer;
begin
if a
end;
function Max(a,b:integer):integer;
begin
if a
end;
procedure TZImage.MouseMove(Shift: TShiftState; X, Y: Integer);
var d,s:integer;
coef:Double;
begin
if FMouse=mNone then Exit;
if FMouse=mZoom then begin
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
oldx:=x; oldy:=y;
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
end;
if FMouse=mDrag then begin
//horizontal movement
coef:=(PicRect.Right-PicRect.Left)/(ShowRect.Right-ShowRect.Left);
d:=Round(coef*(x-oldx));
s:=PicRect.Right-PicRect.Left;
if d>0 then begin
if PicRect.Left>=d then begin
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Left:=0;
PicRect.Right:=PicRect.Left+s;
end;
end;
if d<0 then begin
if PicRect.Right
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Right:=FBitmap.Width;
PicRect.Left:=PicRect.Right-s;
end;
end;
//vertical movement
coef:=(PicRect.Bottom-PicRect.Top)/(ShowRect.Bottom-ShowRect.Top);
d:=Round(coef*(y-oldy));
s:=PicRect.Bottom-PicRect.Top;
if d>0 then begin
if PicRect.Top>=d then begin
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Top:=0;
PicRect.Bottom:=PicRect.Top+s;
end;
end;
if d<0 then begin
if PicRect.Bottom
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Bottom:=FBitmap.Height;
PicRect.Top:=PicRect.Bottom-s;
end;
end;
oldx:=x; oldy:=y;
if FForceRepaint then Repaint
else Invalidate;
end;
end;
procedure TZImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var coef:Double;
t:integer;
begin
if FMouse=mNone then Exit;
if x>ShowRect.Right then x:=ShowRect.Right;
if y>ShowRect.Bottom then y:=ShowRect.Bottom;
if FMouse=mZoom then begin //calculate new PicRect
t:=startx;
startx:=Min(startx,x);
x:=Max(t,x);
t:=starty;
starty:=Min(starty,y);
y:=Max(t,y);
FMouse:=mNone;
MouseCapture:=False;
if Abs(x-startx)<5 then Exit;
if (PicRect.Right=PicRect.Left)
then
coef := 100000
else
coef:=ShowRect.Right/(PicRect.Right-PicRect.Left);
PicRect.Left:=Round(PicRect.Left+startx/coef);
PicRect.Right:=PicRect.Left+Round((x-startx)/coef);
if (PicRect.Bottom=PicRect.Top)
then
coef := 100000
else
coef:=ShowRect.Bottom/(PicRect.Bottom-PicRect.Top);
PicRect.Top:=Round(PicRect.Top+starty/coef);
PicRect.Bottom:=PicRect.Top+Round((y-starty)/coef);
end;
if FMouse=mDrag then begin
FMouse:=mNone;
Canvas.Pen.Mode:=pmCopy;
Screen.Cursor:=crDefault;
end;
Invalidate;
end;
procedure TZImage.DblClick;
begin
PicRect:=Rect(0,0,FBitmap.Width,FBitmap.Height);
Invalidate;
end;
procedure TZImage.SetBitmap(b:TBitmap);
begin
FBitmap.Assign(b);
PicRect:=Rect(0,0,b.Width, b.Height);
Invalidate;
end;
procedure TZImage.SetBorderWidth(w:integer);
begin
FBorderWidth:=w;
Invalidate;
end;
procedure TZImage.SetShowBorder(s:boolean);
begin
FShowBorder:=s;
Invalidate;
end;
procedure TZImage.SetProportional(b:boolean);
begin
FProportional:=b;
Invalidate;
end;
procedure Register;
begin
RegisterComponents('Custom', [TZImage]);
end;