روش زوم و زوم اوت کردن عکس مثل اتوران مجموعه لرد

سلام دوستان

میخواستم اگر کسی از دوستان روش زوم و زوم اوت مثل اتوران مجموعه لورد میدونه ممنون میشم راهنمایی کنه


یا علی (ع)

سلام
به نظرم بهتره از دو ای پی آی bitblt و strechblt hsjthni (نمی دونم اسماشونو درست نوشتم یا نه) استفاده کنی
و یا از متد paintpicture پیکچر باکس

ممنون از جوابتون
نمونه سورسی ندارید بزارید اینجا . ممنون میشم


یا علی(ع)

این یه برنامه زوم روی عکس هستش امتحانش ضرری نداره :

ممنون از شما . ولی یکی مثل این اما از مال شما کاملتر داشتم . اگه رو عنوان تاپیک توجه کرده باشید من میخوام زوم و زوم اوت داشته باشه (بزرگنمایی و کوچکنمایی ) مثل اتوران مجموعه لورد


یا علی (ع)

یکی از دوستان منو راهنمایی نمیکنه؟

سلام
چقدر کم صبری شما!
من چند سال پیش چند تا سوال پرسیدم هنوز امیدوارم یکی جوابش بده!
بفرما:
شما يه فرم بساز و روش دو تا پيکچر باکس به نام هاي picture1 و picture2 قرار بده و عکس مورد نظرتو بنداز رو يکچر1.
حالا يه اسکرول بار مثلا با مين 50 و ماکس 200 و وليوي 100 به اسم VScroll1 بذار رو فرمت. حالا اين کد رو بنويس:

Private Sub VScroll1_Change()

If VScroll1.Value < 100 Then Picture2.Cls

x = Picture1.Width * VScroll1.Value / 100

y = Picture1.Height * VScroll1.Value / 100

Picture2.PaintPicture Picture1.Picture, 0, 0, x, y, 0, 0, Picture2.Width, Picture2.Height

End Sub



Private Sub VScroll1_Scroll()

VScroll1_Change

End Sub

اون if فقط برا پرش کمتره و کار خاصي نميکنه
در ضمن برا بالا و پايين و چپ و راست بردن تصوير زوم شده هم بايد آرگومان هاي 6 و 7 تابع paintpicture‌ رو زياد و کم کني

ممنون از لطف شما
ولی سه تا مشکل داره :
1- اگه توجه کرده باشید اتوران مجموعه لرد وقتی عکس رو کوچک میکنه در وسط فرم قرار میده عکس رو ولی این روش عکس رو در سمت چپ قسمت بالا پیکچر باکس قرار میده
2- من کد رو به این تغییر دادم :

Private Sub VScroll1_Change()

If VScroll1.Value < 100 Then Picture2.Cls

x = Picture1.Width * VScroll1.Value / 1000

y = Picture1.Height * VScroll1.Value / 1000

Picture2.PaintPicture Picture1.Picture, 0, 0, x, y, 0, 0, Picture2.Width, Picture2.Height

End Sub

 

Private Sub VScroll1_Scroll()

VScroll1_Change

End Sub

اما عکس رو زشت میکنه :
ضمیمه 83643

3- وقتی اسکرول بار رو به اول ( نقطه سفر میکشی به این کد گیر میده و خطا میده :

Picture2.PaintPicture Picture1.Picture, 0, 0, x, y, 0, 0, Picture2.Width, Picture2.Height

عکس خطا :
ضمیمه 83644

ممنون میشم راهنمایم کنید:قلب:


یا علی (ع)

1- گفتم که، باید رو آرگومان های 6 و 7 اون تابع برای تعیین نقطه شروع رسم تصویر کار کنی. اونا رو کم و زیاد کن، حساب کار دستت میاد.
2-خب بدیهیه. شما باید تو خط دوم کد هم بجای 100، هزار و قرار بدی
اصلا اون خط دوم میاد بررسی میکنه که اگه تصویر جدید بخشی از محدوده تصویر قدیم رو پوشش نمیده، تصویر قبلی پیکچر باکس رو پاک میکنه. که البته میشه اون دستور IF رو بهینش کرد.
یا اگه پرش تصویر برات مهم نیست کلا if رو حذف کن و بذار هر سر ی دستور جلوی if اجرا بشه.
3-فکر کنم مشکلت بخاطر اینه که مقدار x و y که در حقیقت اندازه تصویرمون هست صفر میشه که طبیعیه خطا بده.
شما مقدار min‌ اسکرولت رو یه مقداری بیشتر از صفر قرار بده.

واقعا ممنون
سوالات 2 حل شد ولی سوال 1 و 3 هرکاری کردم درست نشد . اینم سورس زحمت بکشید مشاهده کنید ببینید کچاش مشکله

ممنونم


یا علی (ع)

بفرما

Private Sub VScroll1_Change()

Me.Cls

x = Picture1.Width * VScroll1.Value / 1000

y = Picture1.Height * VScroll1.Value / 1000

If x < Screen.TwipsPerPixelX Then x = Screen.TwipsPerPixelX

If y < Screen.TwipsPerPixelY Then y = Screen.TwipsPerPixelY

X1 = (Me.Width - x) / 2

Me.PaintPicture Picture1.Picture, X1, 1000, x, y

End Sub