نوشته 90 درجه در VB6

[Mohsen0025]

با سلام و خسته نباشید خدمت شما اساتید بزرگوار :چشمک:
یک سوال داشتم!
آیا میشه تو VB6 نوشته های فارسی رو به صورت 90 درجه(عمودی) نوشت؟ اگه میشه خواهش میکنم کمک کنید.و آیا کدی هست که به هنگام چاپ کردن اون فرم پس زمینه فرم خودمون چاپ نشه؟ به این صورت که ما یه کاغذ داریم که از پیش چند تا مورد خودش داخلش پر هست حالا ما میخواهیم که برگه ای که چاپ میشه رنگ بندی فرم (رنگ پس زمینه) رو برگه چاپ نشه !!! ممنونم
با تشکر فراوان
به خدا خیلی احتیاجش دارم
ممنون میشم
یا اینکه اگه نشد صفحه را در هنگام چاپ به صورت عمودی در آوریم و برگه ای که چاپ می شود به صورت عمودی چاپ شوند!!
با تشکر

[سید حمید حق پرست]

سلام علیکم
نمونه سورس برای چرخش label ضمیمه کردم،
برای چرخش خود textbox چیزی پیدا نکردم اما میشه متن textbox داخل picturebox چرخاند.
برای چاپ میخواید متن داخل یک textbox یا label چاپ کنید فقط؟ درست متوجه نشدم چیکار میخواید انجام بدید.
موفق باشید.

یا علی (ع)

[m.4.r.m]

Option Explicit

Private Const LF_FACESIZE = 32

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * LF_FACESIZE
End Type

Private Type DOCINFO
cbSize As Long
lpszDocName As String
lpszOutput As String
lpszDatatype As String
fwType As Long
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _
As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal lpString As String, ByVal nCount As Long) As Long ' or Boolean

Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
(ByVal hdc As Long, lpdi As DOCINFO) As Long

Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) _
As Long

Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) _
As Long

Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) _
As Long

Const DESIREDFONTSIZE = 12 ' Could use variable, TextBox, etc.





Private Sub Command2_Click()
' Print using API calls only
Dim OutString As String 'String to be rotated
Dim lf As LOGFONT 'Structure for setting up rotated font
Dim temp As String 'Temp string var
Dim result As Long 'Return value for calling API functions
Dim hOldfont As Long 'Hold old font information
Dim hPrintDc As Long 'Handle to printer dc
Dim hFont As Long 'Handle to new Font
Dim di As DOCINFO 'Structure for Print Document info

OutString = "Hello , Wlcome To Barnamenevis.org !" 'Set string to be rotated

' Set rotation in tenths of a degree, i.e., 1800 = 180 degrees
lf.lfEscapement = -900
lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
hFont = CreateFontIndirect(lf) 'Create the rotated font
di.cbSize = 20 ' Size of DOCINFO structure
di.lpszDocName = "My Document" ' Set name of print job (Optional)

' Create a printer device context
hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

result = StartDoc(hPrintDc, di) 'Start a new print document
result = StartPage(hPrintDc) 'Start a new page

' Select our rotated font structure and save previous font info
hOldfont = SelectObject(hPrintDc, hFont)

' Send rotated text to printer, starting at location 1000, 1000
result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

' Reset font back to original, non-rotated
result = SelectObject(hPrintDc, hOldfont)

' Send non-rotated text to printer at same page location
result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

result = EndPage(hPrintDc) 'End the page
result = EndDoc(hPrintDc) 'End the print job
result = DeleteDC(hPrintDc) 'Delete the printer device context
result = DeleteObject(hFont) 'Delete the font object
End Sub

[Mohsen0025]

سلام
آقای m.4.r.m دمت گرم واقعاً مر30
همون چیزی بود که خواستم
حالا اگه بخوای مثلاً 10 تا مقدار رو چاپ کنه و مثلاً تو label فونتش Bold هستش (هر خاصیتی که label داشت) چاپ کنه چکار باید کرد؟
ممنونم به خاطر جوابتون
خداییش دمتون گرم

