Цифровой фотоаппарат - великая штука! За выходные 100 мегабайт фотографий наснимал! :) Жаль только карта памяти маленькая - часто к компьютеру бегать приходится...
Читайте!

Как преобразовать 4 байта в Лонг?

Вопрос:

Достаю из файла 4 байта - переменную типа Long\DWord.
Как преобразовать её в число Long?

Ответ:

lngResult=byt1 + _
           byt2 * 2^8 + _
           byt3 * 2^16 + _
           byt4 * 2^24

Это - без апи. Можно и с АПИ.

Call MoveMemory(lngResult, byt1,1)
Call MoveMemory(ByVal VarPtr(lngResult)+1, byt2,1)
Call MoveMemory(ByVal VarPtr(lngResult)+2, byt3,1)
Call MoveMemory(ByVal VarPtr(lngResult)+3, byt4,1)

    Артем Кривокрисенко

Можно ещё LSET попробовать

создаётся два типа.в одном 4 байта в другом 2 лонга, из них две переменных. а потом

Lset tip1=tip2

    DmitryK1

наверх

---

Как в NT-системе правильно скопировать текст?

Вопрос:

Как под NT системой правильно скопировать текст в буфер? Вот такая строчка "Clipboard.SetText lstStatus.Text" копирует лажу (не в той кодировке).

Ответ:

Можно программно менять раскладку:

Private Declare Function ActivateKeyboardLayout Lib "user32" _
     (ByVal HKL As Long, ByVal flags As Long) As Long

Public Sub RussianKbd()
     ActivateKeyboardLayout 68748313, 0
End Sub

Public Sub EnglishKbd()
     ActivateKeyboardLayout 67699721, 0
End Sub

    Рязанов Андрей

наверх

---

Как определить позицию курсора в Windows?

Вопрос:

Как определить позицию курсора в Windows?

Ответ:

Позицию курсора можно определить с помощью API функции GetCursorPos
Объявление:

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
      x As Long
      y As Long
End Type
Private g As Long' Любая переменная типа Long
Private Position As POINTAPI ' Любая переменная типа POINTAPI

Применение:

Private Sub Form_Load()
g = GetCursorPos(Position)
MsgBox "Позиция по Х: " & Position.x
MsgBox "Позиция по Y: " & Position.y
End Sub

Ivan

наверх

---

Как сумировать ячейки в таблице Excel, которые выделены красным цветом?

Вопрос:

Как сумировать ячейки в таблице Excel, которые выделены, к примеру, красным цветом?

Ответ:

Можно использовать такую схему:

' отобранные ячейки для суммирования
Dim sumRange As Range
' отдельная проверямая ячейка
Dim rCell As Range

' просматриваем диапазон ячеек
For Each rCell In Range("A1:D5").Cells
   ' проверяем цвет шрифта в ячейке
   If rCell.Font.Color = RGB(255, 0, 0) Then
       ' если набор ячеек еще не инициализирован
       If sumRange Is Nothing Then
           ' инициализируем набор первой найденной ячейкой
           Set sumRange = rCell
       Else
           ' или добавляем очередную ячейку к уже найденным
           Set sumRange = Union(sumRange, rCell)
       End If
   End If
Next rCell

' записываем результат, используя для суммирования
' встроенную функцию Excel'я
Range("A7").Value = Application.Sum(sumRange)

Kirill

наверх

---

Как из Visual Basic открыть книгу Excel, добавить таблицу и заполнить её данными?

Вопрос:

 Как мне из моей программы открыть Excel, добавить в него новую таблицу, а в нее уже добавить некоторые данные (числа, текст).
 Я пока вишу только на добавлении новой таблицы - т.е. Excel я открываю, но на этом все, дальше не могу. Вот мой исходник:

Option Explicit

Private exapp As Excel.Application

Private Sub Комманда1_Click()
   Set exapp = New Excel.Application
' WordApp.Visible = True
   exapp.Visible = True
   'Set exapp = Nothing
