döviz kurunu form üzerinde haber gibi kaydırma

[osmn06]

mrb arkadaşlar üstadlar,
ekli dosyadaki kurlar adlı tabloyo logo formununüzerinde yukarı doğru nasıl kaydırırım güncel tarihe göre buğünse bugünü eğer bugün yoksa en güncel tarihi ( kaydıracağı kısımlar tarih.dövizrefno, alış,satış,efalış,efsatış,
üstadlar ilginize tşkler

 

[osmn06]

.

bu konu ile ilgili bilgili arkadaş yokmu ?

 

[osmn06]

hala yokmu bilen

 

[modalı]

Sayın osman06,

Yukarıya doğru kaydırmakla neyi kastediyorsunuz;

TV lerde Gördüğümüz bilgi çubuğu halinde mi istiyorsunuz?

İyi çalışmalar

 

[osmn06]

.

evet sayın modalı aşağıdan yukarı doğru

 

[osmn06]

sayın modalı

Sayın modalı Bu konu ile ilgili bi çalışmanız oldumu acaba

 

[osmn06]

BU konuyu hiç kimse bilmiyormu HELP,HELP,HELP

 

[osmn06]

Sayın Modalı Yardımlarınızı Bekliyorum Lütfen

 

[gulsum1]

cevap

istediğin sanırım böyle bir şeydi

 

[gulsum1]

kodlar

başka bir tür uygulama ama buda yukarı doğru scrolltext
daha basit
Option Compare Database
Option Explicit

Private Declare Function apiGetDeviceCaps Lib "gdi32" _
Alias "GetDeviceCaps" _
(ByVal hdc As Long, _
ByVal nIndex As Long) _
As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const TWIPSPERINCH = 1440

Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type

Private Declare Function apiGetTextMetrics Lib "gdi32.dll" _
Alias "GetTextMetricsA" _
(ByVal hdc As Long, _
lpTextMetric As TEXTMETRIC) _
As Long

Private Declare Function apiGetFocus Lib "user32" _
Alias "GetFocus" _
() As Long

Private Declare Function apiGetDC Lib "user32" _
Alias "GetDC" _
(ByVal hWnd As Long) _
As Long

Private Declare Function apiReleaseDC Lib "user32" _
Alias "ReleaseDC" _
(ByVal hWnd As Long, _
ByVal hdc As Long) _
As Long

Private Declare Sub apiSleep Lib "kernel32" _
Alias "Sleep" _
(ByVal dwMilliseconds As Long)


Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim lngFontHeight As Long
Dim blStartOver As Boolean







Private Sub Form_Timer()
On Error GoTo ErrorPoint

Static lines As Integer
Dim bolLast As Boolean
Dim strTmp As String

If blStartOver = True Then

bolLast = True
blStartOver = False
Me.txtScroll = vbNullString
lines = 0
bolLast = False
End If


strTmp = GetLineOut(lines, bolLast)
Me.txtScroll.Value = Me.txtScroll.Value & strTmp & IIf(bolLast, "", vbCrLf)

If bolLast Then

lines = 0
Else

lines = lines + 1
End If

ExitPoint:
Exit Sub

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Sub

Private Function GetLineOut(ByVal LineNumber As Integer, ByRef bolLast As Boolean) As String
On Error GoTo ErrorPoint

If rst Is Nothing Then
Set db = DBEngine(0)(0)
Set rst = db.OpenRecordset("tblCreditLines", dbOpenTable)
End If

If Me.txtScroll.Top > lngFontHeight Then

If Me.txtScroll.Height + lngFontHeight > 4100 Then

Me.txtScroll = Mid$(Me.txtScroll, InStr(1, Me.txtScroll, vbCrLf) + 2)
Else

Me.txtScroll.Top = Me.txtScroll.Top - lngFontHeight
Me.txtScroll.Height = Me.txtScroll.Height + lngFontHeight
End If
Else
If Me.txtScroll.Top <> 0 Then

Me.txtScroll.Top = 0.2
End If

Me.txtScroll = Mid$(Me.txtScroll, InStr(1, Me.txtScroll, vbCrLf) + 2)
End If

rst.Index = "PrimaryKey"
rst.Seek "=", LineNumber
If Not rst.NoMatch Then
If rst!WaitTime > 0 Then

Call apiSleep(rst!WaitTime * 1000)
End If

GetLineOut = Nz(rst!LineText)
Else

Debug.Print "Line Number not found!"
End If

If rst!IsLast Then

bolLast = True
Me.TimerInterval = 0
rst.Close
Set rst = Nothing
Set db = Nothing
End If

ExitPoint:
Exit Function

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Function

Private Sub GetFontHeight(ctl As Control)
On Error GoTo ErrorPoint

Dim lngRet As Long
Dim hdc As Long
Dim hWnd As Long
Dim udtTM As TEXTMETRIC
Dim lngCharHeight As Long

ctl.Enabled = True
ctl.SetFocus
hWnd = apiGetFocus()
hdc = apiGetDC(hWnd)
lngRet = apiGetTextMetrics(hdc, udtTM)
If Not lngRet = 0 Then
lngFontHeight = udtTM.tmHeight
Call ConvertPIXELSToTWIPS(lngFontHeight, 0)
End If
Call apiReleaseDC(hWnd, hdc)
' Move the focus to the tiny hidden text box
Me.txtFocus.SetFocus
ctl.Enabled = False

ExitPoint:
Exit Sub

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Sub

Sub ConvertPIXELSToTWIPS(x As Long, y As Long)
On Error GoTo ErrorPoint

Dim hdc As Long, hWnd As Long, RetVal As Long
Dim XPIXELSPERINCH As Long, YPIXELSPERINCH As Long

hdc = apiGetDC(0)
XPIXELSPERINCH = apiGetDeviceCaps(hdc, LOGPIXELSX)
YPIXELSPERINCH = apiGetDeviceCaps(hdc, LOGPIXELSY)
RetVal = apiReleaseDC(0, hdc)
x = (x / XPIXELSPERINCH) * TWIPSPERINCH
y = (y / YPIXELSPERINCH) * TWIPSPERINCH

ExitPoint:
Exit Sub

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Sub

Private Sub tabAbout_Change()
On Error GoTo ErrorPoint

If Me.tabAbout.Value = 0 Then

Me.txtScroll = vbNullString
Me.TimerInterval = 0
blStartOver = True
Else

Me.Painting = False
Call GetFontHeight(Me.txtScroll)
Me.txtScroll = vbNullString
Me.txtScroll.Height = lngFontHeight
Me.txtScroll.Top = Me.tabAbout.Height - lngFontHeight
Me.Painting = True
Me.TimerInterval = 700
End If

ExitPoint:
Exit Sub

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Sub

 

[assenucler]

Sn. gulsum1;

Teşekkürler hocam..

Sevgi ve saygılar.