[m.4.r.m]

میتونی از آرایه استفاده کنی رشته هارو تو آرایه بگیری و با یک حلقه همه رو چاپ کنی

[Mohsen0025]

سلام هر کاری کردم نشد:عصبانی++:
اگه میشه یک مثال بزنید و یا اگه میشه اون آرایه OutString حذف بشه و بتونیم خودمون چیزایی که تعیین میکنیم مثلاً label1,label2,label3,.... رو چاپ کنه و یا اصلاً کل فرم رو در هنگام چاپ 90 درجه کنه(عمودی) و بعد چاپ کنه!!! تابشه labelها اگه با هون چیزی که میخوایم set نشد اونارو جابه جا کنه کاربر
تشکر
ممنونم از تون

[nazanin_90]

سلام
با تشکر از جناب m.4.r.m
در صورت امکان کدهای فوق را در قالب یک نمونه برای عمودی نشان دان یک لیبل یا تکست باکس بر روی فرم ارائه نمائید.
با تشکر فراوان

[Mohsen0025]

سلام
با تشکر از جناب m.4.r.m
در صورت امکان کدهای فوق را در قالب یک نمونه برای عمودی نشان دان یک لیبل یا تکست باکس بر روی فرم ارائه نمائید.
با تشکر فراوان

خسته نباشین
آقا اگه کسی بلده خواهش می کنم جواب بده
ممنون

[vbhamed]

سلام
خب چرا اينقدر سخت مي‌كنيد كارتون رو، براي چي از گزارشگرها مثل Crystal Report و ... استفاده نمي‌كنيد كه مخصوص اينطور كارها هستن ؟

[Mohsen0025]

خب چرا اينقدر سخت مي‌كنيد كارتون رو، براي چي از گزارشگرها مثل Crystal Report و ... استفاده نمي‌كنيد كه مخصوص اينطور كارها هستن ؟

سلام
دوست عزیز من زیاد با کریستال کار نکردم،بعد گفتم ببینم میشه که با کدنویسی این کار رو کرد؟چون برای متون انگلیسی میشه و الانم با کد بالا برای متون فارسی میشه اما من گفتم ببینم میشه مثلاً چند تا label رو تو فرم و یا.... رو چاپ کرد به صورت 90 درجه یا نه؟
اگه کسی بلده لطف کنه بگه ممنون میشم!!
با تشکر

[m.4.r.m]

سلام
خب چرا اينقدر سخت مي‌كنيد كارتون رو، براي چي از گزارشگرها مثل Crystal Report و ... استفاده نمي‌كنيد كه مخصوص اينطور كارها هستن ؟

آخ راست میگه حامد عزیز با اینا هم می تونید همین کارو بکنید ها خیلی راحت

[m.4.r.m]

خدایی تشکر لازم نیست کردین هم ممنون :لبخندساده:
یک OCX برای این کار

[Mohsen0025]

ممنون ولی این زبان فارسی رو Suport نمیکنه وگرنه چیز خوبیه!!!
بعد همون کد اولی که دادین نمیشه کاری کنیم که چند تا label رو چاپ کنه؟؟؟ اگه همون اولی راستو ریست شه خداییش خیلی عالی میشه!!
فداتون
تشکر فراوان

[m.4.r.m]

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

[vbhamed]

سلام
دوست عزیز من زیاد با کریستال کار نکردم،بعد گفتم ببینم میشه که با کدنویسی این کار رو کرد؟چون برای متون انگلیسی میشه و الانم با کد بالا برای متون فارسی میشه اما من گفتم ببینم میشه مثلاً چند تا label رو تو فرم و یا.... رو چاپ کرد به صورت 90 درجه یا نه؟
اگه کسی بلده لطف کنه بگه ممنون میشم!!
با تشکر

