/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 473
от 15.05.2006, 02:05

Вопрос № 42.491

Здравствуйте уважаемые эксперты! Вопрос такой. Как получить из уже динамически созданного пункта меню его свойство Caption. Как узнать на коком пункте был сделан Click. И какое возникает событие при наведении мыши на этот пункт. Спасибо.

Отправлен: 09.05.2006, 05:59 Вопрос задал: NVL (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Проходящий Мимо Здравствуйте, NVL! Создать новый пункт (или подпункт) можно так: procedure TFMain.NAddItems1Click(Sender: TObject); var vItems: TMenuItem; i: byte; begin for i := 0 to 10 do begin vItems := TMenuItem.Create(MainMenu1); vItems.Caption := 'Пункт ' + IntToStr(i); vItems.Name := 'N' + IntToStr(i); vItems.OnClick := ItemsOnClick; MainMenu1.Items.Add(vItems); end; end; Для доступа к его свойству Caption служит свойство Caption :) procedure TFMain.ItemsOnClick(Sender: TObject); begin if Sender is TMenuItem then Application.MessageBox(PChar(TMenuItem(Sender).Caption), '', 0); end; Приводим переменную Sender к типу TMenuItem и выводим значение Caption или все, что угодно: //проверить совместимость типов if Sender is TMenuItem then //привести Sender к TMenuItem with Sender as TMenuItem do begin Caption := 'Оба-на!!! Получилось!'; Tag:=100; Visible:=true; Checked:=false; //и т.д. end; --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 3-ий класс) Ответ отправлен: 10.05.2006, 12:19 Оценка за ответ: 4 Комментарий оценки: Большое спасибо. Все понятно. Жаль не на все вопросы получен ответ.

Вопрос № 42.505

Здравствуйте, уважаемые экперты! Подскажите, пожалуйста, как в Delphi реализуется шифрование md5? Заранее спасибо!

Отправлен: 09.05.2006, 12:06 Вопрос задал: Андрющенко Вячеслав Васильевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Устинов Сергей Евгеньевич Здравствуйте, Андрющенко Вячеслав Васильевич! Вот - http://delphiworld.narod.ru/base/md5.html - юнит, с помощью которого можно получить строку md5. Использование: str:='тестовая строка'; Showmessage( LowerCase(MD5DigestToStr(MD5String(str))) ); Приложение: http://delphiworld.narod.ru/base/md5.html --------- Ответы на все вопросы - на сайте www.ya.ru :)

Ответ отправил: Устинов Сергей Евгеньевич (статус: 7-ой класс) Ответ отправлен: 09.05.2006, 12:24

Отвечает: Злоумышленник Здравствуйте, Андрющенко Вячеслав Васильевич! Вот у меня валяется алгоритм хэширования MD5, надеюсь, то что тебе надо. Приложение: Function md5(s:string):string; var a:array[0..15] of byte; i:integer; LenHi, LenLo: longword; Index: DWord; HashBuffer: array[0..63] of byte; CurrentHash: array[0..3] of DWord; procedure Burn; begin LenHi:= 0; LenLo:= 0; Index:= 0; FillChar(HashBuffer,Sizeof(HashBuffer),0); FillChar(CurrentHash,Sizeof(CurrentHash),0); end; procedure Init; begin Burn; CurrentHash[0]:= $67452301; CurrentHash[1]:= $efcdab89; CurrentHash[2]:= $98badcfe; CurrentHash[3]:= $10325476; end; function LRot32(a, b: longword): longword; begin Result:= (a shl b) or (a shr (32-b)); end; procedure Compress; var Data: array[0..15] of dword; A, B, C, D: dword; begin Move(HashBuffer,Data,Sizeof(Data)); A:= CurrentHash[0]; B:= CurrentHash[1]; C:= CurrentHash[2]; D:= CurrentHash[3]; A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7); D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12); C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17); B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22); A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7); D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12); C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17); B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22); A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7); D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12); C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17); B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22); A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7); D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12); C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17); B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22); A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5); D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9); C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14); B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20); A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5); D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9); C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14); B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20); A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5); D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9); C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14); B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20); A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5); D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9); C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14); B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20); A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4); D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11); C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16); B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23); A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4); D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11); C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16); B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23); A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4); D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11); C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16); B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23); A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4); D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11); C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16); B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23); A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6); D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10); C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15); B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21); A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6); D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10); C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15); B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21); A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6); D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10); C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15); B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21); A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6); D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10); C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15); B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21); Inc(CurrentHash[0],A); Inc(CurrentHash[1],B); Inc(CurrentHash[2],C); Inc(CurrentHash[3],D); Index:= 0; FillChar(HashBuffer,Sizeof(HashBuffer),0); end; procedure Update(const Buffer; Size: longword); var PBuf: ^byte; begin Inc(LenHi,Size shr 29); Inc(LenLo,Size*8); if LenLo< (Size*8) then Inc(LenHi); PBuf:= @Buffer; while Size> 0 do begin if (Sizeof(HashBuffer)-Index)<= DWord(Size) then begin Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index); Dec(Size,Sizeof(HashBuffer)-Index); Inc(PBuf,Sizeof(HashBuffer)-Index); Compress; end else begin Move(PBuf^,HashBuffer[Index],Size); Inc(Index,Size); Size:= 0; end; end; end; procedure Final(var Digest); begin HashBuffer[Index]:= $80; if Index>= 56 then Compress; PDWord(@HashBuffer[56])^:= LenLo; PDWord(@HashBuffer[60])^:= LenHi; Compress; Move(CurrentHash,Digest,Sizeof(CurrentHash)); Burn; end; begin Init; Update(s[1],Length(s)); Final(a); result:=''; for i:=0 to 15 do result:=result+IntToHex(a[i],0); Burn; end;

