» Задачи на Visual Basic (VB).

MicrosoftTMM
в третьей формуле нифига не понял, что стоит перед квадратным корнем из X; вроде бы похоже на цифирь один


Код:
Function funEin(ByVal m As Integer, ByVal x As Double) As Double
Dim n As Integer, tSum As Double

tSum = 0

If (x > 1) Or (x < -1) Then GoTo error

For n = 1 To m

tSum = tSum + ((x ^ 3) / n) * (Sqr(n + x) - Sqr(n - x))

Next n

funEin = tSum

Exit Function

error:

MsgBox "Неверное значение X"

funEin = 0

End Function

Function funZwei(ByVal x As Double, ByVal a As Double, ByVal b As Double) As Double

funZwei = Exp(a * (x ^ 2)) + Exp(b * x) + Sin(x)

End Function

Function funDrei(ByVal x As Double, ByVal a As Double, ByVal b As Double, ByVal c As Double) As Double

funDrei = Exp(4.5) + a * Cos(3 * b * (c ^ (Sqr(x))))

End Function

Function funVier(ByVal a As Double, ByVal b As Double, ByVal c As Double) As Double

funVier = a * Cos(b * (c ^ (2 * Sqr(a))))

End Function

кто нить может мне написать этот http://www.nw.schule.de/eu/fragy/Projekte/koerper.htm проект на vb 2005 ? Буду очень признателен

Нашел в сети по моей проблемме. Но это решение мне не подходит,т.к. у меня английская винда, а там написано что :
Данные функции работают корректно только на русской Windows

Решил выложить. Может кому понадобиться ...

Как изменить кодировку

'Форма
Text1.Text = Convert(Text1.Text, 866, 1251) 'dos->win
Text1.Text = Convert(Text1.Text, 1251, 866) 'win->dos
Text1.Text = Convert(Text1.Text, 28595, 1251) 'iso->win
Text1.Text = Convert(Text1.Text, 1251, 28595) 'win->iso
Text1.Text = Convert(Text1.Text, 20866, 1251) 'koi8r->win
Text1.Text = Convert(Text1.Text, 20866, 1251) 'win->koi8r

'Модуль
Declare Function MultiByteToWideChar& Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As _
Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long)

Declare Function WideCharToMultiByte& Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar _
As String, ByVal lpUsedDefaultChar As Long)

' MBCS and Unicode Translation Flags.

Public Const MB_PRECOMPOSED = &H1 ' use precomposed chars
Public Const MB_COMPOSITE = &H2 ' use composite chars
Public Const MB_USEGLYPHCHARS = &H4 ' use glyph chars, not ctrl chars

Public Function Convert(ByVal strSrc As String, ByVal nFromCP As Long, ByVal nToCP As Long) As String
Dim nLen As Long
Dim strDst As String
Dim strRet As String
Dim nRet As Long
nLen = Len(strSrc)
strDst = String(nLen * 2, Chr(0))
strRet = String(nLen * 2, Chr(0))
nRet = MultiByteToWideChar(nFromCP, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(nToCP, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
Convert = Left(strRet, nRet)
End Function

danka
В твоем английском Win русский добавлен, как второй язык?

dneprcomp

Да. Как второй.
Еще у меня для написания установлен французский. Я пробовал его буковки распечатывать . ТАм вообще завал. Во французском ведь есть &#233;; &#369;; &#337;;. Эти тоже не понимает. Хоть при написании в окошке Текстбук все отовбражается корректно, когда выставлю в свойствах окна.

Добавлю. ВОт тут на форуме тоже не так отображаются буквы французского алфавита/ &#233;; &#369;; &#337/. Ну да ладно с этим французским. Это я так написал для интереса ддругих у кого пытливый ум. Мне б с русским разобраться. А с французским уже бы знал где рыть и по аналогии уже б дошел до нужного варианта
Для тех кому интересно, то вот тут:
_http://orthonord.ru/fonts/winfonts.htm
про шрифты. Но я пока не могу разобраться как это можно применить к моей проблемме.

Ура, ребята, нашел решение!!!!!!!!!!!!!!!!!!!!!!
Всем у кого возникнет такая проблема вот как я дошел до этого.

Блин, ьак просто а сколько времени забрало.
Так вот. Там /в ссылке вверху/ было написано
"... И соответствие это определяется как раз жестко зашитыми допустимыми суффиксами национальных версий шрифтов: <пусто>, Cyr, CE, Baltic, Greek и Tur. Кроме того, таким образом мы обеспечиваем совместимость создаваемых нами документов с Windows 3.1x..."

В моем случае надо просто в коде окна текстбокс надо добавить к названию шрифта Cyr:
Printer.ScaleMode = 1
Printer.FontName = "Courier New Cyr"
Printer.FontSize = 16

Спасибо всем кто помогал.

Ну какое чертовски приятное чувсвто когда все получается... Всем в этом мире от чистого сердца желаю каждый раз испытывать такое.!!!!!!!!!!!!!!!!!

Извините за флейм , но меня чувства обуревают...

danka
Когда сам разберешься, оно всегда лучше.
PS. Нельзя просто добавлять Cyr к названию любого фонта. Не в каждом фонте есть русская кодировка. До обращения надо такой фонт иметь на компьютере. Если бы не был добавлен русский как второй язык, то и Cyr фонтов не было бы.

dneprcomp

Ага. Понятно. Поэтому ты спрашивал наинсталировано ли у меня . НУ видишь, ты пояснил более грамотно.
Я токо учусь.
Спасибо за помощь. Класно было . Теперь надо идти дальше.

Господа, посоветуйте как лучше сделать. Я просто не разу не писал программ для работы с инетом.
Словом есть веб сервер на котором есть cgi скрипты. Эти скрипты отдают данные. То есть если в браузере набрать адрес до сервера со скриптом, скрипт просто отдаст ответ.
Например...
Hs=123124fe
Мне соответственно нужно получить эти данные и положить их в текстовый файл для дальнейшей обработки...
Мне посоветовали работать с модулем Microsoft Internet Transfer Control
Я в принципе нашел несколько исходников для данного модуля, но не могу докопаться до нужного результата.
Помогите плиз!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

DLysenko
Думаю, найдешь что-нибудь подходящее
http://www.koders.com/vb/fidCE2C56B5FAB6EC83E5A2B148333A0B42C3C3CE5E.aspx
http://vbcity.com/forums/faq.asp?fid=10&cat=Web+Development
http://www.saberman.com/VBSamples/CGIEcho/CGIEcho.html

dneprcomp
Спасибо за ссылки, но я похоже не совсем прально сформулировал вопрос, поэтому немного не то...
Словом мы делаем запрос на удаленный сервер. Там выполняется скрипт и сервер должен возвратить программе обработанные данные. Соответственно прога их обрабатывает и ложит в текстовый файл для дальнейшего использования.


Приблизительное задание по тому что требуется, ниже.

Запрос на авторизацию
_h_t_t_p://imperz.ru/cgi-bin/im_klnt.cgi?Log=xxxx&Pas=xxxx&PsM=xxxx
Log - имя входа
Pas - пароль. Или PsM - MD5 пароля

Ответ: Er=0&Hs=xxxxx&Dm=w1w
Hs - сесионый пароль. В дальшейшем все запросы должны содержать поле a=xxxx (сесиный пароль)
Dm - домен 3 уровня с которым в дальнешем следует работать (w1w.imperz.ru)
Номера ошибок:
Er=0 - Без ошибок
Er=1 - Имя пользователя или пароль не верны
Er=2 - Идет обработка данных пользователя, повторить вход через 60 мин
Er=3 - Не активность более 60 мин
Er=4 - Изменился IP адрес
Er=5 - Повторный ввод имени и пароля в новом окне

Есть некая таблица в приложении на VB6 (используется VSFlexGrid).
Нужно сгенерить копию в файл Excel. (*.xls)
Текст и свойства ячейки передать получается, а вот рисунок нет

Какие вообще есть варианты експорта рисунка в ячейку с VB6?
Спасибо!

(для просмотра использую Excel 2003)

Ребята!
Понимаю , что не совсем туда запостил. но в поиске ничего не выдало...
Я скачал с Осла Planet source code. Довольно обьемная штука и как утверждают в текст файле там все коды с этого сайта и на все случаи жизни.
НО оно просится инсталироваться на комп. ВОт хочется спросить у бывалых а стоит его инсталировать?
Если тут нельзя такие вопросы задавать , то ,пожалуста, отошлите /только не на.... Гы...ГЫ...спасибо за понимание/ где такое обсуждает народ. Не хочется интсалировать а потом сносить и чистить реестр.

Друзья, если будет время, перекодте, плиз, с VB на С:

Dim X () As Integer
Dim Counter () As Integer
Dim K As Integer
Dim N As Integer

Public Sub Soch()
Dim i As Integer

N = CInt(InputBox("Введите N"))
K = CInt(InputBox("Введите K"))

K = K + 1

ReDim X(N)

For i = 1 To N
X(i) = i
Next
txtOut.Text = ""

ReDim Counter(K)
Counter(0) = 1

SochGenerate 1
End Sub

Private Sub SochGenerate(ByVal c As Integer)
Dim i As Integer
Dim j As Integer
Dim n1 As Integer
Dim Out() As Integer
Dim X1() As Integer

If c = K Then
ReDim Out(K)

X1 = X

For i = 1 To K - 1
n1 = 0
For j = 1 To N
If X1(j) <> 0 Then n1 = n1 + 1
If n1 = Counter(i) Then
Out(i) = X1(j)
X1(j) = 0
Exit For
End If
Next
txtOut.Text = txtOut.Text & CStr(Out(i))
Next
txtOut.Text = txtOut.Text & vbCrLf
Else
For Counter© = Counter(c - 1) To N - c + 1
SochGenerate c + 1
Next
End If
End Sub

С VB просто не разу не сталкивался, а некоторые вещи в коде меня смущают

Помогите люди добрые!!!)
Я на 1м курсе, учу вб 06 с нуля, не могу решить задачку 8}
Буду весьма признательна!!
    Изделие контролируется по двум параметрам, которые задаются точкой на
плоскости X, Y. Допустимые значения параметров задаются прямыми Y = aX + b,
Y = aX + c, X = k, X = t. Для произвольно задаваемых значений a, b, c, k, t, X,
Y напечатать слово “Норма” при попадании изображающей точки в границы
допусков, иначе напечатать слово “Брак”.

Господа, с предыдущим своим вопросом я разобрался, но теперь возник новый.
вопрос примерно в следующем:
получили данные в переменную data например такие test=1&ts=777fe&tt=8888
далее эти данные нужно записать в файл в формате
test=1
ts=777fe
tt=8888
То есть в переменной дата провести выборку и все это записать без знака & и построчно.

Grindylow
что-то с условием не так Может k и t -- это ограничения, наложенные на X, а не прямые?


DLysenko
Не совсем понял чего надо сделать.

Код:
dim data as string
dim tS() as string, var1 as string, var2 as string, var3 as string

var1 = "": var2 = "": var3 = ""

data = "test=1&ts=777fe&tt=8888"
tS = split(data, "&")

if ubound(ts)>=0 then var1 = ts(0) ' теперь var1 = "test=1"
if ubound(ts)>=1 then var2 = ts(1) ' теперь var2 = "ts=777fe"
if ubound(ts)>=2 then var3 = ts(2) ' теперь var3 = "tt=8888"

DLysenko
Или так
Код: data = Replace(data, "&", vbCrLf)

Legio

очень может быть, но условие к сожалению не я составлялю Ж)
так значит, не судьба мне с этой задачкой??!

Grindylow
Держи, горе луковое

Public Sub TestMenders(ByVal a As Double, ByVal b As Double, ByVal c As Double, _
ByVal t As Double, ByVal k As Double, _
ByVal X As Double, ByVal Y As Double)
Dim Yb As Double, Yc As Double, Result As Boolean

If t = k Then MsgBox "Параметры t и k совпадают", vbExclamation, "Ошибка": Exit Sub
If b = c Then MsgBox "Параметры b и с совпадают", vbExclamation, "Ошибка": Exit Sub
Result = True
'Проверка изделия по диапазону X
If t < k Then
If (X < t) Or (X > k) Then Result = False
Else
If (X < k) Or (X > t) Then Result = False
End If

'Проверка изделия по диапазону Y
If Result Then
Yb = a * X + b
Yc = a * X + c
If Yb < Yc Then
If (Y < Yb) Or (Y > Yc) Then Result = False
Else
If (Y < Yc) Or (Y > Yb) Then Result = False
End If
End If
'Вывод результата
If Result Then
MsgBox "Норма", vbInformation, "Результат"
Else
MsgBox "Брак", vbInformation, "Результат"
End If
End Sub

Господа,
подскажите плиз в какую сторону копать...
есть файл, в котором существуют координаты в виде 11111-11111
Так же через двоеточие ставиться исследованы ли эти координаты или нет...
То есть 11111-11111:1
Так вот, нужно сделать карту в формате x-y соответственно каждой координате взятой из файла будет соответствовать рисунок (исследовано, неисследовано)
Собственно теперь вопрос
Какие для этого использовать функции и где можно нарыть подобные примеры.
Я просто перерыл несколько форумов, несколько сайтов с исходниками, пододбного ничего не нашел.
Пытался сделать данную фишку через Frame1. Незнаю прально ли я "копаю" или нет.
Словом подскажите плиз.

В чем проблема то? Берешь массив, заполняешь его элементами. На основе размера массива делаешь DC для карты. Размер карты по х = размер рисунка по х * количество элементов карты по х, размер карты по y = размер рисунка по y * количество элементов карты по y.
В цикле прогоняешь BitBlt, координаты расчитывай как номер элемента * размер элемента

хм, не совсем понял что значит кол-во элементов по х и у.
Просто таких "точек" на карте будет несколько тысяч. (где то порядка 80000)
Координаты от 0 до 45000. То же самое и по у.
Насколько обработка будет быстрой???

карта состоит из квадратов 45000*45000, а быстрее BitBlt только прямое копирование памяти.
Вообще хотелось бы понять что за карта, ее размеры в пикселях, размеры наносимых рисунков, и соответствуют ли единицы измерения координат пикселам?

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

DroN_S

дай ссылку на книжку решил учиться [если не в лом]....

Ребят, помогите, plz, совсем не шарю в VB 06!!! Задачка: Найти наименьшее общее кратное 3 заданных натуральных чисел.

lapulechka
математический алгоритм дай, сделаем в бейсике

AndronH
раскладываешь на множители и сравниваешь (выкидываешь лишние) -- вот и весь алгоритм

lapulechka

Код:
Option Base 1
Option Explicit
'определение трёх глобальных динамических массивов, в которых будут храниться множители
Dim tA() As Integer, tB() As Integer, tC() As Integer

Private Sub Form_Load()
'Найти наименьшее общее кратное 3 заданных натуральных чисел.
'Integer -- -32,768 .. 32,767
'Currency (scaled integer) -- -922,337,203,685,477.5808 .. 922,337,203,685,477.5807
Dim a As Integer, b As Integer, c As Integer, i As Integer, s As Currency

'инициализация переменных... Задаём 3 натуральных числа
a = 7
b = 17
c = 34

'начинается поиск множителей НОК трёх чисел
Call srcNOK(a, b, c)

'перемножение найденных множителей
s = 1

For i = 1 To UBound(tA)

s = s * tA(i)

Next i

'Form1.Hide

'результат перемножения выводится на экран
MsgBox s, vbOKOnly + vbInformation, "Результат"

'выход из программы
End

End Sub

Sub srcNOK(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer)

'проверка исходных данных
'если числа не натуральные, выдаётся сообщение об ошибке и производится выход из программы
If (a < 1) Or (b < 1) Or (c < 1) Then MsgBox "Wrong values": Exit Sub

'инициализация массивов
ReDim tA(1): tA(1) = 1
ReDim tB(1): tB(1) = 1
ReDim tC(1): tC(1) = 1

'заполнение массивов множителями соответствующих чисел
Call fillArray(a, tA)
Call fillArray(b, tB)
Call fillArray(c, tC)

'сравнение множителей чисел a и b
'результат -- множители НОК -- будет сохранён в массиве tA
Call cmpArr(tA, tB)
'сортировка массива tA
Call sortArr(tA)
'сравнение промежуточного результата (массив tA) с массивом множителей числа c
Call cmpArr(tA, tC)

End Sub

'ищутся множители числа
Sub fillArray(ByVal n As Integer, ByRef tN() As Integer)
Dim i As Integer, k As Integer

i = 2
k = 2

Do While (n > 1) And (i <= n)

If (n Mod i) = 0 Then

'если число без остатка делится на текущее значение
'целочисленной переменной i,
'значит i -- один из множителей числа
ReDim Preserve tN(k)
tN(k) = i
k = k + 1

'далее проверяется результат деления числа на множитель
n = n / i

'целочисленная переменная i инициализируется заново
i = 2

Else

'если число не делится на i, переходим к следующему i
i = i + 1

End If

Loop

End Sub

'сравнение массивов
Sub cmpArr(ByRef tN1() As Integer, ByRef tN2() As Integer)
Dim i1 As Integer, i2 As Integer, k As Integer, j As Integer

'инициализация индексов массивов
i1 = 1
i2 = 1

Do While (i1 <= UBound(tN1)) And (i2 <= UBound(tN2))

'если элементы массивов (множители) одинаковы,
'элемент второго массива зануляется,
'производится переход к следующим элементам обоих массивов
If tN1(i1) = tN2(i2) Then

i1 = i1 + 1
tN2(i2) = 0
i2 = i2 + 1

'если текущий элемент первого массива больше текущего элемента
'второго массива, то производится переход к следующему элементу
'второго массива
ElseIf tN1(i1) > tN2(i2) Then

i2 = i2 + 1

'если текущий элемент второго массива больше текущего элемента
'первого массива, то производится переход к следующему элементу
'первого массива
Else

i1 = i1 + 1

End If

Loop

i1 = UBound(tN1)
k = 0

'проверяется число ненулевых элементов второго массива
For i2 = 1 To UBound(tN2)

If tN2(i2) > 0 Then k = k + 1

Next i2

'если во втором массиве есть ненулевые элементы, то
'переопределяется размер первого массива (увеличивается --
'ровно на количество ненулевых элементов второго массива)
'и ненулевые элементы второго массива добавляются в конец первого массива
'(во втором массиве занулены элементы/множители, которые уже были в первом массиве)
If k > 0 Then

ReDim Preserve tN1(i1 + k)

j = 1
i2 = 1

For i2 = 1 To UBound(tN2)

If tN2(i2) > 0 Then

tN1(i1 + j) = tN2(i2)
j = j + 1

End If

Next i2

End If

End Sub

'сортировка массивов
Sub sortArr(ByRef tN() As Integer)
Dim i As Integer, j As Integer, k As Integer

'если в массиве всего один элемент -- сортировка не производится
'(выход из процедуры сортировки)
If UBound(tN) = 1 Then Exit Sub

For i = 2 To UBound(tN)

For j = 1 To i - 1

If tN(j) > tN(i) Then

k = tN(i)
tN(i) = tN(j)
tN(j) = k

End If

Next j

Next i

End Sub

Молодые люди, помогите, пожалуйста, бедной девушке с курсовиком))

Решите две задачки, а? Они нетрудные,наверное, даже очень легкие но это не мое. Буду очень благодарна.

Задача №1

Напечатать первые n натуральных чисел, которве при удалении последней цифры уменьшаются в челое число раз. Вывести на экран эти числа с указанием во сколько раз они уменьшаются.

Забача №2

Дан массив n целых чисел. Если в массиве четные и нечетные числа чередуются, то создается новый массив, все члены которого умножаются на его минимальный элемент, в противном случае новый массив не содается. Для вывода массива пользоваться элементом управления LIST