السلام عليكم ورحمه الله وبركاته
أتمني منكم مساعدتي ...........
لو أحد من الاعضاء الكرام يعرف كـــــيفــــيــــــــه تحريك النص (( الكلمة ))
با أكثر من طريقة (( بطرق مختلفه )) في الفجول بيسك يكتب الكود ؟؟؟؟؟
***********************************************
أتمني الرد على الموضوع والمساعدة
لو أحد يعرف يكتب الكود ؟؟؟
بسم الله الرحمن الرحيم
هناك طريقة لتحريك النص ، موجودة في موضوع (تصويت: أكواد للمبتدئين) أرجو أن يكون هو المطلوب ، وإليك تحياتي
الاخ (((( عبد الله فتحي ))))
شكرا لك على الرد
ولكن أنا اريد أكثر من طريقه لي تحريك النص
مثلاً يتحرك النص بشكل عمودي افقي دائري طرق مختلفة
أختي شجون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
لتحريك (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
طريقة أخرى
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
وطريقة كمان
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
طريقة ثانية
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
طريقة أحلى
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
طريقة كمان
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
آخر طريقة،،،،،،، وآسف جداً للإزعاج: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
أشكرك جداً جداً وأرجو أن تضيف بعض أكوادك على أكوادي في موضوع
أكواد كثيرة جداً ومفيدة
تأثير على الـ 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
***************************************************
شكراً لك أخي ((((((((((( عبد الله فتحي )))))))))
جزاك الله كل خير
لقد أستفت كثيراً من الاكواد
شكراً على المساعدة لقد تعبتك معاى
*************************************************
##### شجــــــــــــــــون ######
أختي: شجون
إليك تحياتي، كما أتمنى أن تقومي بالتصويت على موضوعي (تصويت: أكواد للمبتدئين)، وأتمنى أن تقومي بزيارة الرابط التالي:
تسلم على الأكواد الجميلة .
أخوك : سعد (f)
بسم الله الرحمن الرحيم
تحياتي الي كل من شارك في هزة المساعدة
كما أرجو ان يوفقني الة في طرح هزة الفكار بخصوص تحريك النص
فأليك تحريك النص في اعلي الفورم وتحريك النص في ليبل وتحريك النص في أدة مخصصة ليزليك وأليكم المزيد عن قريب ان شاء الله
هذا الموضوع مغلق.