End Sub

 Дальше не знаю как...

Ответ:

В принципе начало правильное, насколько я понимаю проблема в незнании объектов Excel VBA, но это как раз дело поправимое :)

Option Explicit

Private exapp As Excel.Application

Private Sub Комманда1_Click()
    Dim wBook As Excel.Workbook ' чтобы обращаться к созданной таблице
' здесь я бы сделал не так:
' Set exapp = New Excel.Application
' а добавил бы возможность использовать запущенное приложение
    Dim StartedNew As Boolean ' поставим в True, если сами запустим Excel
    StartedNew = False
    On Error Resume Next
    Set exapp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ' если нет запущенного Excel'я
        Set exapp = CreateObject("Excel.Application")
        StartedNew = True
    End If
    On Error GoTo 0
    exapp.Visible = True
    ' создаем новую таблицу
    Set wBook = exapp.Workbooks.Add
    ' издеваемся над созанной таблицей :)
    wBook.Sheets(1).Name = "MyResult"
    wBook.Sheets(1).Range("A1").Value = "это ячейка A1"
    wBook.Sheets("MyResult").Cell(4, 2).Value = InputBox("Впиши что хочешь", "текст для ячейки B4", "filled from VB")
    ' сохраняем таблицу
    wBook.Save "c:\my_table.xls"
    wBook.Close
    Set wBook = Nothing
    ' если Excel запускали мы, то надо бы его закрыть
    If StartedNew Then
        exapp.Quit
    End If
    Set exapp = Nothing
End Sub

Kirill

---

Вопрос/Ответ

Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.

Вопросы:

---

Автор вопроса: Романов Александр

Ответ ожидается по этому адресу

   Есть текстовый файл в котором надо заменить только первую строку. Можно конечно загрузить весь документ в текстбокс, там подменить первую строку и обратно записать в файл. Есть ли более простой вариант, как можно это сделать (файлы большие, долго загружает)?

---

Автор вопроса: psinetron

Ответ ожидается по этому адресу

   Как осуществить поиск по заданным параметрам из MS Access таблицы (например, найти все имена на букву "а")?

---

Автор вопроса: Владимир

Ответ ожидается по этому адресу

   Как из программы на VB6 найти окно сообщения сторонней программы и прочитать в переменную текст из этого окна?

---

Автор вопроса: Damer

Ответ ожидается по этому адресу

   У кого-нибудь найдется электронный справочник по WinApi?

---

Автор вопроса: anton

Ответ ожидается по этому адресу

   Подскажите, как в VB6.0 узнать прошитый (заводской) серийный номер CD-диска. То, что выдает GetVolumeInformation - это не серийный номер, а номер тома, который каждый раз после записи разный.

---

Автор вопроса: Александр

Ответ ожидается по этому адресу

   Почему у меня при создании WebApplication в VB.NET не отоброжается DBGrid и DBList?

---

Автор вопроса: Kris

Ответ ожидается по этому адресу

   Есть DataGrid (WinForms) в .Net. Как выделить строки, начинающиеся с буква А, определенным цветом, с буквы Б - другим цветом?

---

Ответы:

---

Вопрос:

   Есть у кого-нибудь примеры или материал на русском, как работать с TabStrip? Вышлите, если не жалко :), буду благодарен. Имеется ли возможность в отображать вкладки снизу?

Ответ:

Автор ответа: C...R...a...S...H

Да, но только в MS Common controls 6.0. Есть свойство Placement, в котором можно поставить, где будут находиться кнопки.

---

Вопрос:

   Как вытащить асоциированную иконку, но не из отдельного файла, а по расширению?

Ответ:

Автор ответа: Хатламаджиян Виталий Арутюнович