سلام
خب اين كه دليل نشد، شما داريد با وي بي برنامه مي‌نويسيد اونوقت فكر مي‌كنيد كار كردن با كريستال كار سختيه ؟
وقتي باهاش كار كنيد مي‌بينيد كه چقدر تا حالا وقتتون تلف شده بوده، هر چه زودتر بريد سراغش، مثل آب خوردنه

[Mohsen0025]

دمت گرم آقای m.4.r.m خداییش گل کاشتی
برای چاپ چک میخواستم از این روش استفاده کنم
اگه رو label بود خیلی بهتر بود!!چون الان داده ها رو میگیره و رو فرم چاپ میکنه و در هنگام چاپ تار میشه!!! و اون تنظیماتی که باب دل باشه نمیشه روش انجام داد!!

[Mohsen0025]

عرض ادب مجدد
تو این حالت اگه طول جمله ها زیاد باشن تمامی تنظیم ها به هم میخورن !!!!
نمیشه کاری کرد که تنظیم ها ثابت بشن!!! یا labelها رو چرخوند؟؟؟ یعنی هیچ راهی نداره که label ها رو چرخوند؟

[m.4.r.m]

شما چرا چک رو بر عکس می نویسی ؟ چک رو به صورت افقی تایپ کن وقتی چک رو میزاری تو پرینتر هم به صورت افقی بزار نه عمودی میشه همون آش و همون دوغ چرا لقمه رو دور سرت می چرخونی ؟

[m.4.r.m]

تو برنامه آخری که بهتون دادم این کد ها رو به این صورت عوض کنید :

RotateText Picture1.hDC, Persian, Picture1.Font, RGB(0, 192, 0), vbCenter, True, 50, 200, 90

یک Picture1 بزار رو فرم رنگشو سفید کن حاشیه هاشو بردار و به صورت فلت در بیار و مقدار AutoRedraw رو برابر True کن نوشته شما مثله لیبل در Picture1 قرار میگیره برای هر نوشته یک Pciture بزار مشکلت حل بشه

[Mohsen0025]

مرسی از جوابت ولی چک رو اگه افقی بزاری داخل پرینتر گیر میکنه!!!یعنی میره داخل پرینتر و دیگه بیرون نمیاد!!!! نگه اینکه یک برگه اضافی بهش بچسپونی که با توجه به حجم کاری این کار امکان پذیر نیست پس باید عمودی باشه!!!
با Picture box خودم قبلش امتحان کردم ولی بازم آش همون آشه و کاسه هم همون کاسه با این تفاوت که میشه دیگه این pictureboxها رو تو صفحه جابه جا کرد(به وسیله موس)....(در روش قبل باید اعداد رو دسکاری میکردی)
به خاطر این میگم label چون اگه چک رو چاپ کنی رنگ label رو برگه نمیمونه ولی در pictureوform رنگ سفیدی یا.... رو چک میفته و چک رو خراب میکنه!!! :ناراحت:

[m.4.r.m]

والله دوست عزیز چون لیبل عنصری به اسم CurentX,Y نداره یا Scalheight , Width نداره امکان چرخش لیبل وجود نداره من که هر کاری کردم نشد فقط راهش همینه یا که از VB.net استفاده کنی که امکاناتش زیاده بضاعت ویبی 6 همینه دیگه :بامزه:

یا از OCX استفاده کنی که بهت دادم اونم با unicode مشکل داره که می تونی مشکل یونی کد رو با توابع برطرف کننده یونید فکر کنم حل کنی . بهترین مورد همون OCX هست بگرد برای حل مشکل یونیکدش . همین.

[Mohsen0025]

با VB2010 نمیشه؟ این کارو کرد؟
بخدا خیلی گشتم اون OCX که بهم دادی بخدا حتی سورسشم پیدا کردم ولی اینقد پروژه دانلود کردم که نا خدا حذفش کردم:ناراحت: ولی چیزی پیدا نکردم یعنی پیدا کردما اما فارسی رو support نمی کردن:ناراحت:

