





новичоок писал(а):Мужики, ну здорово не пинайте меня, я только месяц VB пробую.
Сделал как вы сказали , но текстовый файл открывается в одном Label
помогите как сделать чтоб он открывался сначала в одной Label и дойдя до конца Label начинал открываться в другой Label
A = Str(Text)
If A > 10000 Then ' Тогда первые 10000 символов в одну сторону другие в другую сторону


как сделать чтоб он открывался сначала в одной Label и дойдя до конца Label начинал открываться в другой Label


Dim strFileName As String 
Dim strFileContent As String 
Dim nFreeFile As Long 
Dim nFileLenght As Long
Private Sub cdStart_Click() 
   cdCommonDialog.ShowOpen 
   strFileName = cdCommonDialog.FileName 
   nFreeFile = FreeFile 
   If strFileName <> "" Then 
      Open strFileName For Input As nFreeFile 
      nFileLenght = FileLen(strFileName) 
      strFileContent = Input(nFileLenght, #nFreeFile)
      Dim nChr As Long
 
      For nChr = 1 To 1000 'Символы 1-1000 помещаются на Label1
         Label1.Caption = Label1.Caption & Mid(strFileContent, nChr, 1)
      Next
      For nChr = nChr To 2000 'Символы 1000-2000 помещаются на Label2
         Label2.Caption = Label2.Caption & Mid(strFileContent, nChr, 1)
      Next
   End If
End Sub
- Да.
- Нет!
- ДА!
- НЕТ!!!
[ещё десяток таких же строк]

Option Explicit
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private Type CHARRANGE
  cpMin As Long
  cpMax As Long
End Type
Private Type FORMATRANGE
  hdc As Long
  hdcTarget As Long
  rc As RECT
  rcPage As RECT
  chrg As CHARRANGE
End Type
Private Type POINTL
  x As Long
  y As Long
End Type
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = (WM_USER + 57)
Private Const WM_SETTEXT As Long = &HC
Private Const WS_CHILD As Long = &H40000000
Private Const WM_GETFONT As Long = &H31
Private Const WM_SETFONT As Long = &H30
Private Const ES_MULTILINE As Long = &H4&
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const EM_LINEINDEX As Long = &HBB
Private Const EM_CHARFROMPOS As Long = &HD7
Private Const EM_LINEFROMCHAR As Long = &HC9
Private h As Long
Private WithEvents btnUp As CommandButton, WithEvents btnDown As CommandButton
Private CurPage As Long
Private TotalLinesCount As Long, VisibleLinesCount As Long
Private Sub btnDown_Click()
  CurPage = CurPage + 2
  
  DrawPage Me.Controls("shpLeftPage"), CurPage
  DrawPage Me.Controls("shpRightPage"), CurPage + 1
End Sub
Private Sub btnUp_Click()
  CurPage = CurPage - 2
  If CurPage < 0 Then CurPage = 0
  
  DrawPage Me.Controls("shpLeftPage"), CurPage
  DrawPage Me.Controls("shpRightPage"), CurPage + 1
End Sub
Private Sub Form_Load()
  Dim s As String, pl As POINTL, r As RECT
  
  Me.Width = 9330
  Me.Height = 7560
  
  With Me.Controls.Add("vb.shape", "shpLeftPage")
    .Left = 120
    .Top = 120
    .Width = 4215
    .Height = 6855
    .Visible = True
  End With
  
  With Me.Controls.Add("vb.shape", "shpRightPage")
    .Left = 4560
    .Top = 120
    .Width = 4215
    .Height = 6855
    .Visible = True
  End With
  
  Set btnUp = Me.Controls.Add("vb.CommandButton", "btnUp")
  btnUp.Left = 4560 + 4215 + 50
  btnUp.Top = 120
  btnUp.Width = 300
  btnUp.Height = 300
  btnUp.Font.Name = "Wingdings"
  btnUp.Caption = "й"
  btnUp.Visible = True
  
  Set btnDown = Me.Controls.Add("vb.CommandButton", "btnDown")
  btnDown.Left = 4560 + 4215 + 50
  btnDown.Top = Me.Controls("shpRightPage").Top + Me.Controls("shpRightPage").Height - 300
  btnDown.Width = 300
  btnDown.Height = 300
  btnDown.Font.Name = "Wingdings"
  btnDown.Caption = "к"
  btnDown.Visible = True
  
  h = CreateWindowEx(0, "RichEdit20A", vbNullString, WS_CHILD Or ES_MULTILINE, 0, 0, Me.ScaleX(Me.Controls("shpLeftPage").Width, Me.ScaleMode, vbPixels), Me.ScaleY(Me.Controls("shpLeftPage").Height, Me.ScaleMode, vbPixels), Me.hwnd, 0, App.hInstance, ByVal 0&)
  SendMessage h, WM_SETFONT, SendMessage(Me.hwnd, WM_GETFONT, 0, ByVal 0&), ByVal 0&
  
  
  Open "c:\book.txt" For Input Access Read As #1
  s = Input$(LOF(1), 1)
  Close #1
  
  SendMessage h, WM_SETTEXT, 0, ByVal s
  TotalLinesCount = SendMessage(h, EM_GETLINECOUNT, 0, ByVal 0&)
  
  GetClientRect h, r
  pl.x = r.Left + 1
  pl.y = r.Bottom - 1
  
  VisibleLinesCount = SendMessage(h, EM_LINEFROMCHAR, SendMessage(h, EM_CHARFROMPOS, 0, pl), ByVal 0&)
End Sub
Private Sub DrawPage(ByVal s As Shape, ByVal PageNum As Long)
  Dim f As FORMATRANGE
  
  
  f.rc.Left = Me.ScaleX(s.Left, Me.ScaleMode, vbTwips)
  f.rc.Right = f.rc.Left + Me.ScaleX(s.Width, Me.ScaleMode, vbTwips)
  f.rc.Top = Me.ScaleY(s.Top, Me.ScaleMode, vbTwips)
  f.rc.Bottom = f.rc.Top + Me.ScaleY(s.Height, Me.ScaleMode, vbTwips)
  
  f.rcPage = f.rc
  
  f.hdc = Me.hdc
  f.hdcTarget = Me.hdc
  
  
  f.chrg.cpMin = SendMessage(h, EM_LINEINDEX, PageNum * VisibleLinesCount, ByVal 0&)
  f.chrg.cpMax = SendMessage(h, EM_LINEINDEX, (PageNum + 1) * VisibleLinesCount, ByVal 0&)
  
  If f.chrg.cpMin = -1 Then Exit Sub
  'If f.chrg.cpMax = -1 Then
  '
  'End If
    
  SendMessage h, EM_FORMATRANGE, 1, f
End Sub








А если слово не известно, известно только его положение в тексте (порядок)
Нестрашно, через пару лет будешь даже без книг разбираться! (как я )

Конь писал(а):!Viper!
А если слово не известно, известно только его положение в тексте (порядок)

Как первое противоположно второму... Конь лукавит!

А если слово не известно, известно только его положение в тексте (порядок)
Нестрашно, через пару лет будешь даже без книг разбираться! (как я )
Сейчас этот форум просматривают: AhrefsBot и гости: 8