Не буду расписывать как реализовать функции работы с реестром, а перейду сразу к делу.
Итак, в реестре в разделе HKEY_CLASSES_ROOT располагаются зарагистрированные расширения файлов. Все они начинаются на "." (.txt, .doc и т.п.).
У каждого этого расширения фала в параметре (По-умолчанию) записана строка - описание файла.
Например у .txt написано txtfile.
В этом же разделе (HKEY_CLASSES_ROOT) открыть раздел txtfile (для примера - тектовый файл). У этого раздела есть свой раздел DefaultIcon.
Полный путь - HKEY_CLASSES_ROOT\txtfile\DefaultIcon.
В вышеуказанном разделе в параметре (По-умолчанию) написан путь к файлу с иконкой и может быть указан ещё индекс этой иконки в этом файле.

Теперь главное. Загрузка ентого значка к примеру на элемент PictureBox

'В модуле
Option Explicit
Public Const DI_NORMAL = 3
Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long

'На форме
Dim glLargeIcons() As Long 'массив для иконок 32x32 \можно брать любые размеры, но при условии, что эта иконка имеет такие размеры
Dim glSmallIcons() As Long 'массив для иконок 16x16 /
Dim lIndex As Long
Dim lIcons As Long
Dim sExeName As String
Const LARGE_ICON As Integer = 32 'икнока 32x32
Const SMALL_ICON As Integer = 16 'икнока 16x16

lIcons = ExtractIconEx(sExeName, -1, 0, 0, 0) 'возвращает количество иконок в библиотеке
ReDim glLargeIcons(lIcons)
ReDim glSmallIcons(lIcons)
ExtractIconEx(sExeName, lIndex, glLargeIcons(lIndex), glSmallIcons(lIndex), 1)
lIndex = 0 'индекс иконки
With pic 'pic - 'элелемент PictureBox, находящийся на этой форме
     .AutoRedraw = True
     DrawIconEx(.hDC, 0, 0, glLargeIcons(lIndex), LARGE_ICON, LARGE_ICON, 0, 0, DI_NORMAL)
     .Refresh
End With

---

Вопрос:

   Как написать число прописью?

Ответ:

Автор ответа: Кирко Владимир

http://www.microsoft.ru/offext/documents/text/list.aspx?id=15

---

Ответ:

Автор ответа: Кирко Владимир

Учитывая характер вопроса, наверное проще будет посмотреть
http://www.microsoft.com/rus/msdn/activ/msvb/archive/data/227.mspx,
а не ту ссылку, которую я прислал чуть раньше.

---

Ответ:

Автор ответа: Хатламаджиян Виталий Арутюнович

Когда-то давно я делал это. Вот, что я нашёл:

Private Function NumberInWords(Number As String) As String 'основная функция. её параметр - число вида CStr(1234)
     Dim Image As String, Modulus As String
     If IsNull(Number) Then
         NumberInWords = Null
     Else
         Image = String$(36 - Len(Number), "0") & Number
         If Image = 0 Then
             NumberInWords = "ноль"
         Else
             Modulus = TriadInWords(Mid$(Image, 1, 3), 1, "дециллион", "дециллиона", "дециллионов") & _
                       TriadInWords(Mid$(Image, 4, 3), 1, "нониллион", "нониллиона", "нониллионов") & _
                       TriadInWords(Mid$(Image, 7, 3), 1, "октиллион", "октиллиона", "октиллионов") & _
                       TriadInWords(Mid$(Image, 10, 3), 1, "септиллион", "септиллиона", "септиллионов") & _
                       TriadInWords(Mid$(Image, 13, 3), 1, "секстиллион", "секстиллиона", "секстиллионов") & _
                       TriadInWords(Mid$(Image, 16, 3), 1, "квинтиллион", "квинтиллиона", "квинтиллионов") & _
                       TriadInWords(Mid$(Image, 19, 3), 1, "квадриллион", "квадриллиона", "квадриллионов") & _
                       TriadInWords(Mid$(Image, 22, 3), 1, "триллион", "триллионa", "триллионов") & _
                       TriadInWords(Mid$(Image, 25, 3), 1, "миллиард", "миллиарда", "миллиардов") & _
                       TriadInWords(Mid$(Image, 28, 3), 1, "миллион", "миллиона", "миллионов") & _
                       TriadInWords(Mid$(Image, 31, 3), 2, "тысяча", "тысячи", "тысяч") & _
                       IIf(Mid$(Image, 34, 3) = "000", " ", TriadInWords(Mid$(Image, 34, 3), 1, "", "", ""))
         End If
     End If
End Function

Private Function TriadInWords(Triad As String, Gender As Integer, Unit1 As String, Unit2 As String, Unit5 As String) As String 'вспомогательная функция
     Dim Result As String
     If Triad = "000" Then
         TriadInWords = ""
     Else
         Result = Choose(Mid$(Triad, 1, 1) + 1, "", " сто", " двести", " триста", " четыреста", " пятьсот", " шестьсот", " семьсот", " восемьсот", " девятьсот")
         If Mid$(Triad, 2, 1) = 1 Then
             Result = Result & " " & Choose(Mid$(Triad, 3, 1) + 1, "десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать") & " " & Unit5
         Else
             Result = Result & Choose(Mid$(Triad, 2, 1) + 1, "", "", " двадцать", " тридцать", " сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят", " девяносто")
             Select Case Mid$(Triad, 3, 1)
                 Case 1: Result = Result & Choose(Gender, " один ", " одна ", " одно ") & Unit1
                 Case 2: Result = Result & Choose(Gender, " два ", " две ", " два ") & Unit2
                 Case 3: Result = Result & " три " & Unit2
                 Case 4: Result = Result & " четыре " & Unit2
                 Case Else: Result = Result & Choose(Mid$(Triad, 3, 1) + 1, "", "", "", "", "", " пять", " шесть", " семь", " восемь", " девять") & " " & Unit5
             End Select
         End If
         TriadInWords = Result
     End If
End Function

---

Ответ:

Автор ответа: C...R...a...S...H

На такой запрос в Yandex появится около 10000 ссылок.
Вот одна из них:

Public Function СуммаПрописью(Число As Long) As String
If Число = 0 Then Число = 1
СуммаПрописью = props(Число)
End Function

