Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 23.12.2010, 20:38
Jerrick Jerrick вне форума
Прохожий
 
Регистрация: 23.12.2010
Сообщения: 9
Репутация: 10
По умолчанию Помогите перевести код с VB на Delphi

Товарищи, очень нужна ваша помощь!
описание форм не выкладываю... Откликнувшимся заранее огромное спасибо!!!

//..........frmSettings.frm..............
Код:
Attribute VB_Name = "frmSettings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdOk_Click()
  PortName = txtPort
  Koefin = Val(txtKin)
  Koefout = Val(txtKout)
  PathStprokat = txtPathStPr
  PathBase = txtpathDonix
  
  If Len(PortName) = 0 Then PortName = "Com1"
  If Koefin <= 0 Then Koefin = 1
  If Koefout <= 0 Then Koefout = 1
  If Len(PathStprokat) = 0 Then PathStprokat = "\\helios\ves_oc\inb\"
  If Len(PathBase) = 0 Then PathBase = "\\helios\donix\"
  
  Open App.path & "\Slb.ini" For Output As #1
    Print #1, PortName
    Print #1, Koefin
    Print #1, Koefout
    Print #1, PathStprokat
    Print #1, PathBase
  Close #1
  
  Unload Me
End Sub
Private Sub Form_Activate()
  txtPort = PortName
  txtKin = Koefin
  txtKout = Koefout
  txtPathStPr = PathStprokat
  txtpathDonix = PathBase
End Sub

Последний раз редактировалось Admin, 23.12.2010 в 20:41.
Ответить с цитированием
  #2  
Старый 23.12.2010, 20:40
Jerrick Jerrick вне форума
Прохожий
 
Регистрация: 23.12.2010
Сообщения: 9
Репутация: 10
По умолчанию

//......................frmMain.frm................. .......

Код:
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
                                                  ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

' Used by the OpenProcess API call
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_SET_INFORMATION As Long = &H200

' Used by SetPriorityClass
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const BELOW_NORMAL_PRIORITY_CLASS = 16384
Private Const ABOVE_NORMAL_PRIORITY_CLASS = 32768
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100

Public Enum ProcessPriorities
  ppidle = IDLE_PRIORITY_CLASS
  ppbelownormal = BELOW_NORMAL_PRIORITY_CLASS
  ppAboveNormal = ABOVE_NORMAL_PRIORITY_CLASS
  ppNormal = NORMAL_PRIORITY_CLASS
  ppHigh = HIGH_PRIORITY_CLASS
  ppRealtime = REALTIME_PRIORITY_CLASS
End Enum

Private Sub TestConnection()
On Error GoTo TestConnectionErr

  Set con = New ADODB.Connection
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & PathBase & ";Extended Properties=DBase IV"
  
  conState = True
  Exit Sub
TestConnectionErr:
  MsgBox "Отсутствует подключение к базе", vbCritical + vbOKOnly, "ОШИБКА"
  conState = False
End Sub

Private Sub Form_Activate()
  If DebugMode Then lblDeb.Visible = True: lblDeb = Sost.Ns & " " & Sost.Napr
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Static est As String
  est = est & Chr(KeyAscii)
  If Len(est) > 3 Then est = Right$(est, 3)
  If est = "egy" Then DebugMode = True: mnuTest.Visible = True
End Sub

Private Sub Form_Load()
Dim ProcessID As Long
Dim hProc As Long
Const fdwAccess1 As Long = PROCESS_QUERY_INFORMATION Or PROCESS_SET_INFORMATION

  If App.PrevInstance = True Then
    MsgBox "Программа СЛЯБИНГ уже загружена. Не надо вызывать ее еще раз.", 16, "Ошибка пользователя"
    End
  End If

  ProcessID = GetCurrentProcessId()
  hProc = OpenProcess(fdwAccess1, 0&, ProcessID)
  If hProc Then
    SetPriorityClass hProc, ppHigh
    CloseHandle hProc
  End If

  If Environ$("USERNAME") = "egy" Then
    DebugMode = True
    mnuTest.Visible = True
  End If

  ' Загрузка настроек
  If Len(Dir$(App.path & "\Slb.ini")) > 0 Then
    Open App.path & "\Slb.ini" For Input As #1
      Input #1, PortName
      Input #1, Koefin
      Input #1, Koefout
      Line Input #1, PathStprokat
      Line Input #1, PathBase
    Close #1
  Else
    PortName = "Com1"
    Koefin = 1
    Koefout = 1
    PathStprokat = "\\helios\ves_oc\inb\"
    PathBase = "\\helios\donix\"
  End If

  If Len(Dir$(App.path & "\Data.bin")) > 0 Then
    Open App.path & "\Data.bin" For Binary As #1
      Get #1, , Sost
    Close #1
  Else
    Sost.Ns = 1
    Sost.Napr = 1
  End If

  Ns = Sost.Ns

  TestConnection

  If Not DebugMode Then Operator = InputBox("ВВЕДИТЕ ВАШУ ФАМИЛИЮ", "Ф.И.О. ОПЕРАТОРА") Else Operator = "EGY"
End Sub
Private Sub Form_Unload(Cancel As Integer)
  End
End Sub

' Взвешивание в цех
Private Sub mnuIn_cex_Click()
Dim s As String
On Error GoTo mnuIn_cex_Err

  If Ns > 200 Then
    Shell App.path & "\rar.exe m -agddmmyy -ep """ & App.path & "\Архив\.rar"" """ & App.path & "\Печать\*.bin""", vbHide
    Ns = 1
    Sost.Ns = Ns
    MsgBox "Файлы из папки - ПЕЧАТЬ сохранены в архиве", 48, "Сообщение"
  End If

  If Sost.Napr = 0 Then
    MsgBox "Вы уже взвесили в цех!", vbInformation + vbOKOnly, "Сообщение"
    Exit Sub
  End If

  Napr = 0
  N_osi = 0
  ReDim Ves(N_osi)

  frmWess.Show vbModal
  
  Exit Sub
mnuIn_cex_Err:
  If Err.Number = 0 Then Exit Sub
  MsgBox Err.Description & Chr(13) & "1. Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
End Sub

Private Sub mnu_Oper_Click()
  Operator = InputBox("ВВЕДИТЕ ВАШУ ФАМИЛИЮ", "Ф.И.О. ОПЕРАТОРА", Operator)
  If Operator = "egy" Then DebugMode = True Else DebugMode = False
End Sub

Private Sub mnu_re_Click()
  'frmDubl.Show vbModal
End Sub
Private Sub mnuExit_Click()
  Unload Me
End Sub
Private Sub mnuHelp_Click()
  Shell "notepad.exe " & App.path & "\Архив\Справка.txt", vbNormalFocus
End Sub

Private Sub mnuOut_cex_Click() ' Взвешивание из цеха
ReDim Ves_osi(150, 10) As Variant
On Error GoTo mnuOut_cex_Err
     
  If Sost.Napr = 1 Then
    MsgBox "Вы уже взвесили из цеха!", vbInformation + vbOKOnly, "Сообщение"
    Exit Sub
  End If
       
  Napr = 1
  N_osi = 0
  ReDim Ves(N_osi)

  frmWess.Show vbModal

  Exit Sub
mnuOut_cex_Err:
  If Err.Number = 0 Then Exit Sub
  MsgBox Err.Description & Chr(13) & "2.Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
End Sub

Private Sub mnuPort_Click()
  If Not DebugMode Then Passw.Show vbModal Else frmSettings.Show vbModal
End Sub

Private Sub mnuPr_itog_Click()
  frmPrintItog.Show vbModal
End Sub

Private Sub mnuPr_osi_Click()
  frmPrintOsi.Show vbModal
End Sub

Private Sub mnunew_Click()
  txtLabel.Visible = True
  frmDonixEgy.Show vbModal
  txtLabel.Visible = False
End Sub


Private Sub mnuTest_Click()
On Error GoTo mnuTest_Err

  SaveSost App.path & "\1", Sost

'  Dim cn As ADODB.Connection
'  Dim rs As ADODB.Recordset
'  Set cn = New ADODB.Connection
'  Set rs = New ADODB.Recordset
'
'  'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & ";Extended Properties=DBase IV"
'  'cn.Open "Provider=vfpoledb.1;Data Source=" & App.Path & ";Collating Sequence=general;"
'  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\test.xls;Extended Properties=""Excel 8.0;HDR=No"";"
'
'  rs.CursorLocation = adUseClient
'
'  'cn.Execute "CREATE TABLE test1.dbf (N_SOST_IN decimal(4), N_OSI_IN decimal(3), DATA_IN date, TIME_IN char(5), BRUTTO numeric(6,2)" & _
'    ",SKOR_IN numeric(3,1), N_SOST_OUT integer, N_OSI_OUT integer, DATA_OUT date, TIME_OUT char(5), TARA single" & _
'    ",SKOR_OUT single, NETTO single, VAGON single, PLAVKA single, N_PLAVKI char(7), Koef_IN single" & _
'    ",Koef_OUT single, NST char(5), MST char(10), TSLT char(8), KSLT char(8))"
'
'  'cn.Execute "CREATE TABLE test1 (N_SOST_IN decimal(4), N_OSI_IN decimal(3), DATA_IN date, TIME_IN char(5), BRUTTO decimal(6,2)" & _
'    ",SKOR_IN decimal(3,1))"
'
'
'  cn.Execute "Create Table[list4] (Name char(50), City char(50), Phone char(20), Zip decimal(5))"
'
'  'Set rs = cn.Execute("SELECT * FROM [лист1$]")
'  cn.Execute ("INSERT INTO[list4$](F1, F2) VALUES (10,20)")
''    MyDBF.AddColumn "N_SOST", N_Decimal, 4
''    MyDBF.AddColumn "N_OSI", N_Decimal, 3
''    MyDBF.AddColumn "DATA_IN", D_Data_YYYYMMDD, 10
''    MyDBF.AddColumn "TIME_IN", C_String, 5
''    MyDBF.AddColumn "BRUTTO", N_Decimal, 6, 2
''    MyDBF.AddColumn "SKOR_IN", N_Decimal, 3, 1
''    MyDBF.AddColumn "N_SOST", N_Decimal, 4
''    MyDBF.AddColumn "N_OSI", N_Decimal, 3
''    MyDBF.AddColumn "DATA_OUT", D_Data_YYYYMMDD, 10
''    MyDBF.AddColumn "TIME_OUT", C_String, 5
''    MyDBF.AddColumn "TARA", N_Decimal, 6, 2
''    MyDBF.AddColumn "SKOR_OUT", N_Decimal, 3, 1
''    MyDBF.AddColumn "NETTO", N_Decimal, 6, 2
''    MyDBF.AddColumn "VAGON", N_Decimal, 6, 2
''    MyDBF.AddColumn "PLAVKA", N_Decimal, 6, 2
''    MyDBF.AddColumn "N_PLAVKI", C_String, 7
''    MyDBF.AddColumn "Koef_IN", N_Decimal, 6, 4
''    MyDBF.AddColumn "Koef_OUT", N_Decimal, 6, 4
''    MyDBF.AddColumn "NST", C_String, 5
''    MyDBF.AddColumn "MST", C_String, 10
''    MyDBF.AddColumn "TSLT", C_String, 8
''    MyDBF.AddColumn "KSLT", C_String, 8
'
'  'rs.Open "CREATE TABLE test.dbf (First_Name char(50),Last_Name char(50),Address char(50))", cn
'  'rs.Save
'
'  rs.Open "SELECT * FROM [лист1$]", cn, adOpenDynamic, adLockBatchOptimistic
'  rs.AddNew
'  rs.Fields(1) = 10
'  rs!N_SOST_IN = 10
'  rs!skor_in = 10.5
'  'rs.Update
'  rs.UpdateBatch adAffectAllChapters
'  'rs.Save
'  rs.Close
'  cn.Close
  
  Exit Sub
mnuTest_Err:
  MsgBox "Ошибка открытия базы"
End Sub
Admin: Пользуемся тегами!
Ответить с цитированием
  #3  
Старый 23.12.2010, 20:42
Jerrick Jerrick вне форума
Прохожий
 
Регистрация: 23.12.2010
Сообщения: 9
Репутация: 10
По умолчанию

//........................frpPrintItog.frm.......... ...........
Код:
Attribute VB_Name = "frmPrintItog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim cSopr As SoprInfo

Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

Private Sub Form_Load()
  cSopr.Npl = 0
End Sub

Private Sub mnu_open_Click()
Dim i%, j%, k%
Dim s$
Dim SumVes As Single
On Error GoTo Cansel
  
  If txt(1).Text <> "" Then
    dlg1.CancelError = True                                     'установим, чтобы возникала ошибка при щелчке по кнопке Cansel
    dlg1.InitDir = App.path & "\Norma\"
    dlg1.Filter = "Файлы данных (*.bin)|*.bin"
    dlg1.Flags = cdlOFNFileMustExist & cdlOFNHideReadOnly
    dlg1.DialogTitle = "Загрузить файл"
    dlg1.ShowOpen
    
    Mnu_Open.Enabled = False
    Mnu_Print.Enabled = True
    Mnu_Trans.Enabled = True
    
    LoadSost dlg1.FileName, cSost
    cSost.Sopr = cSopr
  
    Label6.Caption = "Дата взвешивания цех:           " & Format(cSost.Ves_in(1).DATA, "dd.mm.yyyy")
    Label7.Caption = "Время взвешивания в цех:      " & Format(cSost.Ves_in(1).DATA, "hh:NN:ss")
    Label8.Caption = "Дата взвешивания из цеха:      " & Format(cSost.Ves_out(1).DATA, "dd.mm.yyyy")
    Label2.Caption = "Время взвешивания из цеха:  " & Format(cSost.Ves_out(1).DATA, "hh:NN:ss")
    
    For j = 1 To cSost.Sopr.Npl
      SumVes = 0
      For i = cSost.Sopr.Pl(j).N_osi To cSost.Sopr.Pl(j).N_osi + cSost.Sopr.Pl(j).KolTel * 6 - 1
        SumVes = SumVes + cSost.Ves_in(i).Ves - cSost.Ves_out(i).Ves
      Next i
      cSost.Sopr.Pl(j).Ves = SumVes
      txt(-1 + 6 * j) = Format(SumVes, "000.0")
    Next j
    
    s = Mid$(dlg1.FileName, InStrRev(dlg1.FileName, "\") + 1, Len(dlg1.FileName) - InStrRev(dlg1.FileName, "\") - 4)
    
    Open dlg1.FileName For Binary As #1
      Put #1, , cSost
    Close #1

    Open App.path & "\ASUTP\" & Format(Now, "ddmmyyhhNNss") & ".bin" For Binary As #1
      Put #1, , cSost
    Close #1

    MoveFile dlg1.FileName, App.path & "\Печать\" & s & ".bin"
    MoveFile App.path & "\Norma\" & s & ".xls", App.path & "\Печать\" & s & ".xls"
  End If
  
  Exit Sub
Cansel:
  If Err.Number = cdlCancel Or Err.Number = 0 Then
    Exit Sub
  Else
    MsgBox Err.Description
  End If
End Sub

Private Sub mnu_exit_Click()
  Unload frmDonixEgy
  Unload Me
End Sub

Private Sub mnuBD_Click()
  If conState Then
    frmDonixEgy.Show vbModal
  Else
    Exit Sub
  End If
End Sub

Private Sub mnu_zapis_Click()
Dim ans As Long, i As Integer, j As Integer

On Error GoTo Cansel

  txtCover2.Visible = False
  If Len(txtCover2.Text) > 0 Then txtCover2.Text = ""
  
  While Len(Operator) = 0
     Operator = InputBox("ВВЕДИТЕ ВАШУ ФАМИЛИЮ", "Ф.И.О. ОПЕРАТОРА", Operator)
  Wend
  Label4.Caption = " Ф.И.О. оператора:  " & Operator
  
  While cSopr.Npl < 1 Or cSopr.Npl > 3
    cSopr.Npl = Val(InputBox("ВВЕДИТЕ КОЛИЧЕСТВО ПЛАВОК ", "КОЛИЧЕСТВО  ПЛАВОК", 2))
  Wend
    
  If Not conState Then
    ans = 0
    While ans <> 2
      cSopr.Pl(1).Npl = InputBox("ВВЕДИТЕ НОМЕР ПЕРВОЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
      If Len(cSopr.Pl(1).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
    Wend
    If cSopr.Npl > 1 Then
      ans = 0
      While ans <> 2
        cSopr.Pl(2).Npl = InputBox("ВВЕДИТЕ НОМЕР ВТОРОЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
        If Len(cSopr.Pl(2).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
      Wend
    End If
    If cSopr.Npl > 2 Then
      ans = 0
      While ans <> 2
        cSopr.Pl(3).Npl = InputBox("ВВЕДИТЕ НОМЕР ТРЕТЬЕЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
        If Len(cSopr.Pl(3).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
      Wend
    End If
    
  End If
  
  cSopr.Pl(1).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "В ПЕРВОМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  If cSopr.Npl > 1 Then cSopr.Pl(2).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "ВО ВТОРОМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  If cSopr.Npl > 2 Then cSopr.Pl(3).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "В ТРЕТЬЕМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  
  cSopr.Pl(1).N_osi = 9
  cSopr.Pl(2).N_osi = cSopr.Pl(1).N_osi + cSopr.Pl(1).KolTel * 6
  cSopr.Pl(3).N_osi = cSopr.Pl(2).N_osi + cSopr.Pl(2).KolTel * 6
  
  For i = 0 To 6
    vLine(i).Y2 = hLine(1 + cSopr.Npl).Y1
  Next i
  
  For j = 1 To cSopr.Npl
    For i = 0 To 5
      txt((j - 1) * 6 + i).Visible = True
    Next i
    hLine(1 + j).Visible = True
  Next j
  
  If conState Then
    For j = 1 To cSopr.Npl
      MsgBox "Введите сопроводительные данные по " & j & " плавке", 48, "СООБЩЕНИЕ "
      frmDonixEgy.Show vbModal
      cPl.KolTel = cSopr.Pl(j).KolTel
      cPl.N_osi = cSopr.Pl(j).N_osi
      cSopr.Pl(j) = cPl
      txt((j - 1) * 6 + 0).Text = cSopr.Pl(j).NST
      txt((j - 1) * 6 + 1).Text = cSopr.Pl(j).Npl
      txt((j - 1) * 6 + 2).Text = cSopr.Pl(j).MST
      txt((j - 1) * 6 + 3).Text = cSopr.Pl(j).TSLT
      txt((j - 1) * 6 + 4).Text = cSopr.Pl(j).KSLT
    Next j
  Else
    For j = 1 To cSopr.Npl
      txt((j - 1) * 6 + 1).Text = cSopr.Pl(j).Npl
    Next j
    MsgBox "БАЗА НЕДОСТУПНА ", 48, "СОБЩЕНИЕ  "
    MsgBox "ВВЕДИТЕ САМОСТОЯТЕЛЬНО" & Chr(13) & "сопроводительные данные по плавкам", 48, "НАПОМИНАНИЕ  "
  End If
  
  Mnu_Open.Enabled = True

  Exit Sub
Cansel:
  If Err.Number = 0 Then Exit Sub
  MsgBox Err.Description & Chr(13) & "11.Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
End Sub

Private Sub Mnu_Print_Click()
  CmdCancel.Visible = False
  Me.PrintForm
  CmdCancel.Visible = True
End Sub

Private Sub Mnu_Trans_Click()
Dim i%
Dim s$
On Error GoTo Mnu_TransErr

  txtCover2 = ""

  For i = 1 To cSost.Sopr.Npl
    If Len(txt((i - 1) * 6 + 5)) = 0 Then
       MsgBox "Введите вес плавки", 48, "СООБЩЕНИЕ "
       Exit Sub
    End If
    If txt((i - 1) * 6 + 1) <> "" And txt((i - 1) * 6 + 1) <> "0000000" Then
      txtCover2 = txtCover2 & txt((i - 1) * 6 + 1) & " " & _
        Format(cSost.Ves_in(cSost.Sopr.Pl(i).N_osi).DATA, "dd/mm/yyyy") & " " & _
        Format(cSost.Ves_in(cSost.Sopr.Pl(i).N_osi).DATA, "hh:mm") & " " & _
        Format(cSost.Sopr.Pl(i).Ves, "000.0") & vbCrLf
    End If
  Next i
  
  txtCover1.Visible = True
  txtCover2.Visible = True
  
  DoEvents
  
  Open PathStprokat & "\" & Format(Now, "ddmmhhmm") & ".txt" For Output As #1
    Print #1, txtCover2
  Close #1
  
  Open App.path & "\ASUTP\" & Format(Now, "ddmmhhmm") & ".txt" For Output As #1
    Print #1, txtCover2
  Close #1
  
  Mnu_Trans.Enabled = False
  Mnu_Open.Enabled = False
  
Exit Sub
Mnu_TransErr:
  If Err.Number = 0 Then Exit Sub
  If Err.Number = 75 Or Err.Number = 52 Then
    MsgBox Err.Description & Chr(13) & " БАЗА СТАЛЬ-ПРОКАТ НЕДОСТУПНА", 16, "ОШИБКА  " & Err.Number
  Else
    MsgBox Err.Description & Chr(13) & "12.Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
  End If
End Sub

Private Sub cmdCancel_Click()
  Unload frmDonixEgy
  Unload frmPrintItog
End Sub

Private Sub txt_DblClick(Index As Integer)
Dim j%
  j = 1 + Index \ 6
  cPl.KolTel = cSost.Sopr.Pl(j).KolTel
  cPl.N_osi = cSost.Sopr.Pl(j).N_osi
  cSost.Sopr.Pl(j) = cPl
  txt((j - 1) * 6 + 0).Text = cSost.Sopr.Pl(j).NST
  txt((j - 1) * 6 + 1).Text = cSost.Sopr.Pl(j).Npl
  txt((j - 1) * 6 + 2).Text = cSost.Sopr.Pl(j).MST
  txt((j - 1) * 6 + 3).Text = cSost.Sopr.Pl(j).TSLT
  txt((j - 1) * 6 + 4).Text = cSost.Sopr.Pl(j).KSLT
End Sub
Админ: Еще раз предупреждаю - пользуемся разметкой, иначе последуют санкции!

Последний раз редактировалось Admin, 23.12.2010 в 21:00.
Ответить с цитированием
  #4  
Старый 23.12.2010, 22:22
Аватар для ***
*** *** вне форума
Прохожий
 
Регистрация: 20.06.2010
Сообщения: 47
Репутация: 0
Хорошо Я немного знаком с VB

напиши мне в ICQ 587483571 или Skype Anton7773332
Может чем и смогу помочь
__________________
Я новичок в программировании
Ответить с цитированием
  #5  
Старый 13.01.2011, 11:42
Jerrick Jerrick вне форума
Прохожий
 
Регистрация: 23.12.2010
Сообщения: 9
Репутация: 10
По умолчанию

Админы, удаляйте тему!
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:26.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter