۱۸-آبان-۱۳۹۱, ۲۱:۵۹:۲۹
با سلام دوباره مزاحم شدم اون برنامه رو پیدا کردم ویک مشکل دارم
زمانی که برنامه رو اجرا میکنم مشکل ندام ولی با فرمی که خودم ساختم وهمین برنامه رو توشکپی کردم یک مشکل تو فرم دارم واون اینه که متنی که توسط shapeها باید به دایره های رنگی تبدیل بشه انجام نمیشه البته وقتی از shapeفرم اصلی کپی میگیرم وتو فرمم میزارم مشکل حل میشه ایا امکان داره
که shapeبرنامه من با فرم فرق بکنه ویا بایدیکcomponentجدید بسازم لطفا کمک کنید برنامه تو صفحه 4 ویزوابیسیک به نام برنامه تبدیل متن به پیکسل تابلوروان اینم برنامه بیسیک
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Sub Command1_Click()
Dim X As Integer, Y As Integer, Index As Integer
Dim Blank As Long
Picture1.Cls
Blank = GetPixel(Picture1.hdc, 0, 0)
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(Text1)) \ 2
Picture1.CurrentY = (Picture1.ScaleHeight - Picture1.TextHeight(Text1)) \ 2
Picture1.Print Text1
For Index = 1 To Shp.UBound
X = Shp(Index).Left + Shp(Index).Width \ 2
Y = Shp(Index).Top + Shp(Index).Height \ 2
If GetPixel(Picture1.hdc, X, Y) <> Blank Then
Shp(Index).FillColor = vbRed
Else
Shp(Index).FillColor = Blank
End If
Next
End Sub
Private Sub Form_Load()
Dim Row As Long, Col As Long
Dim vLeft As Integer, vTop As Integer
Dim Cols As Long, Rows As Long
Dim Index As Long
Const W = 7
Const H = 7
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Rows = Picture1.ScaleHeight \ (H - 1)
Cols = Picture1.ScaleWidth \ (W - 1)
Shp(0).Visible = False
Shp(0).FillStyle = 0
vLeft = 0
vTop = 0
For Row = 1 To Rows
For Col = 1 To Cols
Index = (Row - 1) * Cols + Col
Load Shp(Index)
Shp(Index).Move vLeft, vTop, W, H
Shp(Index).Visible = True
vLeft = vLeft + W - 1
Next
vLeft = 0
vTop = vTop + H - 1
Next
End Sub
زمانی که برنامه رو اجرا میکنم مشکل ندام ولی با فرمی که خودم ساختم وهمین برنامه رو توشکپی کردم یک مشکل تو فرم دارم واون اینه که متنی که توسط shapeها باید به دایره های رنگی تبدیل بشه انجام نمیشه البته وقتی از shapeفرم اصلی کپی میگیرم وتو فرمم میزارم مشکل حل میشه ایا امکان داره
که shapeبرنامه من با فرم فرق بکنه ویا بایدیکcomponentجدید بسازم لطفا کمک کنید برنامه تو صفحه 4 ویزوابیسیک به نام برنامه تبدیل متن به پیکسل تابلوروان اینم برنامه بیسیک
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Sub Command1_Click()
Dim X As Integer, Y As Integer, Index As Integer
Dim Blank As Long
Picture1.Cls
Blank = GetPixel(Picture1.hdc, 0, 0)
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(Text1)) \ 2
Picture1.CurrentY = (Picture1.ScaleHeight - Picture1.TextHeight(Text1)) \ 2
Picture1.Print Text1
For Index = 1 To Shp.UBound
X = Shp(Index).Left + Shp(Index).Width \ 2
Y = Shp(Index).Top + Shp(Index).Height \ 2
If GetPixel(Picture1.hdc, X, Y) <> Blank Then
Shp(Index).FillColor = vbRed
Else
Shp(Index).FillColor = Blank
End If
Next
End Sub
Private Sub Form_Load()
Dim Row As Long, Col As Long
Dim vLeft As Integer, vTop As Integer
Dim Cols As Long, Rows As Long
Dim Index As Long
Const W = 7
Const H = 7
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Rows = Picture1.ScaleHeight \ (H - 1)
Cols = Picture1.ScaleWidth \ (W - 1)
Shp(0).Visible = False
Shp(0).FillStyle = 0
vLeft = 0
vTop = 0
For Row = 1 To Rows
For Col = 1 To Cols
Index = (Row - 1) * Cols + Col
Load Shp(Index)
Shp(Index).Move vLeft, vTop, W, H
Shp(Index).Visible = True
vLeft = vLeft + W - 1
Next
vLeft = 0
vTop = vTop + H - 1
Next
End Sub