Ответ отправил: Злоумышленник (статус: 7-ой класс) Ответ отправлен: 09.05.2006, 13:02

Вопрос № 42.519

Здравствуйте, как мне можно загрузить графический фаил типа *.png, мне нужно вывести этот png на bitmap на форме (чтобы были прозрачневые участки). Надеюсь вы меня поняли! Всех с праздником!

Отправлен: 09.05.2006, 15:17 Вопрос задал: Toxic~Fire (статус: 2-ой класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Решетник Д Здравствуйте, Toxic~Fire! Я не знаю, можно это без проблем сделать через стандартные компоненты, но можно почитать спецификацию формата и самому сделать "с нуля" чтение файла(http://pngdelphi.sourceforge.net/), или скачать готовый компонент для работы с графическими форматами GraphicEx (http://www.delphi-gems.com/supplement/download.php?ID=13) --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: 5-ый класс) Ответ отправлен: 09.05.2006, 15:44

Отвечает: Калашников Михаил Здравствуйте, Toxic~Fire! А это действительно нужно ? Если я правильно понял, то можно просто TImage и поверх него нужные элементы TButton etc.

Ответ отправил: Калашников Михаил (статус: 4-ый класс) Ответ отправлен: 09.05.2006, 16:28

Отвечает: sir henry Здравствуйте, Toxic~Fire! Вот зднсь находится компонент, созданый для работы с png-картинками в Delphi. http://pngdelphi.sourceforge.net/ На его основе довольно просто сделать то, что Вы хотите.

Ответ отправил: sir henry (статус: Академик) Россия, Красноярск ---- Ответ отправлен: 10.05.2006, 06:05 Оценка за ответ: 5

Отвечает: $erBep Здравствуйте, Toxic~Fire! Можешь использовать вместо png - bmp только вместо прозрачного фона подбери какой-нибудь сверестественный например Фукси. И в свойстве TBitmap поставь true напротив свойства transperent. Только учти фоновым будет цвет пикселя, находящийся в левом верхнем углу. --------- Купи самоучитель - хуже не будет.

Ответ отправил: $erBep (статус: 1-ый класс) Ответ отправлен: 11.05.2006, 17:49 Оценка за ответ: 2 Комментарий оценки: Ты не правильно понял вопрос:(

Вопрос № 42.521

Как можно програмно Узнать есль ктонибудь подключен к компу и тип подключения (обычно по сети, через терминал ...)

Отправлен: 09.05.2006, 15:46 Вопрос задал: Negruzzi Cristian (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Калашников Михаил Здравствуйте, Negruzzi Cristian! Поищи в инете исходники к одной замечательной программе Kill Watchers. По моему там все понятно.

Ответ отправил: Калашников Михаил (статус: 4-ый класс) Ответ отправлен: 09.05.2006, 16:33

Вопрос № 42.535

Добрый день. На форме есть TwebBrowser, хотелось бы сделать возможным для него включать и отключать прокси соединение и если понадобится авторизацию на прокси, т.е: Прокси адрес: порт кол-во потоков Авторизация на прокси: Имя пользователя Пароль С Уважением, Максим

Отправлен: 09.05.2006, 19:17 Вопрос задал: Maximus (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Решетник Д Здравствуйте, Maximus! В приложении приведен код, позволяющий изменить настройки прокси Возможно у Вас получится адаптировать под свои нужды Приложение: uses...urlmon, wininet... .... var PIInfo: PInternetProxyInfo; begin New(PIInfo); PIInfo^.dwAccessType := INTERNET_OPEN_TYPE_PROXY; // Изменение настроек ПРОКСИ PIInfo^.lpszProxy := PChar('some.proxy:someport'); // указать прокси напр. 195.43.67.33: 8080 PIInfo^.lpszProxyBypass := PChar(''); // Список адресов, доступ к которым возможен минуя Proxy сервер UrlMkSetSessionOption(INTERNET_OPTION_PROXY, piinfo, SizeOf(Internet_Proxy_Info), 0); .... Dispose(PIInfo); --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: 5-ый класс) Ответ отправлен: 09.05.2006, 21:58

© 2001-2006, Портал RusFAQ.ru, Россия, Москва. Идея, дизайн, программирование: Калашников О.А. Email: adm@rusfaq.ru, Тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале Версия системы: 4.32 от 03.05.2006