[vbhamed]

سلام
روش نوشتن مستقيم در چاپگر رو تست كن
With Printer
.Orientation = 2
.ScaleMode = 6
.Font.Name = "Tahoma"
.Font.Size = 14
'Left and Top in mm
.CurrentX = 10: .CurrentY = 10: Printer.Print "1392/10/10 - دهم ديماه نود و دو"
.CurrentX = 10: .CurrentY = 20: Printer.Print "در وجه آقاي نمونه"
.CurrentX = 95: .CurrentY = 20: Printer.Print "Test"
.CurrentX = 10: .CurrentY = 30: Printer.Print "3,680,000 ريال"
.EndDoc
End With

[Mohsen0025]

سلام
نشد:افسرده:
یعنی برگه چک کوچیکه (طولش حدوداً اندازه A5 و عرضش حدود 5سانته) نشد:گریه:
برنامه FastReports رو دان کردم بازم بلد نبودم :ناراحت:
نمیدونم چیکار کنم :اشتباه:

[vbhamed]

سلام
كوچك بودن برگه چك اهميتي نداره، شما مختصات دلخواه رو ميدين
در مورد fastReport هم فيلدهايي كه روي صفحه ميزاريد يك خاصيت دارن به نام Rotation كه مي‌تونيد روي 90 يا 270 درجه بزاريد

[Mohsen0025]

تشکر
دیدم ولی بلد نیستم که داده ها رو چطور از VB به fastreport بفرستم:افسرده:

كوچك بودن برگه چك اهميتي نداره، شما مختصات دلخواه رو ميدين
هر مشخصاتی رو دادم نمیشد:عصبانی++:
ممنونم حامدجان

[m.4.r.m]

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

این کار با ساده ترین شکل ممکن توی کریستال ریپورت انجام میشه بدون هیچ دغدغه ای اون تو عرض نیم ساعت نمی دونم گیر دادی به خود وی بی علتش چیه آموزش اتصال وی بی به کریستالم تا دلت بخواد تو سایت و گوگل پره . یه همتی کنی عمو همش که سوال نمیشه

[Mohsen0025]

اون بالا هم گفتم فقط یه برنامه چک سادس که حدود 200KB فوقش حجم داشته باشه اما کریستال حدود 200MB حجم داره، تا حالام کار نکردم ولی مثل اینکه باید کار کنم
تو VB2010هم مثل اینکه نمیشه!!
تشکرات

[vbhamed]

سلام
اول اينكه حجم برنامه اصلا مهم نيست چقدر باشه، فرض كنيد 10 كيلوبايت باشه، چرا مي‌خواين گزارش ساز استفاده نكنيد
دوم اينكه 200 مگابايت حجم فايلهاي نصب كريستال هست و برنامه نهايي شما نهايتا با چند مگابايت dll همراه هست
سوم اينكه فست ريپورت كلا 12 مگابايت حجم فايل نصبش هست و برنامه نهايي شما هم فقط يك DLL هفت مگابايتي داره
براي اتصال هم لازم نيست كار خاصي كنيد، ديتاهاتون رو توي يك جدول در بانك بريزيد و در فست ريپورت همون جدول خونده ميشه، نمونه مثالهاش رو ببينيد، يك نمونه ساده هم ضميمه كردم، وقتي فايل fr3 رو با فست ريپورت باز مي‌كنيد قسمت Data يا داده رو نگاه كنيد، يك ADODatabase داره كه به بانك متصل شده و يك ADOQuery كه به جدول متصل ميشه

[Mohsen0025]

پس باید یک بانک اطلاعاتی درست کنم که کاربر تو برنامه بنویسه و تو بانک اکسس ذخیره شه و بعد با fastreport اونو لود کنم؟و نمایش بدم؟
یه چیز دیگه اینه که این رجستر نیست و پیغام رجستر نشدنش رو چاپ میکنه