Private Function props(chislo As Long) As String
Dim a1(9) As String
Dim a2(9) As String
Dim a3(9) As String
Dim a4(9) As String
Dim t As Long
Dim b As Long
Dim k As Long
Dim ch$, st$, s1$
Dim a#, ass%
t = 0: b = 0: k = 0: a# = 0: ass% = 0
a1(1) = "сто": a1(2) = "двести"
a1(3) = "триста": a1(4) = "четыреста"
a1(5) = "пятьсот": a1(6) = "шестьсот"
a1(7) = "семьсот": a1(8) = "восемьсот"
a1(9) = "девятьсот"
a2(1) = "десять": a2(2) = "двадцать"
a2(3) = "тридцать": a2(4) = "сорок"
a2(5) = "пятьдесят": a2(6) = "шестьдесят"
a2(7) = "семьдесят": a2(8) = "восемьдесят"
a2(9) = "девяносто"
a3(1) = "одиннадцать": a3(2) = "двенадцать"
a3(3) = "тринадцать": a3(4) = "четырнадцать"
a3(5) = "пятнадцать": a3(6) = "шестнадцать"
a3(7) = "семнадцать": a3(8) = "восемьнадцать"
a3(9) = "девятнадцать"
a4(1) = "один": a4(2) = "два"
a4(3) = "три": a4(4) = "четыре"
a4(5) = "пять": a4(6) = "шесть"
a4(7) = "семь": a4(8) = "восемь"
a4(9) = "девять"
t = Int(chislo)
a# = chislo - t
ass% = Int(a# * 100)
' If Int(a# * 100) + 1 - a# * 100 < 0.5 Then
' ass% = ass% + 1
' End If
' If ass% = 0 Then
' s1$ = Chr$(32) + "00" + Chr$(32) + "коп."
' Else
' If ass% < 10 Then
' s1$ = Chr$(32) + "0" + LTrim(Str(ass%)) + Chr$(32) + "коп."
' Else
' s1$ = Chr$(32) + Str(ass%) + Chr$(32) + "коп."
' End If
' End If
st$ = Chr$(32)
    If t > 1000000 Then
        b = Int(t / 1000000)
        t = t - b * 1000000
        st$ = Chr$(32) + st$ + itos$(b, 0, a1, a2, a3, a4)
        k = b - 100 * Int(b / 100)
            If k >= 11 And k <= 14 Then
                  st$ = st$ + Chr$(32) + "миллионов"
                                   Else
                  k = b - 10 * Int(b / 10)
                      Select Case k
                             Case 0, 5 To 9
                               st$ = st$ + Chr$(32) + "миллионов"
                             Case 2 To 4
                               st$ = st$ + Chr$(32) + "миллиона"
                             Case 1
                               st$ = st$ + Chr$(32) + "миллион"
                      End Select
            End If
    End If
    If t >= 1000 Then
         b = Int(t / 1000)
         t = t - b * 1000
         st$ = st$ + itos$(b, 1, a1, a2, a3, a4)
         k = b - 100 * Int(b / 100)
               If k >= 11 And k <= 14 Then
                    st$ = st$ + Chr$(32) + "тысяч"
                                      Else
                    k = b - 10 * Int(b / 10)
                         Select Case k
                                Case 0, 5 To 9
                                     st$ = st$ + Chr$(32) + "тысяч"
                                Case 2 To 4
                                     st$ = st$ + Chr$(32) + "тысячи"
                                Case 1
                                     st$ = st$ + Chr$(32) + "тысяча"
                         End Select
               End If
    End If
b = t
      If t <> 0 Then
            st$ = st$ + itos$(b, 0, a1, a2, a3, a4)
      End If
b = t
k = b - 100 * Int(b / 100)
     If k >= 11 And k <= 15 Then
         st$ = st$ + Chr$(32) + "часов" 'часов
                            Else
         Rem по последней цифре
         k = b - 10 * Int(b / 10)
             Select Case k
                    Case 0, 5 To 9
                        st$ = st$ + Chr$(32) + "часов"
                    Case 2 To 4
                        st$ = st$ + Chr$(32) + "часа"
                    Case 1
                        st$ = st$ + Chr$(32) + "час"
             End Select
      End If
st$ = LTrim$(st$)
st$ = UCase$(Left$(st$, 1)) + Right$(st$, Len(st$) - 1)
props$ = st$ + s1$
End Function
Rem Вывод прописью числа от 1 до 999
Private Function itos$(n As Long, p As Byte, a1() As String, a2() As String, a3() As String, a4() As String)
'n-число, t-признак тысячи
Dim t As Integer
Dim i As Integer
Dim st$
i = 0
t = n
   If t >= 100 Then
      i = Int(t / 100)
      st$ = a1(i)
      t = t - i * 100
   End If
Select Case t
    Case Is >= 20
       i = Int(t / 10)
       st$ = st$ + Chr$(32) + a2(i)
       t = t - i * 10
    Case 11 To 19
       i = t - 10
       st$ = st$ + Chr$(32) + a3(i)
       t = 0
    Case 10
       st$ = st$ + Chr$(32) + a2(1)
       t = 0
    Case Else
End Select
Select Case t
    Case 1, 2
      If p <> 1 Then
         st$ = st$ + Chr$(32) + a4(t)
                Else
              If t = 1 Then
                   st$ = st$ + Chr$(32) + "одна"
                       Else
                   st$ = st$ + Chr$(32) + "две"
              End If
      End If
    Case 3 To 9
        st$ = st$ + Chr$(32) + a4(t)
    Case Else
End Select
itos$ = Chr$(32) + st$
End Function

(с) Автор неизвестен, но ему БОЛЬШОЕ СПАСИБИШЕ

---

---

Можете заполнить эту форму, либо отослать вопрос СЮДА

Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.

Текст сообщения:

Ваше имя
E-mail для ответа

наверх