حرکت لغزشی به روی تصویر

[salam007]

سلام سلام
درون اسکرول باکس برنامه یک Timage قرار دادم ، حالا میخام وقتی موس میره روی ایمیج کاربر با نگه داشتن کلیک راست بتونه عکس رو به جهات مختلف بکشه و حرکت بده مانند حالت دستی که در برنامه فتوشاپ یا گوگل مپ قرار دارد و اگر میشه اون ته حرکت آهسته که بعد از رها کردن کلیک را هم نمایش بدهد برای زیبایی کار عالی میشود،در ضمن من نمیخام از canvas جهت انجام اینکار استفاده کنم

پیشاپیش از دوستان حرفه ای که در این مسئله یاری میکنند تشکر میکنم

[salam007]

کسی نمیتونه کمکی بکنه :ناراحت::افسرده:

[Ananas]

سلام.
تو رویداد OnMouseMove از TImage یه دستور بنویس که اگه کلید چپ موس فشرده شده بود ScrollBy انجام شه مثلا یه نمونش کد زیر :

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
{$J+}
const
LastMousePos : TPoint = (X : 0; Y : 0);
{$J-}
var
p : TPoint;
begin
if (ssLeft in Shift) then
begin
p := Point(X - LastMousePos.X, Y - LastMousePos.Y);
ScrollBox1.ScrollBy(p.X, p.Y);
LastMousePos := Point(X - p.X, Y - p.Y);
end else begin
LastMousePos := Point(X, Y);
end;
end;

برای بعد از رها کردن موس هم می تونی یه TTimer رو بگذاری و تو OnMouseUp تایمر رو فعال کنی و مثلا بعد از 10 دفعه تایمر خودش رو غیر فعال کنه.

[حسن اسدپور]

منظور از LastMousePos یعنی مکان کروسر هست ؟ LastMousePos در برنامه به عنوان متغییر ناشناخته هست جای خاصی باید تعریف بشه ؟ در ضمن بهتر نیست از رویداد OnMouseDown استفاده نماییم ؟

[salam007]

دوست عزیز این کدی که نوشتی درست کار نمیکنه اگه ممکنه کاملشو بزاری ممنون میشم ...

[Ananas]

منظور از LastMousePos یعنی مکان کروسر هست ؟ LastMousePos در برنامه به عنوان متغییر ناشناخته هست جای خاصی باید تعریف بشه ؟ در ضمن بهتر نیست از رویداد OnMouseDown استفاده نماییم ؟
متغیر ناشناخته نیست بلکه از جنس متغیر هایی است که به شکل const تعریف میشه و با خارج شده از تابع مقدارشو برای دفعه بعد حفظ میکنه یعنی جای قبلی موس و ما مکان فعلی موس رو منهای مکان قبلی می کنیم تا مقدار تغییر رو بدست بیاریم و به اون مقدار ScrollBy کنیم. اون کامپایلر دایرکتیو {+J$} هم برای تعریف متغیر هایی هست که برای دفعه بعد که تابع اجرا میشه مقدار قبلی خودش رو حفظ کنه.
اگه تو MouseDown این کارو انجام بدیم همون موقع که موس فشرده شد یک بار تابع اجرا میشه و تموم! یعنی نمی تونیم دائم با موس جابجا کنیم مگه اینکه تو MouseDown یه حلقه بی پایان بنویسی که هر وقت کلیک موس برداشته شد حلقه break بشه. اون هم فکر خوبی هست. اینم مثالش :


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p0, p1 : TPoint;
begin
if ssLeft in Shift then
begin
GetCursorPos(p0);
while ((GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0) do
begin
GetCursorPos(p1);
ScrollBox1.ScrollBy(p1.X - p0.X, p1.Y - p0.Y);
p0 := p1;
Image1.Update;
end;
end;
end;



دوست عزیز این کدی که نوشتی درست کار نمیکنه اگه ممکنه کاملشو بزاری ممنون میشم ...

چرا ؟ چی ایرادی میگیره؟ درست و کامل کپی کردی؟ چیزی رو جا ننداختی مخصوصا {+J$} رو؟ راستی من برای کلیک چپ موس نوشتم مینونی ssLeft رو به ssRight تغییر بدی و VK_LBUTTON رو به VK_RBUTTON تغییر بدید تا برای کلیک راست کار کنه.
بهر حال کد دومی (MouseDown) فکر کنم بهتر باشه میتونی از اون استفاده کنی.

[mbshareat]

سلام و خدا قوت
کدی که گذاشتین برام جالب بود.
اگه ممکنه لطف کنین کد برای تغییر Position نوارهای لغزنده ScrollBox رو بدون جابجا شدن تصویر بذارین.

[Ananas]

سلام و خدا قوت
کدی که گذاشتین برام جالب بود.
اگه ممکنه لطف کنین کد برای تغییر Position نوارهای لغزنده ScrollBox رو بدون جابجا شدن تصویر بذارین.

متشکر دوست عزیز.
فکر نمی کنم بشه چون نوار های لغزنده به طور اتوماتیکی خودشون تنظیم میشن و نسبت به اینکه چقدر اشیای درونش از کادر زدن بیرون نوارها تنظیم میشن. اصلا این خاصیت ScrollBox هست وگرنه شاید بشه یه Panel بگذاریم و از ScrollBar استفاده کنیم.
البته کدی که من نوشتم همهی اشیای درون ScrollBox رو جابجا میکنه میتونیم بیایم یک شی بزرگ مثل Panel با اندازه چند برابر Imagr به طور ثابت بگذاریم داخل ScrollBox بعد Image رو داخل اون Panel بگذاریم و اونجا تو حلقه MouseDown به جای ScrollBox.ScrollByبنویسیم :

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
p0, p1 : TPoint;
begin
if ssLeft in Shift then
begin
GetCursorPos(p0);
while ((GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0) do
begin
GetCursorPos(p1);
//ScrollBox1.ScrollBy(p1.X - p0.X, p1.Y - p0.Y);
Image1.Left := Image1.Left + p1.X - p0.X;
Image1.Top := Image1.Top + p1.Y - p0.Y;
p0 := p1;
Image1.Update;
end;
end;
end;

و چون Panel تغیر اندازه و جابجایی نداره اون نوار های ScrollBox هم سر جاشون می مونن.

[salam007]

سلام خیلی ممنون و متشکر از کمکتون آناناس جان

یه مشکل اینکه میخام کاربر نتونه کشیدن عکس رو بیش از جایی که چسبیده به لبه های اسکرول باکس ادامه بده یعنی الان شخص اگه با کشیدن ،عکس رو از محدوده اسکرول و دسترسی خودش بیشتر جابجا کنه نمیتونه مجددا به عکس برای جابجایی دسترسی داشته باشه ؟

اگه میشه لطفی کنید اون کد تایمری که باعث حرکت آهسته در پایان کلیک کردن میشه یعنی تصویر یه حرکت آهسته در مخالف جهتی که کشیده شده میکنه و می ایسته رو هم بدید هم کمکی به من هم به خیلی ها که در این زمینه کار میکنن کردید؟

[Ananas]

سلام خیلی ممنون و متشکر از کمکتون آناناس جان

یه مشکل اینکه میخام کاربر نتونه کشیدن عکس رو بیش از جایی که چسبیده به لبه های اسکرول باکس ادامه بده یعنی الان شخص اگه با کشیدن ،عکس رو از محدوده اسکرول و دسترسی خودش بیشتر جابجا کنه نمیتونه مجددا به عکس برای جابجایی دسترسی داشته باشه ؟

اگه میشه لطفی کنید اون کد تایمری که باعث حرکت آهسته در پایان کلیک کردن میشه یعنی تصویر یه حرکت آهسته در مخالف جهتی که کشیده شده میکنه و می ایسته رو هم بدید هم کمکی به من هم به خیلی ها که در این زمینه کار میکنن کردید؟

سلام.
به طرف میگن یه چیزی هست به اسم کامپیوتر هرچی ازش بپرسی جواب میده. طرف میره جلو مانیتور وایمیسه میگه : چه خبر! کامپیوتره خودشو هلاک میکنه هر چی اطلاعات داشته لیست میکنه میریزه بیرون در حالی که فن هاش با تمام سرعت کار میکنه یک ساعت بعد که تموم میشه طرف میگه : دیگه چه خبر! دستگاه منفجر میشه:لبخند:
دوستان هم لطف دارن قابل میدونن اینقدر این کد Image رو از من پرسیدن دیگه فکر کنم دفه بعد منفجر شم:لبخند: این یکی دیگه فکر کنم کامل باشه (انشا الله) :

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;
type
TVec2D = record
x, y : Single;
procedure SetVal(x_, y_ : Single);
procedure Avrage(x_, y_ : Single);
end;
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
Timer1: TTimer;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
image1CurrPos : TPoint;
image1Direction : TVec2D;
image1Time : Double;
procedure SetImage1Pos(X, Y : Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TVec2D.SetVal(x_, y_ : Single);
begin
x := x_;
y := y_;
end;
procedure TVec2D.Avrage(x_, y_ : Single);
begin
x := (x + x_) / 2.0;
y := (y + y_) / 2.0;
end;
procedure TForm1.SetImage1Pos(X, Y : Integer);
function Clamp(min, max, val : Integer):Integer;
begin
if val < min then
Result := min
else if val > max then
Result := max
else Result := val;
end;
begin
if Image1.Width > ScrollBox1.ClientWidth then
Image1.Left := Clamp(ScrollBox1.ClientWidth - Image1.Width, 0, X)
else
Image1.Left := Clamp(0, ScrollBox1.ClientWidth - Image1.Width, X);
if Image1.Height > ScrollBox1.ClientHeight then
Image1.Top := Clamp(ScrollBox1.ClientHeight - Image1.Height, 0, Y)
else
Image1.Top := Clamp(0, ScrollBox1.ClientHeight - Image1.Height, Y);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p0, p1, p3 : TPoint;
begin
if ssLeft in Shift then
begin
GetCursorPos(p0);
while ((GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0) do
begin
GetCursorPos(p1);
p3 := Point(p1.X - p0.X, p1.Y - p0.Y);
p0 := Point(Image1.Left + p3.X, Image1.Top + p3.Y);
SetImage1Pos(p0.X, p0.Y);
image1Direction.Avrage(p3.X, p3.Y);
p0 := p1;
Image1.Update;
end;
image1CurrPos := Point(Image1.Left, Image1.Top);
image1Time := 1.0;
Timer1.Enabled := True;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
image1Time := image1Time / 1.25;
if image1Time <= 0.001 then
(Sender as TTimer).Enabled := False
else begin
image1Direction.x := image1Direction.x * (1.0 + image1Time);
image1Direction.y := image1Direction.y * (1.0 + image1Time);
SetImage1Pos(
image1CurrPos.X + Trunc(image1Direction.x),
image1CurrPos.Y + Trunc(image1Direction.y));
Image1.Update;
end;
end;
end.

[salam007]

خیلی متشکر از کمک ،یادمه یه جا خوندم مغز انسان از قویترین ابر رایانه هایی که قراره در آینده بسازن قویتر هست :متفکر: البته خودمم شک کردم :لبخند:

یه چیزی گفتیا که ما دیگه رومون نمیشه سوال کنیم اما یه باره سورسش رو هم میذاشتی که خیالمون راحت بشه :تشویق: در ضمن اگه امکان داره مدت زمانی رو هم که صرف نوشتن این کد کردی رو بگی هم ممنون میشم چون فکر میکنم کار ساده ای نبوده

[Ananas]

خیلی متشکر از کمک ،یادمه یه جا خوندم مغز انسان از قویترین ابر رایانه هایی که قراره در آینده بسازن قویتر هست :متفکر: البته خودمم شک کردم :لبخند:

یه چیزی گفتیا که ما دیگه رومون نمیشه سوال کنیم اما یه باره سورسش رو هم میذاشتی که خیالمون راحت بشه :تشویق: در ضمن اگه امکان داره مدت زمانی رو هم که صرف نوشتن این کد کردی رو بگی هم ممنون میشم چون فکر میکنم کار ساده ای نبوده

بومپ ش خ ش خ ... صدای انفجار بود:لبخند:
سورس چیو ؟ این که کل متن Unit هست فرمشم به این شکل بسازید : یک فرم که توش یک ScrollBox هست که تو ScrollBox هم یک TImage و یک TTimer هم با Interval = 1 هم رو فرم گذاشتم. دو تا اونت داره یکیش که رو MouseDown شی TImage دوبار کلیک کنی خودش برات میسازه و یکی هم روی تایمر دوبار کلیک کنی خدش میره رو محل مورد نظر.
اینم فایلش :
این آدرسا یکین هر کدومو تونستید باز کنید فرقی نداره.
http://uplod.ir/0ejf4r65rvkw/Image_In_ScrollBox.zip.htm
Image_In_ScrollBox.zip - 911.4 Kb (http://uplod.ir/0ejf4r65rvkw/Image_In_ScrollBox.zip.htm)
در مورد زمانش فکر کنم حدودا یه نیم ساعتی علافم کردید:لبخند:.
اگه سوال داشتید بپرسید شوخی کردم .ولی نپرسید چه خبر یا دیگه چه خبر:لبخند: یکمیم خودتون تلاش کنید، هر جا که نتونستید بفهمید سوال بپرسید، دیگه کل کد رو بنویس میشه همون چه خبر.

[salam007]

به طرف میگن گِل میدیمت بیا کوزه گری ، گفت اول شما کوزه رو نشون من بدید تا من بیام کوزه گری :لبخندساده: آقا خیلی ممنون همونطور که میدونی این کدی که شما توی نیم ساعت نوشتی ما باید سالها برای رسیدن بهش زحمت بکشیم و چون الان نیاز بود چاره ای نبود اما در کل حرف شما متین و سنجیده هست

فقط یه چیزی، شما که اینقد زحمت کشیدید حیف نیست که این عکس موقع اسکرول کردن پرش کنه و زیبایی کارتونو ببره زیر سوال !!! بعدم این تایمره در جهت های ضربدری عمل کُندی داره فقط راست و چپ و بالا و پایین میره بعضی وقتا هم نمیره کاش میشد مثل حرکت (فتوشاپ موقعی که زوم هست در حالت Scrubby Zoom) درش آورد یعنی واقعا میشه !!! فتوشاپ یه جوریه که اگه تند بکشید فاصله بیشتری میره اگه آروم بکشید آروم میره و فاصله کمتری رو طی میکنه :ناراحت: الان از خجالت آب میشم :خجالت:

[Ananas]

به طرف میگن گِل میدیمت بیا کوزه گری ، گفت اول شما کوزه رو نشون من بدید تا من بیام کوزه گری :لبخندساده: آقا خیلی ممنون همونطور که میدونی این کدی که شما توی نیم ساعت نوشتی ما باید سالها برای رسیدن بهش زحمت بکشیم و چون الان نیاز بود چاره ای نبود اما در کل حرف شما متین و سنجیده هست

فقط یه چیزی، شما که اینقد زحمت کشیدید حیف نیست که این عکس موقع اسکرول کردن پرش کنه و زیبایی کارتونو ببره زیر سوال !!! بعدم این تایمره در جهت های ضربدری عمل کُندی داره فقط راست و چپ و بالا و پایین میره بعضی وقتا هم نمیره کاش میشد مثل حرکت (فتوشاپ موقعی که زوم هست در حالت Scrubby Zoom) درش آورد یعنی واقعا میشه !!! فتوشاپ یه جوریه که اگه تند بکشید فاصله بیشتری میره اگه آروم بکشید آروم میره و فاصله کمتری رو طی میکنه :ناراحت: الان از خجالت آب میشم :خجالت:
این اشکالی که گفتی رو سیستم من نیست یعنی اینجا درست کار میکنه ولی روی سیستم شما شاید سرعت اجرا با سیستم من فرق میکنه به خاطر همین درست کار نمیکنه. الان من با سرعتی که اونو پرتاب میکنم حرکتشو ادامه میده. ولی :
سه تا نکته:
اول اینکه پر پر زدنشو نتونستم درست کنم و فکر میکنم که دلیلش اینه که ScrollBox این وسط خودشو Update میکنه و نمیگذاره تصویر صاف دیده شه که راهش همون Canvase هست که اول گفتی نمیخوای ازش استفاده کنید.
دوم اینکه Interval تایمرتون رو حتما به 1 تنظیم کنید.
سوم اینکه وقتی تصویر پرتاب میشه اگه در جهتی (x یا y) به دیواره برخورد کنه خوب نمی تونه تو اون جهت به حرکتش ادامه بده (تو فوتو شاپ هم همینطوریه اگه از یک طرف حرکتش محدود بشه اون یکی هنوز به حرکتش ادامه میده) چون ما تابعی نوشتیم که عکس از اسکرول باکس نزنه بیرون.
در کل اشکالاتی داره ولی اگه بخواد مثل فوتوشاپ باشه باید یه برنامه در حد Photoshop بنویسید:لبخند: من که حوصلشو ندارم. اگه بخواید خیلی شاخ و برگ بهش بدید دیگه توابع GDI خیلی مناسب این کارا نیست نمی گم نمیشه ولی برای این کارا ساخته نشده. مثلا باید DirectX یا OpenGL استفاده کنید.
ولی من پیشنهاد می کنم دستی به کد ببرید و تغییری توش بدید و حتما از Canvase استفاده کنید مثلا از TPaiteBox استفاده کنید. درسته من از این جور کدها که با تصویر سر و کار داره بیشتر نوشتم و مثلا نیم ساعته اینو نوشتم ولی اگه یکم کار کنید مخصوصا الان که نمونه هم دارید می تونید اون چیزی رو که می خواید ایجاد کنید. ببینید خوب خیلی کار های دیگه هم هست که برای قشنگ شدنش میشه انجام داد ولی بالاخره همرو که نمی خوای تو همین Image بگنجونی. کسی که میره برای شام خوردن یکی دو پرس بیشتر نمی تونه بخوره دیگه تا یه حدی جا داره هر چند که کلی غذا جلوش بگذارند. حالا این TImage رو اینقدر چیزا میتونی براش بنویسی که آخرش یه فوتوشاپ از توش در بیاد.! چند پرس غذا هم بده به قسمتای دیگه برنامت اینقدر بهش گیر نده.
از توابع Canvase.Draw و BitBlt استفاده کنید می تونید روی Panel هم عکستونو نمایش بدید.
خوب با BitBlt یکم درستش کردم اینم کدش : (فقط بجای اسکرول از TPanel استفاده کنید، خیلی از اشکالاتش هم رفع شده)

(******************************
* *
* Besmellaherrahmanerraheam *
* *
* MHD_1390 *
******************************)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;
type
TVec2D = record
x, y : Single;
procedure SetVal(x_, y_ : Single);
procedure Avrage(x_, y_ : Single);
end;
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
Panel1: TPanel;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
image1CurrPos : TPoint;
image1Direction : TVec2D;
image1MoveVec2D : TVec2D;
image1Time : Double;
image1Bitm : TBitmap;
procedure SetImage1Pos(X, Y : Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TVec2D.SetVal(x_, y_ : Single);
begin
x := x_;
y := y_;
end;
procedure TVec2D.Avrage(x_, y_ : Single);
begin
x := (x * 4 + x_) / 5.0;
y := (y * 4 + y_) / 5.0;
end;
procedure TForm1.SetImage1Pos(X, Y : Integer);
function Clamp(min, max, val : Integer):Integer;
begin
if val < min then
Result := min
else if val > max then
Result := max
else Result := val;
end;
begin
if Image1.Width > Image1.Parent.ClientWidth then
Image1.Left := Clamp(Image1.Parent.ClientWidth - Image1.Width, 0, X)
else
Image1.Left := Clamp(0, Image1.Parent.ClientWidth - Image1.Width, X);
if Image1.Height > Image1.Parent.ClientHeight then
Image1.Top := Clamp(Image1.Parent.ClientHeight - Image1.Height, 0, Y)
else
Image1.Top := Clamp(0, Image1.Parent.ClientHeight - Image1.Height, Y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetImage1Pos(Image1.Left, Image1.Top);
image1Bitm := TBitmap.Create;
image1Bitm.SetSize(Image1.Width, Image1.Height);
image1Bitm.Canvas.StretchDraw(Rect(0, 0, Image1.Width, Image1.Height), Image1.Picture.Graphic);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p0, p1, p3 : TPoint;
dc : HDC;
begin
if ssLeft in Shift then
begin
GetCursorPos(p0);
while ((GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0) do
begin
GetCursorPos(p1);
p3 := Point(p1.X - p0.X, p1.Y - p0.Y);
p0 := Point(Image1.Left + p3.X, Image1.Top + p3.Y);
BitBlt(GetDC(Image1.Parent.Handle), Image1.Left, Image1.Top,
Image1.Width,
Image1.Height,
image1Bitm.Canvas.Handle, 0, 0, SRCCOPY);
SetImage1Pos(p0.X, p0.Y);
image1Direction.Avrage(p3.X, p3.Y);
p0 := p1;
Image1.Update;
end;
image1MoveVec2D := image1Direction;
image1CurrPos := Point(Image1.Left, Image1.Top);
image1Time := Now * 24 * 60 * 60;
Timer1.Interval := 1;
Timer1.Enabled := True;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
d : Double;
begin
d := Now * 24 * 60 * 60 - image1Time;
if (d > 1.0) then
(Sender as TTimer).Enabled := False
else begin
d := d + 0.1;
image1MoveVec2D.x := image1MoveVec2D.x + image1Direction.x / d;
image1MoveVec2D.y := image1MoveVec2D.y + image1Direction.y / d;
SetImage1Pos(
image1CurrPos.X + Trunc(image1MoveVec2D.x),
image1CurrPos.Y + Trunc(image1MoveVec2D.y));
Image1.Update;
end;
end;
end.

[salam007]

روم به دیوار :لبخند:

من از اسکرول استفاده میکنم چون یکسری اشیا روی عکس قرار میگیرند مثل پنل و ... که با حرکت عکس میخام حرکت کنند اگه میشه این کد آخریه با همین اسکرول باکس باشه یا اگه پنل یا اون Canvase هم باشه در صورتی که خاصیت اسکرول رو داشته باشه اشکالی نداره ،بعد برا اینکه مشکل برخورد کنارشم در اسکرول باکس حل بشه فکر کنم بتونیم تا یه حدی هم صفحه خالی نشون بدیم البته تا جایی که عکس از دید خارج نشه ، این پرش عکس هیچ راهی نداره با این کد اسکرول ؟

[Ananas]

من این کد رو جوری نوشتم که از Image1.Parent استفاده کردم برای اینکه اگه اسکرول باشه یا panel باشه فرقی نداره. حالا شما می تونی اسکرول هم بگذاری ولی من امتحان کردم دیدم پر پر میزنه. فکر کنم همون اشیا رو بتونی تو Panel هم استفاده کنی وقتی کاربر ویتونه عکس رو با موس جابجا کنه دیگه چه نیازی به اسکرول داره؟
برای محدوده حرکتیش هم ورودی های تابع Clamp رو به اضافه و یا منهای یک عددی کن. تابع Clamp عدد رو در یک بازه min تا max محدود میکنه پس کافیه min و max رو تغییر بدی.


procedure TForm1.SetImage1Pos(X, Y : Integer);
function Clamp(min, max, val : Integer):Integer;
begin
if val < min then
Result := min
else if val > max then
Result := max
else Result := val;
end;
begin
if Image1.Width > Image1.Parent.ClientWidth then
Image1.Left := Clamp(Image1.Parent.Width div 2 - Image1.Width, Image1.Parent.Width div 2, X)
else
Image1.Left := Clamp(-Image1.Width div 2, Image1.Parent.ClientWidth - Image1.Width div 2, X);
if Image1.Height > Image1.Parent.ClientHeight then
Image1.Top := Clamp(Image1.Parent.Height div 2 - Image1.Height, Image1.Parent.Height div 2, Y)
else
Image1.Top := Clamp(-Image1.Height div 2, Image1.Parent.ClientHeight - Image1.Height div 2, Y);
end;

[Ananas]

چون دوست عزیزمون تو پیغام خصوصی خیلی اسرار کردن که کد رو اصلاح کنم ورداشتم کلا یک یونیت جدا برای این کار ساختم و کافیه تو برنامه اصلی دو سه خط کد برای مقدار اولیه دادن به کلاس مورد نظر نوشته بشه.
با این کد دیگه Image پر-پر نمی زنه و Image رو هم تو هر چیزی که می خواید می تونید بگذارید و به ساختن تایمر هم نیازی نیست چون کلاس مورد نظر خودش اون رو میسازه.
مراحل کار:
1 - این یونیت رو به پروژه تون لینک کنید:

(******************************
* *
* Besmellaherrahmanerraheam *
* *
* ImageMover_Unit *
* *
* MHD_1390 *
* *
******************************)
unit ImageMover_Unit;
interface
uses
Windows, SysUtils, Classes, Controls, Forms, ExtCtrls;
const
MOVE2D_LISTCOUNT_DEFAULT = 6;
MUL_24_60_60 = 24 * 60 * 60;
type
TVec2D = packed record
x, y : Single;
procedure SetVal(x_, y_ : Single);
function Length: Single;
end;
TMove2DList = class
VecCount : Integer;
function GetVecCount : Integer;
procedure SetVecCount(count_ :Integer);
public
Vectors : array of TVec2D;
property VectorCount : Integer read GetVecCount write SetVecCount;
procedure ResetList;
procedure UpdateBy(const x_, y_ : Single);
function GetMoveValue:TVec2D;
constructor Create(vecCount_ : Integer = MOVE2D_LISTCOUNT_DEFAULT);
end;
PTImage = ^TImage;
TImageMover = class
procedure TimerTimer(Sender: TObject);
public
CurrPos : TVec2D;
Direction : TVec2D;
TimeVal : Double;
Move2DList : TMove2DList;
PImage : PTImage;
Timer : TTimer;
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetImagePos(X, Y : Integer);
constructor Create(PImage_ : PTImage;
vecCount_ : Integer = MOVE2D_LISTCOUNT_DEFAULT;
Set_ImageMoseDown : Boolean = True);
end;
function Vec2D(x_, y_ : Single):TVec2D;
implementation
(***************************
* *
* TVec2D *
* *
***************************)
function Vec2D(x_, y_ : Single):TVec2D;
begin
Result.x := x_;
Result.y := y_;
end;
procedure TVec2D.SetVal(x_, y_ : Single);
begin
x := x_;
y := y_;
end;
function TVec2D.Length: Single;
begin
Result := Sqrt(x * x + y * y);
end;
(***************************
* *
* TMove2DList *
* *
***************************)
function TMove2DList.GetVecCount : Integer;
begin
Result := VecCount;
end;
procedure TMove2DList.SetVecCount(count_ :Integer);
var
I, J: Integer;
begin
if VecCount = count_ then
Exit;
VecCount := count_;
if VecCount < 1 then
VecCount := 1;
J := Length(Vectors);
if J > VecCount then
begin
for I := 0 to VecCount - 1 do
Vectors[i] := Vectors[i + J - VecCount];
SetLength(Vectors, VecCount);
end else if J > 0 then begin
SetLength(Vectors, VecCount);
for I := 0 to J - 1 do
begin
Vectors[VecCount - J + I] := Vectors[I];
end;
for I := 0 to VecCount - J - 1 do
Vectors[I].SetVal(0.0, 0.0);
end else
SetLength(Vectors, VecCount);
end;
procedure TMove2DList.ResetList;
var
I: Integer;
begin
for I := 0 to VecCount - 1 do
Vectors[i].SetVal(0.0, 0.0);
end;
procedure TMove2DList.UpdateBy(const x_, y_ : Single);
var
I: Integer;
begin
for I := 1 to VecCount - 1 do
begin
Vectors[I - 1] := Vectors[I];
end;
Vectors[VecCount - 1].SetVal(x_, y_);
end;
function TMove2DList.GetMoveValue:TVec2D;
var
I: Integer;
begin
Result.SetVal(0.0, 0.0);
for I := 0 to VecCount - 1 do
begin
Result.x := Result.x + Vectors[I].x;
Result.y := Result.y + Vectors[I].y;
end;
end;
constructor TMove2DList.Create(vecCount_ : Integer = MOVE2D_LISTCOUNT_DEFAULT);
begin
VecCount := 0;
VectorCount := vecCount_;
end;
(***************************
* *
* TImageMover *
* *
***************************)
procedure TImageMover.SetImagePos(X, Y : Integer);
function Clamp(min, max, val : Integer):Integer;
begin
if val < min then
Result := min
else if val > max then
Result := max
else Result := val;
end;
var
p : TPoint;
begin
if PImage^.Width > PImage^.Parent.ClientWidth then
p.X := Clamp(PImage^.Parent.Width div 2 - PImage^.Width, PImage^.Parent.Width div 2, X)
else
p.X := Clamp(-PImage^.Width div 2, PImage^.Parent.ClientWidth - PImage^.Width div 2, X);
if PImage^.Height > PImage^.Parent.ClientHeight then
p.Y := Clamp(PImage^.Parent.Height div 2 - PImage^.Height, PImage^.Parent.Height div 2, Y)
else
p.Y := Clamp(-PImage^.Height div 2, PImage^.Parent.ClientHeight - PImage^.Height div 2, Y);
p := Point(p.X - PImage^.Left, p.Y - PImage^.Top);
PImage^.Parent.ScrollBy(p.X, p.Y);
end;
procedure TImageMover.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p0, p1, p3 : TPoint;
begin
if ssLeft in Shift then
begin
GetCursorPos(p0);
Move2DList.ResetList;
while ((GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0) do
begin
GetCursorPos(p1);
p3 := Point(p1.X - p0.X, p1.Y - p0.Y);
p0 := Point(PImage^.Left + p3.X, PImage^.Top + p3.Y);
SetImagePos(p0.X, p0.Y);
if (p3.X <> 0) and (p3.Y <> 0) then
Move2DList.UpdateBy(p3.X, p3.Y);
p0 := p1;
PImage^.Update;
end;
Direction := Move2DList.GetMoveValue;
Direction.x := Direction.x / Move2DList.VecCount;
Direction.y := Direction.y / Move2DList.VecCount;
CurrPos := Vec2D(PImage^.Left, PImage^.Top);
TimeVal := Now * MUL_24_60_60;
Timer.Interval := 1;
Timer.Enabled := True;
end;
end;
procedure TImageMover.TimerTimer(Sender: TObject);
var
d : Double;
begin
d := Now * (MUL_24_60_60) - TimeVal;
if (d > 1.0) then
(Sender as TTimer).Enabled := False
else begin
d := 1.0 + d;
CurrPos.x := CurrPos.x + Direction.x / d;
CurrPos.y := CurrPos.y + Direction.y / d;
SetImagePos(
Trunc(CurrPos.x),
Trunc(CurrPos.y));
PImage^.Update;
end;
end;
constructor TImageMover.Create(PImage_ : PTImage;
vecCount_ : Integer = MOVE2D_LISTCOUNT_DEFAULT;
Set_ImageMoseDown : Boolean = True);
begin
Self.PImage := PImage_;
Self.Timer := TTimer.Create(nil);
Timer.Enabled := False;
Timer.Interval := 1;
Move2DList := TMove2DList.Create(vecCount_);
SetImagePos(PImage^.Left, PImage^.Top);
if Set_ImageMoseMove then
PImage_.OnMouseDown := ImageMouseDown;
Timer.OnTimer := TimerTimer;
if PImage_ = nil then
MessageBox(0, 'Error : TImage is nil!', 'MHD_ImageMover_1390', MB_OK);
end;
end.

2 - یک متغیر به این شکل تعریف کنید (می تونید این کا رو در قسمت Public فورمتون انجام بدید) :

Image1Mover : TImageMover;

3 - متغر مورد نظر رو به این شکل در قسمت Form.Create مقداد دهی کنید :

Image1Mover := TImageMover.Create(@Image1);

4 - این مرحله اختیاری هست و برای راحتی کاربر و بهتر شدن هست. OnMouseDown شی Image رو به ScrollBox و یا به Panel می دهیم به این شکل :

ScrollBox1.OnMouseDown := Image1.OnMouseDown;

5 - حالشو ببرید. تمام.
______________________________
نکته :

تابع TImageMover.Create به شکل زیر تعریف شده :

constructor TImageMover.Create(PImage_ : PTImage;
vecCount_ : Integer = MOVE2D_LISTCOUNT_DEFAULT;
Set_ImageMoseDown : Boolean = True);

که سه پارامتر ورودی دارد:
1 - PImage_ اشاره گری به Image ای هست که می خواید با کلاس همراه بشه. و اگه بیشتر از یک Image و اسکرول باکس دارید برای هر کدام باید یک شی TImageMover داشته باشیم.
2 - vecCount_ طول آرایه ای را مشخص می کنه که حرکات موس رو ذخیره میکنه و در آخر میانگین اونها رو برای سر خوردن Image به Timer تحویل میده. این کار برای اینه که مطمئن باشیم جهت حرکت موس با بیشتر از تعداد vecCount_ پکسل مشخص میشه. اون رو به مقدار ثابت MOVE2D_LISTCOUNT_DEFAULT که در قسمت const تعریف کردم تنظیم کنید.
3 - Set_ImageMoseDown یک مقدار Boolean هست که تعیین میکنه موقع ساخت شی، اونت OnMouseDown شی Image برابر ImageMouseDown از شی TImageMover بشه یا مقدار قبلی خودش رو حفظ کنه. اگر برای شی Image تون تابع OnMouseDown رو تعریف نکردید با خیال راحت این مقدار رو به True (حالت پیش فرض) تنظیم کنید. و اگر نمی خواید OnMouseDown شی Image تون از بین بره، می تونید Set_ImageMoseDown رو برابر False قرار بدید و تو قسمت OnMouseDown شی Image خودتون تابع Image1Mover.ImageMouseDown رو هم فراخونی کنید. مثال :


procedure TForm1.FormCreate(Sender: TObject);
begin
Image1Mover := TImageMover.Create(@Image1, MOVE2D_LISTCOUNT_DEFAULT, False);
ScrollBox1.OnMouseDown := Image1.OnMouseDown;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{
...
...
...
}
Image1Mover.ImageMouseDown(Sender, Button, Shift, X, Y);
end;

[salam007]

سلام
احسنت به شما به دلیل اخلاق حرفه ای در کار خود و احسنت به شما که واقعا در کار خود استادید ، فوق العاده متشکر واقعا دل ما رو شاد کردید ، وقتی موسم رو حرکت میدم اینقدر دلپذیره که انگار دارم شکلات هم میزنم :لبخند:

در مرحله 4 منظور اینه که اگه مثلا یک Panel روی ایمیج قرار داشت کاربر با کلیک روی اون هم بتونه عکس رو جابجا کنه ؟ اگه نه آیا چنین امکانه هست ؟

[salam007]

این هم سورس و فایل اجرایی این پروژه که با زحمتهای دوست عزیز ما تهیه شده است

http://www.4shared.com/rar/p8sKWEcA/final_image_scroll.html

[Ananas]

سلام
احسنت به شما به دلیل اخلاق حرفه ای در کار خود و احسنت به شما که واقعا در کار خود استادید ، فوق العاده متشکر واقعا دل ما رو شاد کردید ، وقتی موسم رو حرکت میدم اینقدر دلپذیره که انگار دارم شکلات هم میزنم :لبخند:

در مرحله 4 منظور اینه که اگه مثلا یک Panel روی ایمیج قرار داشت کاربر با کلیک روی اون هم بتونه عکس رو جابجا کنه ؟ اگه نه آیا چنین امکانه هست ؟
لطف دارید ممنون.
بله. تو مرحله 4 چون Image اطرافش خالی هست و می خوایم که کاربر اگه روی قسمت بکگراند ایمیج کلیک کرد هم حرکت انجام شه. برای هر شی مشابه هم میشه این کارو کرد. درون کلاس TImageMover یک تابع به اسم ImageMouseDown تعریف شده که اون رو می تونید به هر شی ای که خاصیت OnMouseDown داره نسبت بدید مثل مرحله 4. و این تابع تقریبا همان تابعی هست که تو پست های قبلی برای Image.OnMouseDown تعریف می کردیم حالا دیگه مثل یک متغیر می تونیم اون رو به شی Panel و یا ScrollBox و غیره نسبت بدیم به همون روش مرحله 4.