[vbhamed]

سلام
در مورد اول بله
در مورد دوم هم كه من نمونه برنامه براتون فرستادم، اون نسخه اي هم كه از سايت اصليش گرفتيد معلومه دمو هست

[m.4.r.m]

بابا به خدا خیلی بزرگش کردی این پست رو کاری نداره که ماشالله چه پره آموزش تو سایت و گوگل یکم خودت تلاش کن از بقیه هم کمک بطلب

[setroyd]

اگه واقعا این موضوع برات مهمه شروع کن یه usercontrol بنویس برای خودت بقیه هم کمکت میکنن من خودم عادت داشتم وقتی چیزی که میخاستم تو نت نبود خودم مینوشتم واسه کارام توام اگه در توانت هست بکن اگر نه من پیشنهاد میکنم از راهی که حامد گفت بری .

[Mohsen0025]

با سلام مجدد
آره والا خیلی برام مهمه ولی باید بلد باشی که چه طور متن تو label رو چه طور بچرخونی بعد user control براش بنویسی یا نه؟
من بلد نیستم!!! دوستان در بالا راهنمایی کردن متن های فارسی رو چه طور بچرخونیم اما اگه متن زیاد باشه به همون اندازه تو صفحه تکون میخوره!!!
اگه کسی فایل OCX یا ......... یا کمکی چیزی بلده دریغ نکنه خداییش
اگه تو VB2010 هم باشه مشکلی نیس!!!
تشکر:بوس:

[Mohsen0025]

یعنی هیچ راهی نداره؟ هیچ فایل OCX و یا کدی نداره؟ حتماً باید از report استفاده شه؟:گریه:

[vbhamed]

سلام
راههاي ديگه هم هست ولي از ريپورت خيلي مشكل تر هستن
بايد با توابع چاپ API كار كني و متن رو در پرينتر بچرخوني، بعدش هم چه كاريه وقتي به اين سادگي با ريپورت ميشه چرا بريد سراغ راههاي سخت

[Mohsen0025]

حامد جان سر به سرش گذاشتم و از چند تا سایت خارجی کمک گرفتم تونستم درستش کنم!! با USER Control!!! اما کیفیت متنش که تو صفحه هستش خیلی پایینه!! نمیدونم چیکارش کنم!!!
راستی میشه از Excel کمک گرفت؟ مثلاً تو اکسل متن ها رو چرخوند با استفاده از textbox بعد تو برنامه بگی فلان textbox توش این متن قرار بگیره و بعد چاپش کرد؟
بازم ممنونم

[vbhamed]

سلام

براي چاپ با كيفيت بايد متنتون به صورت فونت يا برداري باشه، با اون روشهايي كه شما مي‌چرخوني ميشه bitmap و كيفيتش پايين مياد مگر اينكه خيلي بزرگ بنويسي و بعد بچرخوني كه اونم مشكل فضا و حافظه و سرعت و ... داره
اكسل هم از توابع api براي ايجاد فونت زاويه دار استفاده مي‌كنه و وقتي كپي بگيريد فقط متن رو كپي مي‌گيره و توابع api چرخش فونت بايد توسط برنامه شما روش اعمال بشه

به نظر من شما داري روي اين قضيه وقت تلف مي‌كني يا انگار ترس داري از اينكه با گزارشگر كار كني ولي وقتي اينكار رو انجام بدي مي‌بيني كه قبلا چقدر اشتباه مي‌كردي
ضمنا نوشتن برنامه 200 كيلوبايتي اصلا مزيت خاصي نداره (تازه بيشتر وقتها از ديد مشتري ضرر هم داره !) و اين هم برنامه اي نيست كه حجمش مهم باشه، مهم جامع و كامل بودن برنامه و انعطاف پذير بودنش هست كه فقط با گزارشگر بدست مياد