اتو سایز واقعی - Actual AutoSize

[shalineh]

سلام. دوستان یه سوالی دارم که چند وقتیه ذهن منو به خودش مشغول کرده.

ابتدا به عکس زیر نگاه کنید.


http://img.majidonline.com/pic/146170/Label.gif

این تصویر یه لیبل Label استاندارد در وی بی 2005 هستش که خاصیت اتو سایز آن برابر True قرار داده شده است. همچنین میزان Margin و Padding آن هم مساوی صفر قرار داده شده است.
خب حالا سوال من اینه:
همانطور که میبینید علیرغم این که اتو سایز برابر True هستش باز هم فاصله ای بین اولین حرف با لبه چپ، آخرین حرف با لبه راست و نیز فاصله ها از هر دو لبه بالا و پایین قابل مشاهده هست. دوستان عزیز مشکل من اینه که میخوام میزان این فاصله رو بدست آورده تا بتونم با دستور Region این فاصله ها رو از بین ببرم ( در واقع بتونم یک لیبل با اتو سایز واقعی داشته باشم.
برای بیان بهتر منظورم، به شکل زیر که همان لیبل رو در نرم افزاری مثل PhotoImpact با اتو سایز واقعی نمایش میدهد توجه کنید:


http://img.majidonline.com/pic/146171/label2.gif

آیا این کار شدنیه؟ اگر آره، میتونید راهکاری ارائه بدید؟
ممنون.

[shalineh]

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

[touraj]

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

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

[shalineh]

Public Sub Actual_AutoSize(ByVal AxLabel As Label)
If AxLabel.Text.Trim.Length = 0 Then Exit Sub
Dim gp As New Drawing2D.GraphicsPath
Dim sf As New StringFormat
Dim rgn As Region
sf.LineAlignment = StringAlignment.Near
sf.Alignment = StringAlignment.Near
gp.AddString(AxLabel.Text, AxLabel.Font.FontFamily, AxLabel.Font.Style, AxLabel.Font.SizeInPoints, New Point(0, 0), sf)
rgn = New Region(gp)
Dim bit As New Bitmap(AxLabel.Width, AxLabel.Height)
AxLabel.DrawToBitmap(bit, AxLabel.DisplayRectangle)
Dim x As Integer = rgn.GetBounds(AxLabel.CreateGraphics).X
Dim y As Integer = rgn.GetBounds(AxLabel.CreateGraphics).Y
Dim XX, YY As Integer
For XX = x To bit.Width - 1
For YY = y To bit.Height - 1
If bit.GetPixel(XX, YY).ToArgb.ToString <> AxLabel.BackColor.ToArgb.ToString Then
GoTo 100
End If
Next
Next
100:
Dim FirstX As Integer = XX
For XX = bit.Width - 1 To 0 Step -1
For YY = y To bit.Height - 1
If bit.GetPixel(XX, YY).ToArgb.ToString <> AxLabel.BackColor.ToArgb.ToString Then
GoTo 200
End If
Next
Next
200:
Dim SecondX As Integer = XX
For YY = y To bit.Height - 1
For XX = x To bit.Width - 1
If bit.GetPixel(XX, YY).ToArgb.ToString <> AxLabel.BackColor.ToArgb.ToString Then
GoTo 300
End If
Next
Next
300:
Dim FirstY As Integer = YY
For YY = bit.Height - 1 To 0 Step -1
For XX = x To bit.Width - 1
If bit.GetPixel(XX, YY).ToArgb.ToString <> AxLabel.BackColor.ToArgb.ToString Then
GoTo 400
End If
Next
Next
400:
Dim SecondY As Integer = YY
AxLabel.Region = New Region(New Rectangle(FirstX, FirstY, SecondX - FirstX, SecondY - FirstY))
gp = Nothing
sf = Nothing
rgn = Nothing
bit = Nothing
x = Nothing
y = Nothing
XX = Nothing
YY = Nothing
FirstX = Nothing
SecondX = Nothing
FirstY = Nothing
SecondY = Nothing
End Sub


نتیجه کار:


http://img.majidonline.com/pic/146393/Actual_Label.gif


دقت این متد 100% می باشد و سرعت آن هم در حد چند میلی ثانیه می باشد.

ممنون.