سلام
با چه کدی میتوان برای هر فرمی به نسبت اندازه عرض فرم و تعداد حروف کپشن فرم ، متن کپشن را به وسط عنوان یا وسط تایتل بار فرم انتقال داد؟
با تشکر
سلام
با چه کدی میتوان برای هر فرمی به نسبت اندازه عرض فرم و تعداد حروف کپشن فرم ، متن کپشن را به وسط عنوان یا وسط تایتل بار فرم انتقال داد؟
با تشکر
یک فایل پیدا کردم که کپشن فرم رو به وسط عنوان فرم انتقال میده منتها این فایل برای محیط VB6 تهیه شده و بخاطر یک سری خصوصیات که فرم های VB6 دارند و فرم های اکسس فاقد این خصوصیات میباشد موفق نشدم در محیط اکسس از کدهای فوق استفاده کنم . خصوصیاتی مثل () formName.TextWidth و formName.FontName
--------------------------------------------
آخرین ویرایش به وسیله eb_1345 : سه شنبه 16 بهمن 1403 در 06:48 صبح
نمونه ضمیمه رو بررسی بفرما!
آخرین ویرایش به وسیله eb_1345 : سه شنبه 16 بهمن 1403 در 06:49 صبح
نمونه بالا رو الآن دوباره امتحان کردم یک مشکلی داره و اون اینکه در هنگام ریسایز شدن فرم متن کپشن جابجا نمیشه که باید بررسی بشه مشکل از کجاست
به دلیل تفاوت های خاصی که در خصوصیات فرم اکسس نسبت به فرم های زبانهای برنامه نویسی وجود داره برای اجرای بعضی کارها در فرم های اکسس باید از راه های غیر متعارف استفاده کرد. موضوع این تاپیک هم از اون مواردی است که برای عملی کردنش باید از راهکاری غیر عادی استفاده کرد . مثلاً در نمونه بالا چون فرم اکسس فاقد خصوصیت (...) formName.TextWidth میباشه و این خاصیت در قسمت گزارش وجود داره بنده در نمونه پست 4 برای بدست آوردن مقدار این خصوصیت از یک گزارش خالی استفاده کردم و در قسمت Detail_Format مقدار متغییر عمومی رو معادل این خصوصیت قرار دادم و بعد گزارش رو بصورت مخفی اجرا و بلافاصله دستور بسته شدن اون رو در کدها قرار داده ام.
منتها با این وجود هم اشکالات دیگه ای در اجری اون وجود داره که باید از طریق دیگه برطرف بشه
با سلام
ممنون از توضیحاتتون
فقط یک سوال
ممکنه بفرمائید تابع () formName.TextWidth چه کاری انجام میده ؟
اندازه طول کاراکترهای یک متن رو بدست میارهنوشته شده توسط atf1379
سلام جناب بهرامی گرامی
روز خوش
با اجازه شما نمونه ای که زحمتش رو کشیده بودین دیدم و مثل همیشه تحسین برانگیز بود.
یک پرسش داشتم از حضورتون:
همین روش رو در VB هم تست کردین و جواب گرفتین؟ (دات نت منظورم نیست - همون VB6)
این بخش center شدن caption با resize رو میگم.
عرض سلام و ارادت خدمت استاد مازولاق عزیز !
نمونه ای که در پست 2 ضمیمه شده برای انتقال کپشن به وسط فرم در محیط VB6 تهیه شده
که کدهای نمونه فوق در زیر قرار میدهم که ملاحظه و بررسی بفرمائین
کد های ماژول عمومی:
Const SPI_GETNONCLIENTMETRICS = 41
Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfEscapement As Long
lfUnderline As Byte
lfStrikeOut As Byte
lfWidth As Long
lfWeight As Long
lfItalic As Byte
lfCharSet As Byte
lfClipPrecision As Byte
lfOutPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfOrientation As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
'
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSIZE As Long = 30 ' width of a title bar button at 96 DPI
Public Function center_Form_Caption(ByRef formName As Form, ByVal currentTitle)
Dim ncm As NONCLIENTMETRICS, res As Single, strPuffer As String, i As Integer
ncm.cbSize = 340
res = SystemParametersInfo(SPI_GETNONCLIENTMETRICS, ncm.cbSize, ncm, 0)
' If res = 0 Then LastError: Exit Function
Dim lngTitle As Long
Dim Spacelen As Long
Dim theSpaces As Long
Dim tmpFontName As String
tmpFontName = formName.FontName
strPuffer = StrConv(ncm.lfCaptionFont.lfFaceName(), vbUnicode)
strPuffer = Replace(strPuffer, Chr(0), "")
formName.Font.Name = strPuffer
formName.Font.Size = -ncm.lfCaptionFont.lfHeight / (1440 / Screen.TwipsPerPixelY) * 72
lngTitle = formName.TextWidth(currentTitle)
' theSpaces = (formName.Width - lngTitle) / 2
' note: rgrect(2) below is the Min button. If there is no Min button or no buttons at all,
' change as needed. See this link for what items are in the array of rects
' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/ns-winuser-tagtitlebarinfoex
theSpaces = (formName.ScaleWidth - GetSystemMetrics(SM_CXSIZE) * 3.05 * 15 - lngTitle) / 2
If theSpaces < 1 Then
formName.Caption = currentTitle
Else
Spacelen = formName.TextWidth(" ")
If Spacelen = 0 Then Spacelen = 1
theSpaces = theSpaces / Spacelen
formName.Caption = Right$(Space$(theSpaces) & currentTitle, 255)
End If
' Debug.Print formName.Caption
formName.Font.Name = tmpFontName
End Function
کد مربوطه به فراخوانی تابع انتقال کپشن به وسط فرم:
center_Form_Caption Me, LTrim$(Me.Caption)
کدهائی که بنده جایگزین کدهای فوق برای فرم اکسس کردم شامل موارد زیر میباشه :
دو تابع عمومی در ماژول عمومی :
'Public pubSzrFont As String 'font name
'Public pubSzrSize As Integer 'font size
'Public pubSzrBold As Boolean 'font bold
Public pubSzrText As String 'control text
Public pubSzrWidth As Long 'text width
Function fctSzr(strFont As String, intSize As Integer, strText As String, Optional boBold As Boolean = False) As Long
'pubSzrFont = strFont
'pubSzrSize = intSize
pubSzrText = Replace(strText, " ", "-")
'pubSzrBold = boBold
DoCmd.OpenReport "rptSzr", acViewPreview, , , acHidden
DoCmd.Close acReport, "rptSzr"
fctSzr = pubSzrWidth
End Function
Public Sub CenterCaptionForm(frm As Form, strFont As String, intSize As Integer, strText As String, Optional boBold As Boolean = False)
Dim lngTitle As Long
Dim Spacelen As Long
Dim theSpaces As Long
Dim lngWidth As Long
lngWidth = fctSzr(strFont, intSize, strText, True)
lngTitle = lngWidth
theSpaces = (frm.WindowWidth - lngTitle)
Spacelen = fctSzr("tahoma", 9, " ", True)
If Spacelen = 0 Then Spacelen = 1
theSpaces = theSpaces / Spacelen
frm.Caption = Space(theSpaces) & frm.Caption
End Sub
کد مورد استفاده در بخش Detail_Format گزارش خالی:
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
'Me.FontName = pubSzrFont
'Me.FontSize = pubSzrSize
'Me.FontBold = pubSzrBold
pubSzrWidth = Me.TextWidth(pubSzrText) + 30
End Sub
کد فراخوانی تابع انتقال کپشن به وسط تایتل بار فرم:
Call CenterCaptionForm(Me, "tahoma", 8, Me.Caption, False)
همونطور که در پست های 5 و 6 عرض کردم کدهای جایگزین بنده یک ایراد اساسی داره و اون اینکه در هنگام ریسایز فرم ، کپشن به وسط تایتل بار فرم منتقل نمیشه
..........
آخرین ویرایش به وسیله eb_1345 : چهارشنبه 24 بهمن 1403 در 23:43 عصر
سلام دوباره خدمت جناب بهرامی گرامی
کدهای اصلی که برای فرم های VB6 هست رو دیدم،کدهای نمونه فوق در زیر قرار میدهم که ملاحظه و بررسی بفرمائین
البته نمیتونم اون رو تست کنم - ظاهرا که درست هست دیگه،
با این وجود برای این که اونها رو در VBA استفاده کنین مناسب نیست
چون یک سری چیزهایی نیاز داره که اینجا نداریم.
شما بیاین از یک راه دیگه برین:
همون SystemParametersInfo رو برای گرفتن مشخصات فونت دیفالت ویندوز برای کپشن فرمها استفاده کنین.
البته الزاما اکسس از این فونت ممکنه استفاده نکنه - به تم و اینها بستگی داره،
ولی خب بیایم امیدوار باشیم که همینه.
بعد از کتابخونه gdi32 استفاده کنین
که یک فانکشن داره که مشخصات فونت رو میدین (مثل همین LOGFONT بجز اسم فونت که استرینگ ساده اس)
و یک فونت میسازه،
حالا یک فانکشن دیگه داره که با این فونت که ساختین و متنی که بهش میدین اندازه های باکس رندر اون رو حساب میکنه (به پیکسل و واسه screen)
- البته من جزئیات کار رو دیگه نیاوردم - (چون باید برم برتامه های 20 سال پیش رو بگردم یا گوگل/بینگ کنم یا از هوش ساختگی کمک بگیرم که شما نیازی به اینها ندارین)
یک بار هم همین پروسه رو برای متنی که فقط space ساده هست انجام مبدین تا اندازه اون هم داشته باشین.
وقتی اندازه رو داشتین مابقی کار دیگه ساده است:
در فرم یک روتین مینویسین که از روی insidewidth و اندازه باکس که بالا بدست آوردین
اندازه جای خالی رو محاسبه کنه (که البته اینم تقریبی هست چون بستگی به آیکون و کنترل باکس فرم هم داره)
و این اندازه رو نصف و به اندازه space تقسیم
و به اندازه بدست آمده space به سمت چپ trim شده کپشن فعلی بچسبونه
و این رو بعنوان کپشن فعلی بگذاره.
این روتین رو در form resize بگذارین و تمام.
=====
برای ریپورت هم همینه روش
فقط اونجا windowwidth باید باشه.
چه در فرم و چه در ریپورت با ریسایز کردن مقدار width عوض نمیشه
برای همین insidewidth یا windowwidth باید استفاده کنین.
========
بعد همه اینها نهایتا شما یک وسط-چین تقریبی دارین!
و بنظرم کلا چیزی نیست که ارزش وقت گذاشتن داشته باشه - مگر بعنوان یک چالش.
==========
برای بینندگان عبوری تاپیک:
اگر زمانی دیدین خواسته هایی دارین
که اکسس بصورت ذاتی نداره
و پیاده سازی اون نیاز به کارهای پیچیده و عجیب و غریب و غیرمتعارف داره
بدونین که یا انتخاب نادرستی کردین یا خواسته تون غیرمنطقیه!
با عرض سلام متقابل
ممنون بابت توضیحات مفید و مفصلتون
راستش دیروز اومدم از طریق یک سری API Declares و تابع GetStringWidth برای انجام اینکار اقدام کردم ولی در حالت ریسایز نمودن فرم متوجه شدم انجام اینکار برای فرم های اکسس ظاهراً نتیجه بخش نمی باشه ؛ چون وقتی عرض فرم از یک اندازه خاصی بزرگتر میشه متن کپشن بطور کامل نمایش داده نمیشه .
روش جدید رو در فرم نمونه ضمیمه اعمال کرده ام . در فرم نمونه ضمیمه بعد از اجرای فرم ملاحظه خواهی نمود که متن کپشن تقریبا در وسط قرار گرفته ولی اگر فرم رو از طریق پائین نگه داشتن موس و کشیدن لبه سمت راست آن به سمت بیرون ریسایز نمائین متن کپشن کوتاهتر میشه تا جائیکه متن کاملاً غیر قابل نمایش میشه
سلام دوبارهراستش دیروز اومدم از طریق یک سری API Declares و تابع GetStringWidth برای انجام اینکار اقدام کردم ولی در حالت ریسایز نمودن فرم متوجه شدم انجام اینکار برای فرم های اکسس ظاهراً نتیجه بخش نمی باشه ؛ چون وقتی عرض فرم از یک اندازه خاصی بزرگتر میشه متن کپشن بطور کامل نمایش داده نمیشه .
روش جدید رو در فرم نمونه ضمیمه اعمال کرده ام . در فرم نمونه ضمیمه بعد از اجرای فرم ملاحظه خواهی نمود که متن کپشن تقریبا در وسط قرار گرفته ولی اگر فرم رو از طریق پائین نگه داشتن موس و کشیدن لبه سمت راست آن به سمت بیرون ریسایز نمائین متن کپشن کوتاهتر میشه تا جائیکه متن کاملاً غیر قابل نمایش میشه
خدمت جناب بهرامی گرامی
1- این که وقتی پهنای فرم از یک اندازه ای بیشتر میشه،
کپشن رو ناقص نشون میده بخاطر محدودیت ذاتی اندازه خود کپشن هست : 128 کارآکتر
پس شما چک کنین که اگه اندازه رشته با اون space قبلش از 128 بیشتر شد،
از تعداد space ها همون اندازه کم کنین،
اینجوری دیگه آخر کپشن رو نمیبره.
البته بهتره واسه منفی بودن هم چک و به 0 تبدیلش کنین.
2- یک کاری که میتونین بکنین این هست که بجای space (کاراکتر با کد 20 هگز)
از space های دیگه استفاده کنین که پهنای بیشتری دارن (در نتیجه تعداد کمتری نیازه)
مثلا از em space استفاده کنین (کد هگز 2003) و با سعی و خطا ببینین theSpaces رو به چند باید تقسیم کنین (3 مناسبه).
3- حالا درسته که تقریبی هست محاسبات،
ولی از سیستم بگیرین مشخصات فونت کپشن فرم رو
و بجای
lngTitle = GetStringWidth(strText, "Tahoma", 8)
همون رو بدین به تابع CreateFont (البته شما اینو استفاده نکردین)
فونت های کپشن معمولا segui و trebuchet و ... هست.
4- اون 130 نمیدونم از کجا اومده
theSpaces = (Frm.WindowWidth - lngTitle) / 130
ولی GetTextExtentPoint32 اندازه رو به pixel برمیگردونه
که برای تبدیلش به cm باید به 567 تقسیم بشه
ضمنا در حالتی که خصوصیت Orientation فرم در حالت Right-to-Left باشه انتقال کپشن توسط تابع CenterFormCaption انجام نمیشه
چون در این حالت برعکس حالت Left-to-Right که فضای خالی باید قبل از متن کپشن باشه در حالت Right-to-Left فضای خالی باید بعد از متن کپشن اضافه شود
بخاطر همین باید در تابع این حالت بصورت زیر چک شود :
If Frm.Orientation = 0 Then
StrCaption = Space$(Int(theSpaces)) & strText
Else
StrCaption = strText & Space$(Int(theSpaces))
End If
آخرین ویرایش به وسیله eb_1345 : پنج شنبه 02 اسفند 1403 در 07:37 صبح
راستش من هر کاری کردم به نتیجه دلخواه نرسیدم . فرم وقتی از یک حدی عریضتر میشه انتقال متن کپشن به وسط محدودتر میشه .
آخرین ویرایش به وسیله eb_1345 : پنج شنبه 02 اسفند 1403 در 12:28 عصر
با استایل دهی فرم ها به بعضی از استایل ها که متن کپشن رو به وسط عنوان فرم منتقل می کنه این خواسته برآورده میشه
آخرین ویرایش به وسیله eb_1345 : یک شنبه 05 اسفند 1403 در 10:40 صبح دلیل: حذف تصاویر ضمیمه
سلام دوباره
این روش که گفتم رو مطمئنم کار میکنه چون قبلا انجام دادم.
ولی باید سیستم های قدیمی رو بگردم (بابت درست بودن جزئیات)
و احتمالا یک دستی به سر روی اون هم بکشم.
====
البته نفس این دست کارها رو درست نمیدونم (نظر شخصی هست البته)
حالا شاید راجع به این هم یک منبر برم.
در تایپ پست قبلی وقفه افتاد،با استایل دهی فرم ها به بعضی از استایل ها که متن کپشن رو به وسط عنوان فرم منتقل می کنه این خواسته برآورده میشه
و در همین زمان پست جدید شما اومده بوده بود که ندیدم.
پس با اینحساب داستان تمام شده است و پست 19 رو ندیده بگیرید.
سلام جناب استاد مازولاق عزیز !
بعد از ارسال پست 18 یادم افتاد که ظاهراً امکان استایل دهی فرم ها در همه نسخه های بالاتر از آفیس 2010 وجود نداره
بخاطر همین تصاویری که در پست 18 ضمیمه کرده بودم حذف کردم.
آخرین ویرایش به وسیله eb_1345 : یک شنبه 05 اسفند 1403 در 10:39 صبح دلیل: اصلاح توضیحات
من خواهش میکنم اگه فرصت داشتین این موضوع رو بررسی کنین و یک نمونه فایل رو ضمیمه بفرمائین !
شاید بقول خودتون این موضوع اهمیت زیادی نداشته باشه ولی بعنوان یک موضوع چالش برانگیز ارزش بررسی کردن رو داره
متوجه شدم،
چَشم - حتما
... TIME
خب برنامه رو پیدا کردم
و همینجور که میبینین مال 25 سال پیش هست
1.png
و روی همون سیستم قدیمی هم اجرا میشه (ویندوز 98 + آفیس 97)
البته روی آفیس 2010 هم هنوز قابل تبدیل و اجرا هست،
فعلا کدها و اسکرین شات و برنامه قدیمی رو پیوست میکنم،
شاید سر فرصت تبدیل شده اش رو هم پیوست - و کدها رو هم برای آفیس های مدرن ویرایش کنم.
Structures
Option Compare Database
Option Explicit
Public 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(1 To 32) As Byte
End Type
Public Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSmCaptionWidth As Long
iSmCaptionHeight As Long
lfSmCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
Public Type TextSize
Width As Long
Height As Long
WidthCM As Single
HeightCM As Single
End Type
Declares
Option Compare Database
Option Explicit
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
ByVal uiAction As Long, _
ByVal uiParam As Long, _
ByRef pvParam As Any, _
ByVal fWinIni As Long _
) As Long
Public Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" ( _
ByVal lpszDriver As String, _
ByVal lpszDevice As String, _
ByVal lpszOutput As String, _
ByVal lpInitData As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" ( _
ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long
Public Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
ByVal hdc As Long, _
ByVal lpString As String, _
ByVal cbString As Long, _
lpSize As TextSize) As Long
Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( _
ByVal nHeight As Long, _
ByVal nWidth As Long, _
ByVal nEscapement As Long, _
ByVal nOrientation As Long, _
ByVal fnWeight As Long, _
ByVal fdwItalic As Long, _
ByVal fdwUnderline As Long, _
ByVal fdwStrikeOut As Long, _
ByVal fdwCharSet As Long, _
ByVal fdwOutputPrecision As Long, _
ByVal fdwClipPrecision As Long, _
ByVal fdwQuality As Long, _
ByVal fdwPitchAndFamily As Long, _
ByVal lpszFace As String) As Long
Publics
Option Compare Database
Option Explicit
Public Const SPI_GETNONCLIENTMETRICS As Long = 41
Public Const twips = 566.929133858
Public Const twipsPerPixel = 15
Public Function GetTextSize( _
text As String, _
FontName As String, _
Height As Long, _
Width As Long, _
Weight As Long, _
Orientation As Long, _
Italic As Byte, _
Underline As Byte, _
StrikeOut As Byte, _
CharSet As Byte) As TextSize
Dim hdc As Long
Dim hFont As Long
Dim hOldFont As Long
Dim ts As TextSize
hdc = CreateDC("DISPLAY", vbNullString, vbNullString, 0)
hFont = CreateFont( _
lpszFace:=FontName, _
nHeight:=-Height * 20, _
nWidth:=Width, _
nOrientation:=Orientation, _
fnWeight:=Weight, _
fdwItalic:=Italic, _
fdwUnderline:=Underline, _
fdwStrikeOut:=StrikeOut, _
fdwCharSet:=CharSet, _
nEscapement:=0, _
fdwOutputPrecision:=0, _
fdwClipPrecision:=0, _
fdwQuality:=0, _
fdwPitchAndFamily:=0)
hOldFont = SelectObject(hdc, hFont)
GetTextExtentPoint32 hdc, text, Len(text), ts
GetTextSize.Width = ts.Width
GetTextSize.Height = ts.Height
GetTextSize.WidthCM = ts.Width / twips
GetTextSize.HeightCM = ts.Height / twips
SelectObject hdc, hOldFont
DeleteObject hFont
DeleteDC hdc
End Function
Form
Option Compare Database
Option Explicit
Private NCM As NONCLIENTMETRICS
Private CaptionSize As TextSize
Private BlankSize As TextSize
Private CaptionText As String
Private CaptionLength As Integer
Const Blank = " "
Private Sub Form_Load()
CaptionText = Me.Caption
CaptionLength = Len(CaptionText)
NCM.cbSize = Len(NCM)
SystemParametersInfo SPI_GETNONCLIENTMETRICS, NCM.cbSize, NCM, 0
Dim CaptionFontName As String
Dim i As Integer
With NCM.lfCaptionFont
For i = LBound(.lfFaceName) To UBound(.lfFaceName)
If .lfFaceName(i) = 0 Then Exit For
CaptionFontName = CaptionFontName & Chr(.lfFaceName(i))
Next i
BlankSize = GetTextSize( _
Blank, _
CaptionFontName, _
.lfHeight, _
.lfWidth, _
.lfWeight, _
.lfOrientation, _
.lfItalic, _
.lfUnderline, _
.lfStrikeOut, _
.lfCharSet)
CaptionSize = GetTextSize( _
CaptionText, _
CaptionFontName, _
.lfHeight, _
.lfWidth, _
.lfWeight, _
.lfOrientation, _
.lfItalic, _
.lfUnderline, _
.lfStrikeOut, _
.lfCharSet)
End With
End Sub
Private Sub CenterCaption()
Dim CaptionButtonWidth As Integer
CaptionButtonWidth = NCM.iCaptionWidth * twipsPerPixel
Dim AvailableWidth As Single
AvailableWidth = Me.WindowWidth - CaptionButtonWidth
If Me.MinMaxButtons Then
AvailableWidth = AvailableWidth - 2 * CaptionButtonWidth
End If
If Me.CloseButton Then
AvailableWidth = AvailableWidth - CaptionButtonWidth
End If
AvailableWidth = AvailableWidth / twips
Dim x As Single
x = (AvailableWidth - CaptionSize.WidthCM) / 2
Dim n As Integer
n = (x / BlankSize.WidthCM) - 1
If n < 0 Then
n = 0
End If
If n + CaptionLength > 120 Then
n = 120 - CaptionLength
End If
Me.Caption = Space$(n) + CaptionText
End Sub
Private Sub Form_Resize()
CenterCaption
End Sub
بیشتر توضیحات و روش کار رو در پست های 12 و 14 آوردم،
کدها هم دقیقا همون کد 25 سال پیش هست
که فقط در فرم اسم چند متغییر رو تغییر دادم که مفهوم تر باشه
و البته فرمت هم شده برای خوانایی.
و برنامه رو هم که همینجا پیوست میکنم.
سلام استاد
ممنون از پیگیری و زحمتی که متحمل شدین
بنده نمونه رو با آفیس 2010 امتحان کردم ولی کپشن وسط چین نشد
ظاهرا بنا به فرمایش جنابعالی کدها برای اجرا بر روی آفیس های بعدی باید تبدیل شوند
تصویر ضمیمه رو ملاحظه بفرمائید.
این فایل پیوست دقیقا همون فایل پیوست پست 30 هست،
فقط به فرمت accdb تبدیل
و function declaration ها اصلاح شده
بنابر این در هر ویندوز و آفیس (2010 و به بالا) کار میکنه.
منظور از کار کردن این هست که بدون مشکل و خطا اجرا میشه (امیدوارم)
سلام و روز خوش
دلایل وسط چین نشدن (احتمالی)
و راه حل (تقریبی) اون رو در پست های قبلی آوردم.
کار بسیار ساده ای هست که انجامش رو به عهده خودتون میگذارم.
راهنمایی:
به کدهایی که در ماجول ها امده دست نزنین.
آخرین ویرایش به وسیله mazoolagh : چهارشنبه 08 اسفند 1403 در 19:27 عصر
با عرض سلام و خدا قوت
کدها بدون مشکل و خطا اجرا میشه ولی وسط چین نمیشه
امیدوارم دوستان دیگه هم نمونه رو بر روی سیستم خودشان امتحان و نتیجه رو اعلام فرمایند .
شاید آفیس سیستم بنده مشکل داشته باشه که کپشن وسط چین نمیشه
بنده سعیم رو می کنم ولی فکر نکنم از عهدش بر بیام
بخش فنی و سخت کار همونی هست که در ماجول ها آمده،
مابقی چند خط محاسبه بسیار ساده و در نظر گرفتن پست های قبلی هست.
با اکسس 2003 هم وسط چین نشد
در فرم های VB6 این مشکل وجود ندارد .
Me.Caption = Space(190) & Me.Caption
با تعداد 190 کارکتر فضای خالی در یک فرم تقریباً عریض کپشن به وسط فرم منتقل میشه ولی در فرم اکسس با همان اندازه و با این تعداد کاراکتر کلا کپشن نمایش داده نمیشه
ان شاءالله این تاپیک با برطرف شدن چالشی که داره به نتیجه برسه
در واقع این تاپیک تموم شده است!
ولی بنظر میرسه اصلا به پست ها دقت نمیکنین،
برای همین دوباره برای بینندگان عبوری میگم:
برنامه پیوست کامل هست
همه چیز در پست 12 و 14 آمده،
برای ویندوزهای بالاتر باید همونها رو پیاده کنین - بخصوص ویندوز 11
============
1- هوش ساختگی کوپایلوت (و چند تای دیگه) رو برای پاسخ کامل و دقیق train کردم (برای کپی/پیست کارها).
2- راه بسیار بهتر (از نظر نتیجه) و ساده تری (از نظر پیچیدگی کد و بی نیاز بودن از محاسبات) هم هست
ولی چون تاپیک در این مسیر نیست از اون میگذرم.
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول