Ответить

Ответить

ну смотри , если это поможет :           

Public fso As New FileSystemObject
Public fiztxt As TextStream
Public fil As File
Private PicArr(15) As String
Private TxtArr(15) As String
Private frs As Byte
Option Explicit
Private Sub cmdNext_Click()
frs = frs + 1
If Not PicArr(frs) = "" Then
 Call NxtPic
Else
 frs = 1
 Call NxtPic
End If
End Sub
Private Sub cmdPrevous_Click()
If Not frs = 1 Then
 frs = frs - 1
End If
If Not PicArr(frs - 1) = "" Then
 Call NxtPic
Else
 frs = 1
 Call NxtPic
End If
End Sub
Private Sub Form_Load()
On Error GoTo Err1
Dim i As Byte
frs = 1
'инициализация
Set fil = fso.GetFile(frmRead.FilInfPth)
Set fiztxt = fil.OpenAsTextStream(ForReading)
'открытие файла
fiztxt.SkipLine
'пропуск строки
Do Until fiztxt.AtEndOfStream
Select Case i
Case 0: PicArr(0) = fiztxt.ReadLine
Case 1: PicArr(1) = fiztxt.ReadLine
Case 2: PicArr(2) = fiztxt.ReadLine
Case 3: PicArr(3) = fiztxt.ReadLine
Case 4: PicArr(4) = fiztxt.ReadLine
Case 5: PicArr(5) = fiztxt.ReadLine
Case 6: PicArr(6) = fiztxt.ReadLine
Case 7: PicArr(7) = fiztxt.ReadLine
Case 8: PicArr(8) = fiztxt.ReadLine
Case 9: PicArr(9) = fiztxt.ReadLine
Case 10: PicArr(10) = fiztxt.ReadLine
Case 11: PicArr(11) = fiztxt.ReadLine
Case 12: PicArr(12) = fiztxt.ReadLine
Case 13: PicArr(13) = fiztxt.ReadLine
Case 14: PicArr(14) = fiztxt.ReadLine
Case 15: PicArr(15) = fiztxt.ReadLine
End Select
i = i + 1
If i = 16 Then Exit Do
'предохранитель
Loop
'заполнение массива PicArr
Call SepLinePic(PicArr())
'разделение строк массива
fiztxt.SkipLine
'пропуск сторки
i = 0
'обнуление
Do Until fiztxt.AtEndOfStream
Select Case i
Case 0: TxtArr(0) = fiztxt.ReadLine
Case 1: TxtArr(1) = fiztxt.ReadLine
Case 2: TxtArr(2) = fiztxt.ReadLine
Case 3: TxtArr(3) = fiztxt.ReadLine
Case 4: TxtArr(4) = fiztxt.ReadLine
Case 5: TxtArr(5) = fiztxt.ReadLine
Case 6: TxtArr(6) = fiztxt.ReadLine
Case 7: TxtArr(7) = fiztxt.ReadLine
Case 8: TxtArr(8) = fiztxt.ReadLine
Case 9: TxtArr(9) = fiztxt.ReadLine
Case 10: TxtArr(10) = fiztxt.ReadLine
Case 11: TxtArr(11) = fiztxt.ReadLine
Case 12: TxtArr(12) = fiztxt.ReadLine
Case 13: TxtArr(13) = fiztxt.ReadLine
Case 14: TxtArr(14) = fiztxt.ReadLine
Case 15: TxtArr(15) = fiztxt.ReadLine
End Select
i = i + 1
If i = 16 Then Exit Do
'предохранитель
Loop
'заполнение массива TxtArr
Call SepLineTxt(TxtArr())
'разделение строк
If Not PicArr(0) = "" Then
 imgPic(0).Picture = LoadPicture(App.Path & PicArr(0))
 lblPic(0).Caption = TxtArr(0)
End If
'загрузка первого рисунка
If Not PicArr(1) = "" Then
 imgPic(1).Picture = LoadPicture(App.Path & PicArr(1))
 lblPic(1).Caption = TxtArr(1)
End If
'загрузка второго рисунка
Exit Sub
Err1: MsgBox "Для данного урока нет рисунков.", vbCritical, "Ошибка"
End Sub
Private Function SepLinePic(PicArr() As String)
Dim i As Byte
For i = 0 To 15
 If Not PicArr(i) = "#" Then
  PicArr(i) = Mid(PicArr(i), 2)
 Else
  PicArr(i) = ""
 End If
Next
End Function
Private Function SepLineTxt(TxtArr() As String)
Dim i As Byte
For i = 0 To 15
 If Not TxtArr(i) = "@" Then
  TxtArr(i) = Mid(TxtArr(i), 2)
 Else
  TxtArr(i) = ""
 End If
Next
End Function
Private Function NxtPic()
fraPic(0).Caption = "рис." & CStr(frs)
fraPic(1).Caption = "рис." & CStr(frs + 1)
If Not PicArr(frs - 1) = "" Then
 imgPic(0).Picture = LoadPicture(App.Path & PicArr(frs - 1))
 lblPic(0).Caption = TxtArr(frs - 1)
End If
If Not PicArr(frs) = "" Then
 imgPic(1).Picture = LoadPicture(App.Path & PicArr(frs))
 lblPic(1).Caption = TxtArr(frs)
End If
End Function

и это только один модуль

(c) copyright -=[$@$h'OK]=-   

Ответить

Мдя-я.... a frmPic.hide не пробовал? 

Ответить

И правда мда-а... Типа нельзя было по процедурам разбить?

Вообще, можешь попробовать повесить на Form_Initialize().

Или задай форме свойства Visible=false, а по завершении всей лабуды поставь в true, если я правильно понял, чего ты хочешь...

Ответить

Процедура Form_Load вызывается уже после того, как дана команда на загрузку формы и отменить это уже невозможно.

Логично было бы вначале сделать проверку на ошибки, а только потом загружать форму.

Ответить