الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

تحريك النص في الفجول بيسك ؟؟؟؟؟

مغلق
بدأه شجون 2003 في 9 أبريل 2003 · 16 رد · 1,607 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم ورحمه الله وبركاته

أتمني منكم مساعدتي ...........

لو أحد من الاعضاء الكرام يعرف كـــــيفــــيــــــــه تحريك النص (( الكلمة ))

با أكثر من طريقة (( بطرق مختلفه )) في الفجول بيسك يكتب الكود ؟؟؟؟؟

***********************************************

أتمني الرد على الموضوع والمساعدة

لو أحد يعرف يكتب الكود ؟؟؟

#2

بسم الله الرحمن الرحيم

هناك طريقة لتحريك النص ، موجودة في موضوع (تصويت: أكواد للمبتدئين) أرجو أن يكون هو المطلوب ، وإليك تحياتي

ani.gif
#3

الاخ (((( عبد الله فتحي ))))

شكرا لك على الرد

ولكن أنا اريد أكثر من طريقه لي تحريك النص

مثلاً يتحرك النص بشكل عمودي افقي دائري طرق مختلفة

#4

أختي شجون2003

هذه بعض الطرق لتحريك النص

لتحريك Text عند مرور الماوس عليه

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Text1.Top = 600 Then ' Move it to the bottom

For i = 600 To Form1.Height - 2 * Text1.Height Step Screen.TwipsPerPixelY

Text1.Top = i ' Change the command button's top property to i

Next i ' Reapeat



Else ' Move it to the top

For i = Form1.Height - 2 * Text1.Height To 600 Step -Screen.TwipsPerPixelY

Text1.Top = i

Next i

End If

End Sub
ani.gif
#5

لتحريك (2) Label

'Enabled = True

'Command1

'Caption = Enter

'Visible = False



Private Sub Timer1_Timer()

    Label1.Move Label1.Left - 0, Label1.Top - 100

    Label2.Move Label2.Left - 0, Label2.Top - 100

    If Label2.Top > 0 Then

  Else



    Label2.Visible = False

    Timer1.Enabled = False

    Command1.Visible = True

  End If

End Sub
ani.gif
#6

طريقة أخرى

Private Sub Timer1_Timer()

Label1.Top = IIf(Label1.Top <= -Label1.Height, Height, Label1.Top - 50)

If Label1.Top <= 0 Then

Timer1.Enabled = False

Else

Label1.Top = Label1.Top - 50

End If



End Sub
ani.gif
#7

وطريقة كمان

Private Sub Form_Load()

Timer1.Interval = 100

End Sub



Private Sub Timer1_Timer()

 Label1.Move Label1.Left + 100

    If Label1.Left > Form1.Width Then

        Label1.Left = -Label1.Width

    End If

End Sub
ani.gif
#8

طريقة ثانية

Private Sub Form_Load()

Timer1.Interval = 100

End Sub



Private Sub Timer1_Timer()

Label1.Top = Label1.Top - 50

If Label1.Top <= 0 Then Label1.Top = Me.Height

End Sub
ani.gif
#9

طريقة أحلى

Private Sub Form_Load()

Me.Label1.Top = 0

End Sub





Private Sub Timer1_Timer()

a = Me.Height

b = 200

If Me.Label1.Top < a Then 'Me.Height Then

Me.Label1.Top = Me.Label1.Top + b

Exit Sub

End If

For m = 1 To (Int(a / b) + 1)

Me.Label1.Top = Me.Label1.Top - 200

For x = 1 To 1000000

Next

Next

End Sub
ani.gif
#10

طريقة كمان

Private Sub Form_Load()

Timer1.Interval = 100

End Sub



Private Sub Timer1_Timer()

Label1.Move 2000, Label1.Top + 100

If Label1.Top > form1.Height Then

Label1.Top = -Label1.Height

End If

End Sub
ani.gif
#11

آخر طريقة،،،،،،، وآسف جداً للإزعاج:rolleyes:

Private Sub Form_Load()

Timer1.Interval = 100

End Sub



Private Sub Timer1_Timer()

 Label1.Move 2000, Label1.Top - 100

    If Label1.Top < 0 Then

        Label1.Top = Form1.Height

    End If

End Sub
ani.gif
#12

أشكرك جداً جداً وأرجو أن تضيف بعض أكوادك على أكوادي في موضوع

أكواد كثيرة جداً ومفيدة

#13

تأثير على الـ Label

'هذا الكود يحتاج إلى زر Command1

Option Explicit

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Declare Function SetTextCharacterExtra Lib "gdi32" _

(ByVal hdc As Long, ByVal nCharExtra As Long) As Long



Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type



Private Declare Function OffsetRect Lib "user32" (lpRect _

As RECT, ByVal x As Long, ByVal y As Long) As Long



Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc _

As Long, ByVal crColor As Long) As Long



Private Declare Function FillRect Lib "user32" (ByVal hdc As _

Long, lpRect As RECT, ByVal hBrush As Long) As Long



Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal _

crColor As Long) As Long



Private Declare Function DeleteObject Lib "gdi32" (ByVal _

hObject As Long) As Long



Private Declare Function GetSysColor Lib "user32" (ByVal _

nIndex As Long) As Long



Private Const COLOR_BTNFACE = 15



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



Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _

(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _

lpRect As RECT, ByVal wFormat As Long) As Long



Private Const DT_BOTTOM = &H8

Private Const DT_CALCRECT = &H400

Private Const DT_CENTER = &H1

Private Const DT_CHARSTREAM = 4 ' Character-stream, PLP

Private Const DT_DISPFILE = 6 ' Display-file

Private Const DT_EXPANDTABS = &H40

Private Const DT_EXTERNALLEADING = &H200

Private Const DT_INTERNAL = &H1000

Private Const DT_LEFT = &H0

Private Const DT_METAFILE = 5 ' Metafile, VDM

Private Const DT_NOCLIP = &H100

Private Const DT_NOPREFIX = &H800

Private Const DT_PLOTTER = 0 ' Vector plotter

Private Const DT_RASCAMERA = 3 ' Raster camera

Private Const DT_RASDISPLAY = 1 ' Raster display

Private Const DT_RASPRINTER = 2 ' Raster printer

Private Const DT_RIGHT = &H2

Private Const DT_SINGLELINE = &H20

Private Const DT_TABSTOP = &H80

Private Const DT_TOP = &H0

Private Const DT_VCENTER = &H4

Private Const DT_WORDBREAK = &H10



Private Declare Function OleTranslateColor Lib "olepro32.dll" _

(ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long

Private Const CLR_INVALID = -1



Public Sub TextEffect(obj As Object, ByVal sText As String, _

ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop _

As Boolean = False, Optional ByVal lStartSpacing As Long = 128, _

Optional ByVal lEndSpacing As Long = -1, Optional ByVal oColor _

As OLE_COLOR = vbWindowText)



Dim lhDC As Long

Dim i As Long

Dim x As Long

Dim lLen As Long

Dim hBrush As Long

Static tR As RECT

Dim iDir As Long

Dim bNotFirstTime As Boolean

Dim lTime As Long

Dim lIter As Long

Dim bSlowDown As Boolean

Dim lCOlor As Long

Dim bDoIt As Boolean



lhDC = obj.hdc

iDir = -1

i = lStartSpacing

tR.Left = lX: tR.Top = lY: tR.Right = lX: tR.Bottom = lY

OleTranslateColor oColor, 0, lCOlor



hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))

lLen = Len(sText)



SetTextColor lhDC, lCOlor

bDoIt = True



Do While bDoIt

lTime = timeGetTime

If (i < -3) And Not (bLoop) And Not (bSlowDown) Then

bSlowDown = True

iDir = 1

lIter = (i + 4)

End If

If (i > 128) Then iDir = -1

If Not (bLoop) And iDir = 1 Then

If (i = lEndSpacing) Then

' Stop

bDoIt = False

Else

lIter = lIter - 1

If (lIter <= 0) Then

i = i + iDir

lIter = (i + 4)

End If

End If

Else

i = i + iDir

End If



FillRect lhDC, tR, hBrush

x = 32 - (i * lLen)

SetTextCharacterExtra lhDC, i

DrawText lhDC, sText, lLen, tR, DT_CALCRECT

tR.Right = tR.Right + 4

If (tR.Right > obj.ScaleWidth  Screen.TwipsPerPixelX) Then _

tR.Right = obj.ScaleWidth  Screen.TwipsPerPixelX

DrawText lhDC, sText, lLen, tR, DT_LEFT

obj.Refresh



Do

DoEvents

If obj.Visible = False Then Exit Sub

Loop While (timeGetTime - lTime) < 20



Loop

DeleteObject hBrush



End Sub



Private Sub Command1_Click()

Me.ScaleMode = vbTwips

Me.AutoRedraw = True

Call TextEffect(Me, "H  e  l  l  o!", 10, 10, False, 75)

End Sub
ani.gif
#14

***************************************************

شكراً لك أخي ((((((((((( عبد الله فتحي )))))))))

جزاك الله كل خير

لقد أستفت كثيراً من الاكواد

شكراً على المساعدة لقد تعبتك معاى

*************************************************

##### شجــــــــــــــــون ######

#15

أختي: شجون

إليك تحياتي، كما أتمنى أن تقومي بالتصويت على موضوعي (تصويت: أكواد للمبتدئين)، وأتمنى أن تقومي بزيارة الرابط التالي:

http://members.lycos.co.uk/alhosamnet/vb/index.php?s=

ani.gif
#16

تسلم على الأكواد الجميلة .

أخوك : سعد (f)

#17

بسم الله الرحمن الرحيم

تحياتي الي كل من شارك في هزة المساعدة

كما أرجو ان يوفقني الة في طرح هزة الفكار بخصوص تحريك النص

فأليك تحريك النص في اعلي الفورم وتحريك النص في ليبل وتحريك النص في أدة مخصصة ليزليك وأليكم المزيد عن قريب ان شاء الله

PROGRAMER_VB6@HOTMAIL.COM

كلمé_مêيٌكé_çْلى_çل‎وٌم.zip

هذا الموضوع مغلق.

مواضيع مشابهة