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

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

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

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

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

---

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

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% می باشد و سرعت آن هم در حد چند میلی ثانیه می باشد.

ممنون.