Тормоза от работы с тремя сом портами.

[TiG]

В таймере с интервалом 1000 мс прописано выплевывать данные на 3 компорта. Наблюдется торможение программы в момент выплевывания, практически зависание. Как быть подскажите плз.

П.С. Комп достаточно мощьный 1.8 целер.

[Konst_One]

размер буфера передачи увеличь и поставь галочку для FIFO
может в алгоритме, что не так и дабавь в таймер DoEvents

[TiG]

Размер буфера пробовали увеличивать, не помогло. А шо це FIFO, где эту галочку увидеть)

П.С. Если на 1 порт плювать, то норма, на два похуже, на 3 плехо(

[Konst_One]

FIFO UART - см в настройках самого com-порта в диспетчере устройств
это такая мелкосхема (если есть конечно, обычно уже всегда есть) на плате, которая буферизует данные для порта ввода-вывода

[Konst_One]

еще может проблема в самом приемном устройстве, которое на com-порте висит.
просто оно медленно принимает данные. если есть возможность, то лучше увеличить скорость до 115200

[TiG]

Дело в том что программа тормозит одинакого как при подключенных устройствах, так и без оных. Скорость обмена 4800.

П.С. FIFO по умолчанию стоит.

[Konst_One]

а каков объем передаваемых данных каждые 1000мс?
попробуйте посчитать пропускную способность канала из расчета скорости соединения 4800 и объема данных в бит/сек

если слишком много для 1с , то увеличьте интервал опроса устройств

может стоит присмотреться к платам расширетелям com-портов с более серьезными UART?

[TiG]

Сее передаем, тут нема 4800 на глаз если прикинуть)
$GPGGA,151550.00,5956.75,N,03018.32,W,1,03,002,0015,M,-00025,M*4C
$GPZDA,151550,22,06,2005,-03,,*4E
$GPVTG,000.0,T,,M,00.0,N,23.2,K*63
$IIVHW,000.0,T,,M,00.0,N,23.2,K*78
$HEHDT,000.0,T*2F

Плата расширения очень серьезная, а вот принимающие законсервированы военным реестром.

[Konst_One]

да, данных не много

посмотрите внимательно еще разок на процедурки отправки, котрые вы по таймеру вызываете. DoEvents в таймере проставили?
Если не сложно, то привидите код , котрый вы по таймеру выполняете, может что найдем интересное.

[TiG]

Код: Выделить всё

Private Sub Timer5_Timer()
Dim p1 As Integer
Dim minn, horr, secc, dayy, montt As String
horr = Hour(Time)
minn = Minute(Time)
secc = Second(Time)
dayy = Day(Date)
montt = Month(Date)
DoEvents

Text15.Text = f1 & f2 & f3 & f4 & f5
Text11.Text = MSComm1.Input
p1 = InStr(1, Text11.Text, "$HEHDT", vbTextCompare)
If p1 > 0 Then p2 = InStr(1, Text11.Text, "chr(10)", vbTextCompare)

If p2 - p1 <> 0 Then Text14.Text = Mid(Text11.Text, 8, 5)
Form1.Text14.Text = Text14.Text
Form2.Text14.Text = Text14.Text
Form3.Text14.Text = Text14.Text
Form5.Text1.Text = Text14.Text




If Day(Date) < 10 Then dayy = "0" & Day(Date)
If Month(Date) < 10 Then montt = "0" & Month(Date)
If Hour(Time) < 10 Then horr = "0" & Hour(Time)
If Minute(Time) < 10 Then minn = "0" & Minute(Time)
If Second(Time) < 10 Then secc = "0" & Second(Time)
Text12.Text = horr & minn & secc

Text13.Text = dayy & "," & montt & "," & Year(Date)


test = "GPGGA,155750,3742.75,N,12203.32,W,1,03,002,0015,M,-00025,M"

f11 = "GPGGA," & Text12.Text & ".00,5956.75,N,03018.32,W,1,03,002,0015,M,-00025,M"
f1 = "$GPGGA," & Text12.Text & ".00,5956.75,N,03018.32,W,1,03,002,0015,M,-00025,M*" & kont_summ(f11) & Chr(13) & Chr(10)

f22 = "GPZDA," & Text12.Text & "," & Text13.Text & ",-03,,"
f2 = "$GPZDA," & Text12.Text & "," & Text13.Text & ",-03,,*" & kont_summ(f22) & Chr(13) & Chr(10)

f33 = "GPVTG," & Text14.Text & ",T,,M," & mid_point(CCur(Text4.Text)) & ",N,23.2,K"
f3 = "$GPVTG," & Text14.Text & ",T,,M," & mid_point(CCur(Text4.Text)) & ",N,23.2,K*" & kont_summ(f33) & Chr(13) & Chr(10)

f44 = "IIVHW," & Text14.Text & ",T,,M," & mid_point(speed) & ",N,23.2,K"
f4 = "$IIVHW," & Text14.Text & ",T,,M," & mid_point(speed) & ",N,23.2,K*" & kont_summ(f44) & Chr(13) & Chr(10)

f55 = "HEHDT," & Text14.Text & ",T"
f5 = "$HEHDT," & Text14.Text & ",T*" & kont_summ(f55) & Chr(13) & Chr(10)


MSComm1.Output = f1 & f2 & f3 & f4 & f5
MSComm2.Output = f1 & f2 & f3 & f4 & f5

End Sub


[TiG]

Код: Выделить всё

Dim xa As POINTAPI
Dim xb As POINTAPI
Dim scrolcren, scroldiff, tenter, texit As Long
Dim pusk, i, zasl, xaL(7), xaR(7) As Integer
Dim polzL, polzR, chast, temper, narabotka As Currency
Dim T As Long
Dim ss As Integer
Dim f1, f2, f3, f4, f5, f11, f22, f33, f44, f55 As String
Const pi = 3.1415926

Private Sub Command2_Click(Index As Integer)
ss = ss + 1
If ss > 1 Then ss = 0

If ss = 1 Then Form1.Timer7.Enabled = True
If ss = 0 Then Form1.Timer7.Enabled = False
If ss = 0 Then Form1.Timer8.Enabled = False
If ss = 0 Then Form1.Timer9.Enabled = False
If ss = 0 Then Form1.Timer10.Enabled = False

If ss = 0 Then Form1.Image6.Visible = True
If ss = 1 Then Form1.Image6.Visible = False


If pusk = 0 Then
pusk = 1
Command2(0).Picture = LoadPicture("bmp\stop.bmp")
Command2(1).Picture = LoadPicture("bmp\stop.bmp")
HScroll1.Enabled = True
Text5.Text = "8.0"
Text6.Text = "8.0"
Text9(2).Text = "3.5"
Text9(10).Text = "3.5"
xaL(2) = 218
xaR(2) = 897
Text9(3).Text = "2.5"
Text9(11).Text = "2.5"
xaL(3) = 161
xaR(3) = 840
x52.x = 442
x52.y = 196
x62.x = 801
x62.y = 196
Timer2.Enabled = True
Else
pusk = 0
Command2(0).Picture = LoadPicture("bmp\pusk.bmp")
Command2(1).Picture = LoadPicture("bmp\pusk.bmp")
HScroll1.Enabled = False
x52.x = 411
x52.y = 272
x62.x = 769
x62.y = 272
Text5.Text = "0"
Text6.Text = "0"
xaL(2) = 25
xaR(2) = 702
xaL(3) = 25
xaR(3) = 702
Text9(2).Text = "0"
Text9(10).Text = "0"
Text9(3).Text = "0"
Text9(11).Text = "0"
Timer2.Enabled = False
End If
HScroll1.Value = 500

End Sub

Private Sub Form_Load()
MSComm1.PortOpen = True
MSComm2.PortOpen = True
narabotka = 128.2
Text10(0).Text = 0
Text10(1).Text = 0
Text10(2).Text = 1
Text10(3).Text = 2
Text10(4).Text = 8
Text10(5).Text = 2
zasl = 0
speed = 0#
chast = 0
PenW.Style = PS_SOLID
PenW.Color = &HFF00FF
PenW.Width.x = 4
PenW.Width.y = 0
x1.x = 270
x1.y = 411
x2.x = 1224
x2.y = 412
x12.x = 63
x12.y = 411
x22.x = 1018
x22.y = 411

x3.x = 516
x3.y = 433
x4.x = 874
x4.y = 433
x32.x = 410
x32.y = 433
x42.x = 768
x22.y = 433

x5.x = 517
x5.y = 272
x6.x = 875
x6.y = 272
x52.x = 411
x52.y = 272
x62.x = 769
x62.y = 272
Text5.Text = "0"
Text6.Text = "0"
Text7.Text = "0"
Text8.Text = "0"
xaL(2) = 25
xaR(2) = 702
xaL(3) = 25
xaR(3) = 702
Text9(2).Text = "0"
Text9(10).Text = "0"
Text9(3).Text = "0"
Text9(11).Text = "0"
Text9(7).Text = "125"
Text9(15).Text = "125"
xaL(6) = 366
xaR(6) = 1045
Text9(6).Text = "0"
Text9(14).Text = "0"

Call create_0
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Destroy
End Sub

Private Sub line_0()
Dim a, aa As POINTAPI
Dim b As Boolean
a = MoveToEx(MDC1, xa.x, xa.y, aa)
b = LineTo(MDC1, xb.x, xb.y)
End Sub

Private Sub refr()
Dim temp_bmp As String
BitBlt MDC1, 0, 0, 1280, 1024, MDC2, 0, 0, SRCCOPY
'øêàëà êðåíà
BitBlt MDC1, 549, 171, 172, 56, MDC11, scrolcren, 0, SRCCOPY
BitBlt MDC1, 585, 192, 100, 76, MDC8, 0, 0, SRCPAINT
BitBlt MDC1, 585, 192, 100, 76, MDC7, 0, 0, SRCAND
BitBlt MDC1, 585, 192, 100, 76, MDC7, 0, 0, SRCAND
'øêàëà äèôôåðåíòà
BitBlt MDC1, 574, 328, 62, 118, MDC12, 0, scroldiff, SRCCOPY
BitBlt MDC1, 603, 368, 122, 41, MDC10, 0, 0, SRCPAINT
BitBlt MDC1, 603, 368, 122, 41, MDC9, 0, 0, SRCAND
BitBlt MDC1, 603, 368, 122, 41, MDC9, 0, 0, SRCAND

BitBlt MDC1, polzL, 850, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, polzL, 850, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, polzL, 850, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, polzR, 850, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, polzR, 850, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, polzR, 850, 15, 25, MDC3, 0, 0, SRCAND


BitBlt MDC1, tenter, 473, 15, 25, MDC14, 0, 0, SRCPAINT
BitBlt MDC1, tenter, 473, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter, 473, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter + 679, 473, 15, 25, MDC14, 0, 0, SRCPAINT
BitBlt MDC1, tenter + 679, 473, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter + 679, 473, 15, 25, MDC13, 0, 0, SRCAND

BitBlt MDC1, texit, 528, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, texit, 528, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit, 528, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit + 679, 528, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, texit + 679, 528, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit + 679, 528, 15, 25, MDC3, 0, 0, SRCAND

BitBlt MDC1, xaL(2), 612, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaL(2), 612, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaL(2), 612, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(2), 612, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaR(2), 612, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(2), 612, 15, 25, MDC3, 0, 0, SRCAND

BitBlt MDC1, xaL(3), 677, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaL(3), 677, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaL(3), 677, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(3), 677, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaR(3), 677, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(3), 677, 15, 25, MDC3, 0, 0, SRCAND

BitBlt MDC1, tenter, 728, 15, 25, MDC14, 0, 0, SRCPAINT
BitBlt MDC1, tenter, 728, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter, 728, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter + 679, 728, 15, 25, MDC14, 0, 0, SRCPAINT
BitBlt MDC1, tenter + 679, 728, 15, 25, MDC13, 0, 0, SRCAND
BitBlt MDC1, tenter + 679, 728, 15, 25, MDC13, 0, 0, SRCAND

BitBlt MDC1, texit, 783, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, texit, 783, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit, 783, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit + 679, 783, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, texit + 679, 783, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, texit + 679, 783, 15, 25, MDC3, 0, 0, SRCAND

BitBlt MDC1, xaL(6), 929, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaL(6), 929, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaL(6), 929, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(6), 929, 15, 25, MDC4, 0, 0, SRCPAINT
BitBlt MDC1, xaR(6), 929, 15, 25, MDC3, 0, 0, SRCAND
BitBlt MDC1, xaR(6), 929, 15, 25, MDC3, 0, 0, SRCAND

MDC5 = CreateCompatibleDC(CDC)
MDC6 = CreateCompatibleDC(CDC)

Select Case zasl
Case 0: temp_bmp = "bmp\zasl_r.bmp"
Case 1: temp_bmp = "bmp\zasl_close.bmp"
Case 2: temp_bmp = "bmp\zasl_a.bmp"
Case 3: temp_bmp = "bmp\zasl_close.bmp"
End Select
oldobj4 = SelectObject(MDC5, LoadPicture(temp_bmp))
oldobj5 = SelectObject(MDC6, LoadPicture("bmp\zasl_mask.bmp"))
BitBlt MDC1, 320, 394, 60, 60, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 320, 394, 60, 60, MDC5, 0, 0, SRCAND
BitBlt MDC1, 320, 394, 60, 60, MDC5, 0, 0, SRCAND
BitBlt MDC1, 898, 393, 60, 60, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 898, 393, 60, 60, MDC5, 0, 0, SRCAND
BitBlt MDC1, 898, 393, 60, 60, MDC5, 0, 0, SRCAND
newobj = SelectObject(MDC6, oldobj5)
DeleteObject newobj
newobj = SelectObject(MDC5, oldobj4)
DeleteObject newobj

xa = x1
xb = x12
Call line_0
xa = x2
xb = x22
Call line_0
oldobj4 = SelectObject(MDC5, LoadPicture("bmp\oborot.bmp"))
oldobj5 = SelectObject(MDC6, LoadPicture("bmp\oborot_mask.bmp"))
BitBlt MDC1, 171, 319, 144, 129, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 171, 319, 144, 129, MDC5, 0, 0, SRCAND
BitBlt MDC1, 171, 319, 144, 129, MDC5, 0, 0, SRCAND
BitBlt MDC1, 1125, 320, 144, 129, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 1125, 320, 144, 129, MDC5, 0, 0, SRCAND
BitBlt MDC1, 1125, 320, 144, 129, MDC5, 0, 0, SRCAND
newobj = SelectObject(MDC6, oldobj5)
DeleteObject newobj
newobj = SelectObject(MDC5, oldobj4)
DeleteObject newobj
xa = x3
xb = x32
Call line_0
xa = x4
xb = x42
Call line_0
oldobj4 = SelectObject(MDC5, LoadPicture("bmp\tempoug.bmp"))
oldobj5 = SelectObject(MDC6, LoadPicture("bmp\tempoug_mask.bmp"))
BitBlt MDC1, 451, 366, 85, 86, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 451, 366, 85, 86, MDC5, 0, 0, SRCAND
BitBlt MDC1, 451, 366, 85, 86, MDC5, 0, 0, SRCAND
BitBlt MDC1, 809, 366, 85, 86, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 809, 366, 85, 86, MDC5, 0, 0, SRCAND
BitBlt MDC1, 809, 366, 85, 86, MDC5, 0, 0, SRCAND
newobj = SelectObject(MDC6, oldobj5)
DeleteObject newobj
newobj = SelectObject(MDC5, oldobj4)
DeleteObject newobj

xa = x5
xb = x52
Call line_0
xa = x6
xb = x62
Call line_0
oldobj4 = SelectObject(MDC5, LoadPicture("bmp\dm.bmp"))
oldobj5 = SelectObject(MDC6, LoadPicture("bmp\dm_mask.bmp"))
BitBlt MDC1, 452, 205, 79, 81, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 452, 205, 79, 81, MDC5, 0, 0, SRCAND
BitBlt MDC1, 452, 205, 79, 81, MDC5, 0, 0, SRCAND
BitBlt MDC1, 810, 205, 79, 81, MDC6, 0, 0, SRCPAINT
BitBlt MDC1, 810, 205, 79, 81, MDC5, 0, 0, SRCAND
BitBlt MDC1, 810, 205, 79, 81, MDC5, 0, 0, SRCAND
newobj = SelectObject(MDC6, oldobj5)
DeleteObject newobj
newobj = SelectObject(MDC5, oldobj4)
DeleteObject newobj

DeleteDC MDC5
DeleteDC MDC6


BitBlt CDC, 0, 0, 1280, 1024, MDC1, 0, 0, SRCCOPY
End Sub

Private Sub Image_timer_Click()
Text_Timer.Text = 0
Image_timer.Visible = False
End Sub

Private Sub Image1_Click(Index As Integer)
zasl = zasl + 1
If zasl > 3 Then zasl = 0
End Sub

Private Sub Image2_Click()
Form3.Show
End Sub

Private Sub Timer_Timer()
T = T - 1
    If T = 3 Then Call sndPlaySound("sound\timer.wav", 1)
    If T < 0 Then
        T = 0
        Text_Timer.ToolTipText = "Äâîéíîé êëèê -->Ââåäèòå êîëëè÷åñòâî ìèíóò 0..60 (áåç ñåêóíä), ëèáî â ðàçðÿäíîì ôîðìàòå òèïà 15,5"
        Timer.Enabled = False
        ZERO_TIMER.Visible = False
        VKL_TIMER.Visible = True
        Form2.ZERO_TIMER.Visible = False
        Form2.VKL_TIMER.Visible = True
        Form3.ZERO_TIMER.Visible = False
        Form3.VKL_TIMER.Visible = True
        Form1.ZERO_TIMER.Visible = False
        Form1.VKL_TIMER.Visible = True
        Form5.ZERO_TIMER.Visible = False
        Form5.VKL_TIMER.Visible = True
       
       
   
    End If
   
    Text_Timer.Text = (T \ 60) & ":" & ((T \ 10) Mod 6) & (T Mod 10)
    If Text_Timer.Text = "0:00" Then Text_Timer.Text = 0
   
End Sub

Private Sub Timer1_Timer()
Dim angle, angle1, w, scrol, tp, tmp0, tmpp0, tmpp1, tmpp2 As Currency
Static T As Currency
w = Sin(pi * T / 180#)
T = T + 3
If T = 360 Then T = 0
'÷àñòîòà
tmpp2 = HScroll1.Value * pusk
If chast < tmpp2 Then chast = chast + 25
If chast > tmpp2 Then chast = chast - 25
Text1(0).Text = CStr(chast)
Text1(1).Text = Text1(0).Text
angle = chast * 90# / 3000#
tmpp1 = Cos(pi / 180 * angle)
x12.x = x1.x - 206 * tmpp1
x12.y = x1.y - 206 * Sin(pi / 180 * angle)
x22.x = x2.x - 206 * tmpp1
x22.y = x12.y
If chast > 750 Then
tmp0 = 0.025 * (chast - 500)
Else: tmp0 = 0
End If
'skorost lag
If speed < tmp0 Then speed = speed + 0.2
If speed > tmp0 Then speed = speed - 0.2
'òåìïåðàòóðà
If chast <= 500 Then
tmpp0 = 0.9 * chast / 100
If temper < tmpp0 Then temper = temper + 0.1
If temper > tmpp0 Then temper = temper - 0.1
End If
If chast > 500 Then
tmpp0 = 4.5 + chast / 1500
If temper < tmpp0 Then temper = temper + 0.1
If temper > tmpp0 Then temper = temper - 0.1
End If
Text7.Text = CStr(Round(temper * 100, 0))
Text8.Text = Text7.Text
If temper > 3 Then
angle = (temper - 3) * 19       ' (18)!!
Else
angle = 0
End If
tmpp1 = Cos(pi / 180 * angle)
x32.x = x3.x - 106 * tmpp1
x32.y = x3.y - 106 * Sin(pi / 180 * angle)
x42.x = x4.x - 106 * tmpp1
x42.y = x32.y
Text9(6).Text = CStr(Round(1.4 * speed / 60, 2))
Text9(14).Text = Text9(6).Text

' Âû÷èñëÿåòñÿ ñäâèã øêàëû êðåíà
scrol = 9 * w
scrolcren = scrol \ 1 + 155
Text2.Text = CStr(Round(scrol / 6#, 1))
' Âû÷èñëÿåòñÿ ñäâèã øêàëû äèôôåðåíòà
scrol = 12 * w
scroldiff = scrol \ 1 + 180
Text3.Text = CStr(Round(-1# * scrol / 6#, 1))

polzL = 22 + 390 * speed / 60
polzR = 22 + 390 * speed / 60 + 679

If chast < 500 Then
tenter = 110 + 44# / 500 * chast
texit = 110 + chast / 5
Text9(0).Text = CStr(Round(22 + 13# / 500 * chast, 1))
Text9(1).Text = CStr(Round(22 + 27# / 500 * chast, 1))
End If
Text9(8).Text = Text9(0).Text
Text9(9).Text = Text9(1).Text
Text9(4).Text = Text9(0).Text
Text9(5).Text = Text9(1).Text
Text9(12).Text = Text9(0).Text
Text9(13).Text = Text9(1).Text
Call refr
End Sub

Private Sub Timer2_Timer()
Dim tnarab As String
Dim klm As Integer
Static ijk As Integer
ijk = ijk + 1
If ijk = 360 Then       ' 6 minut (0.1 h)
ijk = 0
narabotka = narabotka + 0.1
End If
tnarab = format0(5, 1, narabotka)
For klm = 0 To 4
Text10(klm).Text = Mid(tnarab, klm + 1, 1)
Next klm
Text10(5).Text = Mid(tnarab, 7, 1)
End Sub

Private Function format0(x1f, x2f, e) As String
Dim d, c(20) As String
Dim ij, z, zap, doz, poz As Integer
zap = -1
d = ""
z = Len(e)
For ij = 1 To z
    c(ij) = Mid(e, ij, 1)
        If c(ij) = "," Then
        zap = ij
        poz = z - zap
        doz = z - poz - 1
        End If
Next ij
If zap > 0 Then
    For ij = 1 To x1f - doz
    d = d + "0"
    Next ij
    For ij = 1 To zap
    d = d + c(ij)
    Next ij
        If x2f >= poz Then
            For ij = zap + 1 To z
            d = d + c(ij)
            Next ij
                If x2f > poz Then
                    For ij = 1 To x2f - poz
                    d = d + "0"
                    Next ij
                End If
        End If
        If x2f < poz Then
            For ij = 1 To x2f
            d = d + c(zap + ij)
            Next ij
        End If
Else
    For ij = 1 To x1f - z
    d = d + "0"
    Next ij
    For ij = 1 To z
    d = d + c(ij)
    Next ij
    d = d + "."
    For ij = 1 To x2f
    d = d + "0"
    Next ij
End If
format0 = d
End Function

Private Sub Timer3_Timer()
'skorost gnss
If chast > 750 Then
Text4.Text = CStr(Round(speed + Rnd, 1))
Else
Text4.Text = "0"
End If
pole_time.Text = Time
pole_data.Text = Date

End Sub

Private Sub Timer4_Timer()
If Form3.Timer = True Then Text_Timer = Form3.Text_Timer
If Form1.Timer = True Then Text_Timer = Form1.Text_Timer
If Form2.Timer = True Then Text_Timer = Form2.Text_Timer
If Form5.Timer = True Then Text_Timer = Form5.Text_Timer
End Sub

Private Sub VKL_TIMER_Click()
If Text_Timer < 61 Then
VKL_TIMER.Visible = False
ZERO_TIMER.Visible = True
Form2.VKL_TIMER.Visible = False
Form2.ZERO_TIMER.Visible = True
Form3.VKL_TIMER.Visible = False
Form3.ZERO_TIMER.Visible = True
Form1.VKL_TIMER.Visible = False
Form1.ZERO_TIMER.Visible = True
Form5.VKL_TIMER.Visible = False
Form5.ZERO_TIMER.Visible = True

Timer.Enabled = True
Text_Timer.ToolTipText = "Âíèìàíèå!!! Òàéìåð âêëþ÷¸í! Ïåðåä ââîäîì íîâîãî çíà÷åíèÿ òàéìåð ñëåäóåò îáíóëèòü!"

Else
Image_timer.Visible = True
Image_timer.ZOrder
Image_timer.ShowWhatsThis

End If
T = Text_Timer.Text * 60
End Sub

Private Sub ZERO_TIMER_Click()
Timer.Enabled = False
Form1.Timer.Enabled = False
Form2.Timer.Enabled = False
Form3.Timer.Enabled = False
Form5.Timer.Enabled = False
Text_Timer.Text = 0
Form2.Text_Timer.Text = 0
Form3.Text_Timer.Text = 0
Form1.Text_Timer.Text = 0
Form5.Text_Timer.Text = 0

ZERO_TIMER.Visible = False
VKL_TIMER.Visible = True
Form2.ZERO_TIMER.Visible = False
Form2.VKL_TIMER.Visible = True
Form3.ZERO_TIMER.Visible = False
Form3.VKL_TIMER.Visible = True
Form1.ZERO_TIMER.Visible = False
Form1.VKL_TIMER.Visible = True
Form5.ZERO_TIMER.Visible = False
Form5.VKL_TIMER.Visible = True
Text_Timer.ToolTipText = "Äâîéíîé êëèê -->Ââåäèòå êîëëè÷åñòâî ìèíóò 0..60 (áåç ñåêóíä), ëèáî â ðàçðÿäíîì ôîðìàòå òèïà 15,5"
End Sub

















Private Sub Timer5_Timer()
Dim p1 As Integer
Dim minn, horr, secc, dayy, montt As String
horr = Hour(Time)
minn = Minute(Time)
secc = Second(Time)
dayy = Day(Date)
montt = Month(Date)
DoEvents

Text15.Text = f1 & f2 & f3 & f4 & f5
Text11.Text = MSComm1.Input
p1 = InStr(1, Text11.Text, "$HEHDT", vbTextCompare)
If p1 > 0 Then p2 = InStr(1, Text11.Text, "chr(10)", vbTextCompare)

If p2 - p1 <> 0 Then Text14.Text = Mid(Text11.Text, 8, 5)
Form1.Text14.Text = Text14.Text
Form2.Text14.Text = Text14.Text
Form3.Text14.Text = Text14.Text
Form5.Text1.Text = Text14.Text




If Day(Date) < 10 Then dayy = "0" & Day(Date)
If Month(Date) < 10 Then montt = "0" & Month(Date)
If Hour(Time) < 10 Then horr = "0" & Hour(Time)
If Minute(Time) < 10 Then minn = "0" & Minute(Time)
If Second(Time) < 10 Then secc = "0" & Second(Time)
Text12.Text = horr & minn & secc

Text13.Text = dayy & "," & montt & "," & Year(Date)


test = "GPGGA,155750,3742.75,N,12203.32,W,1,03,002,0015,M,-00025,M"

f11 = "GPGGA," & Text12.Text & ".00,5956.75,N,03018.32,W,1,03,002,0015,M,-00025,M"
f1 = "$GPGGA," & Text12.Text & ".00,5956.75,N,03018.32,W,1,03,002,0015,M,-00025,M*" & kont_summ(f11) & Chr(13) & Chr(10)

f22 = "GPZDA," & Text12.Text & "," & Text13.Text & ",-03,,"
f2 = "$GPZDA," & Text12.Text & "," & Text13.Text & ",-03,,*" & kont_summ(f22) & Chr(13) & Chr(10)

f33 = "GPVTG," & Text14.Text & ",T,,M," & mid_point(CCur(Text4.Text)) & ",N,23.2,K"
f3 = "$GPVTG," & Text14.Text & ",T,,M," & mid_point(CCur(Text4.Text)) & ",N,23.2,K*" & kont_summ(f33) & Chr(13) & Chr(10)

f44 = "IIVHW," & Text14.Text & ",T,,M," & mid_point(speed) & ",N,23.2,K"
f4 = "$IIVHW," & Text14.Text & ",T,,M," & mid_point(speed) & ",N,23.2,K*" & kont_summ(f44) & Chr(13) & Chr(10)

f55 = "HEHDT," & Text14.Text & ",T"
f5 = "$HEHDT," & Text14.Text & ",T*" & kont_summ(f55) & Chr(13) & Chr(10)


MSComm1.Output = f1 & f2 & f3 & f4 & f5
MSComm2.Output = f1 & f2 & f3 & f4 & f5

End Sub

Function mid_point(xxxxx As Currency) As String
Dim vcomp_t As Currency
Dim vcomp_s As String
vcomp_t = Round(xxxxx, 1)
vcomp_s = vcomp_t
If vcomp_t < 10 Then vcomp_s = "0" & vcomp_t
If vcomp_t \ 1 = vcomp_t Then
vcomp_s = vcomp_s + ".0"
Else
vcomp_s = Left(vcomp_s, 2) & "." & Right(vcomp_s, 1)
End If
mid_point = vcomp_s
End Function




' lag  mid_point(speed)
' gnns mid_point(CCur(text4.text))




Private Function kont_summ(OutB1)
       Dim ksi(2) As Byte
        ksi(0) = 0
        For i = 1 To Len(OutB1)
            ksi(0) = ksi(0) Xor Asc(Right(Left(OutB1, i), 1))
        Next i
        ksi(1) = Int(ksi(0) / 16)
        ksi(0) = ksi(0) Mod 16
        For i = 0 To 1
        Select Case ksi(i)
            Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
                ksi(i) = ksi(i) + 48
            Case 10
                ksi(i) = Asc("A")
            Case 11
                ksi(i) = Asc("B")
            Case 12
                ksi(i) = Asc("C")
            Case 13
                ksi(i) = Asc("D")
            Case 14
                ksi(i) = Asc("E")
            Case 15
                ksi(i) = Asc("F")
        End Select
        Next i
        kont_summ = Chr(ksi(1)) & Chr(ksi(0))
End Function











[Konst_One]

попробуй для начала в процедуре Timer5_Timer() присвоить каким-нибудь локальным переменным значегния из твоих текстбоксов text14 и тп, чтобы их потом можно было повторно быстрее использовать.

поставь после

Код: Выделить всё

Form5.Text1.Text = Text14.Text
Doevents

и после

Код: Выделить всё

MSComm1.Output = f1 & f2 & f3 & f4 & f5
Doevents
MSComm2.Output = f1 & f2 & f3 & f4 & f5
doevents

выстави OutBufferSize=1024 для MSCOMM1 при инициализации и вообще, я что-то не увидел, где задается настройка порта


[/syntax]

[Konst_One]

должно быть примерно так:

Код: Выделить всё

   With Me.MSComm1
   
      .CommPort = 1
      .DTREnable = True
      .Handshaking = comRTS
      .InBufferSize = 0
      .InputLen = 0
      .InputMode = comInputModeText
      .NullDiscard = True
      .OutBufferSize = 1024
      .ParityReplace = "?"
      .RThreshold = 1
      .SThreshold = 1

      .RTSEnable = True
      .Settings = "4800, n, 8, 1"
       
      .PortOpen = True
     
   End With

[TiG]

не в коде задаю, а на форме в свойствах значка))

П.С. щяс попробую

[Konst_One]

у тебя очень много форм с контролами, котрые рефрешатся по нескольким таймерам - может проблема в них еще

[TiG]

Сделал вышеуказанное, стало менее прерывисто, но очень незначительное улучшение.

В пустом проекте просто выплевывал на 3 порта, без контролов и т.п, таже беда.

Роляет только скорость обмена. Если выставить 19200 проблемма исчецает, но мне надо именно 4800 (

[Konst_One]

видно все-таки проблема с принимающим оборудованием
или придется запускать отдельно по программе на каждый com-порт, чтобы они работали в разных потоках

[TiG]

Да оборудование даже не подключаю, оно виновато только в том что только низкую скорость поддерживает.

В разные таймера пихал с расхождением в 300 мс, немного помогло. Как в разных потоках пускануть?

[Konst_One]

нужно, чтобы твоя прога работала только с одним настроенным com-портом, а потом запускать несколько ее экземпляров с указанием каждому из них с каким портом он работает.

все это , если конечно , логика твоей программы поддерживает.

а вообще разделение по времени обработки таймеров - это правильный путь, чтобы они друг дружке не мешали, если возможно, то таймеры, отвечающие за отображение дополнительной информации - можно немного притормозить или включать обработку в них , например , через раз или по мере накопления инфы

[TiG]

угу, сенк)