| Вопрос: Переделать код из Delphi на VB | Добавлено: 27.05.08 18:54 |
Автор вопроса:  StudioMaX | ICQ: 971351 |
|
Люди, кто хорошо знает Делфи, помогите переделать код на VB
procedure TForm1.nameChange(Sender: TObject);
const stg:cardinal=$FA34C6A0; var by1,by2,par:string; ch,ch3 :string; p,p2,p3,x,l:integer; begin if length(name.Text)>3 then begin ch:=pchar(name.Text); p:=ord(ch[2]); by1:=inttostr(p); p2:=ord(ch[3]); by2:=inttostr(p2); p3:=ord(ch[4]); ch3:=inttostr(p3); l:=length(ch3); x:=strtoint(ch3[l]); par:=inttostr(stg shl x); if length(par)<10 then begin repeat par:='0'+par; until length(par)=10; end; code.Text:=par+'-'+inttostr(p2 shl 2) + inttostr(p shl 1); end else code.Text:='Имя введено неверно'; end; |
| Ответы | Всего ответов: 12 |
|
Номер ответа: 1 Автор ответа:  StudioMaX ICQ: 971351 Вопросов: 18 Ответов: 15 |
Профиль | | #1 | Добавлено: 27.05.08 19:38 |
| Скажите, действительно в эту тему заходило 700 человек и никто не ответил, или это глюк форума? | ||
|
Номер ответа: 2 Автор ответа: Holsten Вопросов: 5 Ответов: 100 |
Профиль | | #2 | Добавлено: 27.05.08 20:02 |
все зашли - ни кто не знает 
|
||
|
Номер ответа: 3 Автор ответа: Winand Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | | #3 | Добавлено: 27.05.08 20:07 |
|
835 хитов?)) Кому-то нечего делать?
|
||
|
Номер ответа: 4 Автор ответа: StudioMaXICQ: 971351 Вопросов: 18 Ответов: 15 |
Профиль | | #4 | Добавлено: 27.05.08 20:30 |
| так кто-нибудь может переделать или нет? | ||
|
Номер ответа: 5 Автор ответа: Wolf4DВопросов: 20 Ответов: 131 |
Web-сайт: Профиль | | #5 | Добавлено: 27.05.08 20:38 |
| Ближе к вечеру постараюсь... | ||
|
Номер ответа: 6 Автор ответа: SharpЛидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #6 | Добавлено: 27.05.08 22:05 |
|
function shl(a, b)
shl = (a % 2^(32-b)) * 2^b end function if len(name) > 3 then p = asc(mid(name, 2, 1)) by1 = cstr(p) p2 = asc(mid(name, 3, 1)) by2 = cstr(p2) p3 = asc(mid(name, 4, 1)) ch3 = cstr(p3) l = len(ch3) x = val(mid(ch3, l, 1)) par = cstr(shl(&HFA34C6A0, x)) if len(par) < 10 then do par = "0" & par loop until len(par) = 10 end if code.Text = par & "-" & cstr(shl(p2, 2)) & cstr(shl(p, 1)) else code.Text = "Имя введено неверно" end if Как-то так. |
||
|
Номер ответа: 7 Автор ответа: Wolf4DВопросов: 20 Ответов: 131 |
Web-сайт: Профиль | | #7 | Добавлено: 27.05.08 22:45 |
|
sub chtototam()
dim stg as variant stg = FA34C6A0 'тип данных в случае чего можно поправить dim by1 as string dim by2 as string dim par as string dim ch as string dim ch3 as string dim p as integer dim p2 as integer dim p3 as integer dim x as integer dim l as integer if len(name.Text)>3 then //ch:=pchar(name.Text) p=<функция1>  mid$(ch, 2, 1))
by1=p p2=<функция1> mid$(ch, 3, 1))
by2=p2 p3=<функция1> mid$(ch, 4, 1))
ch3=p3 l=len(ch3) x=mid$(ch3, 1, 1) par=stg <функция 2> x if len(par)<10 then while length(par)<>10 do par="0"+par endwhile end if code.Text=par+"-"+(p2 <функция 2> 2) + (p <функция 2> 1) else code.Text="Имя введено неверно" end if End Sub Фуууф... Я, конечно, знаю Delphi на весьма среднем уровне, но... Тут среднестатистический индус-кодер ногу сломит (хотя это говорить не мне, иногда предпочитающему 20 элементов одному массиву). Кроме того, местами непонятно, что значит то или иное действие... Ну да ладно. А теперь непосредственно к результату: 1) Как мог перевёл код. К концу уже "смешались кони, люди" - потому синтаксис может хромать. 2) Я VB знаю не так уж хорошо, код мой обычно не блещет прямотой и красотой, поэтому нужна помощь со стороны. В тексте можно увидеть две как бы внедрённых функции. Я не смог вспомнить им аналоги в VB - код набран за время обеденного перерыва. Так что, выручайте, профессионалы: <функция 1> - должна заменить ord - функцию, выводящую номер символа в таблице ASCII (вроде бы): http://programmersclub.ru/ord/ <функция 2> - cмещение влево и теряя старшие разряды перед смещением назад - http://www.delphibasics.ru/Shl.php P.S. Использование зарезервированных слов типа Name и Code в VB может происходить по-другому. Потому я связанное с этими словами особо и не менял... P.P.S. Потому работоспособность кода не гарантирую. |
||
|
Номер ответа: 8 Автор ответа: Wolf4DВопросов: 20 Ответов: 131 |
Web-сайт: Профиль | | #8 | Добавлено: 27.05.08 22:46 |
| Мда, как-то долго я писал *_< | ||
|
Номер ответа: 9 Автор ответа: StudioMaXICQ: 971351 Вопросов: 18 Ответов: 15 |
Профиль | | #9 | Добавлено: 28.05.08 07:18 |
|
Sharp и Wolf4D, спасибо.
В первом коде VB выдавал ошибку на функции shl function shl(a, b)
shl = (a % 2^(32-b)) * 2^b end function я заменил ее на Function shl(ByVal Value As Byte, ByVal Shift As Byte) As Byte
Dim i As Byte, Mask As Byte For i = 1 To Shift Mask = Mask + 2 ^ (8 - i) Next shl = ((Value And (Not Mask)) * 2 ^ Shift) And &HFF End Function вторая часть ответа в выражении, т.е. после "-" получилась правильная, но на строке par = Str(shl(&HFA34C6A0, x))
выходит ошибка Overflow |
||
|
Номер ответа: 10 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | | #10 | Добавлено: 28.05.08 16:57 |
| потому что это &HFA34C6A0 - не байт (Value As Byte) | ||
|
Номер ответа: 11 Автор ответа: StudioMaXICQ: 971351 Вопросов: 18 Ответов: 15 |
Профиль | | #11 | Добавлено: 29.05.08 08:32 |
| а что тогда нужно сделать? | ||
|
Номер ответа: 12 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | | #12 | Добавлено: 29.05.08 17:44 |
Function shl(ByVal Value As Long, <...> As Long
|
||
Страница: 1 |