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

Выпуск № 492
от 04.06.2006, 00:35

Вопрос № 44.531

Здравствуйте, эксперты! Не как не могу разобраться с одной функцией в библиотеке bass.dll (это с http://www.un4seen.com/). Нужно, чтобы вывести инвормацию из ID тагов из mp3 файла. Как я понял, это осуществляется функцией BASS_BASS_ChannelGetTags (Channel,BASS_TAG_ID3). Но при этом выводится только "TAGНазвание песни". Нужно же вывести в memo или куда-нить еще всю инфу, например: Название: Песня Исполнитель: Вася Пупкин и т.д. Только не предлагайте использовать другой компонент. Нужно именно из библиотеки BASS. С остальными функциями этой б-ки я уже разобрался. Помогите, пожалуйста.

Отправлен: 29.05.2006, 01:37 Вопрос задал: Соколов С.И. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Caleb Здравствуйте, Соколов С.И.! Ну уж незнаю что там у вас за библиотека, могу только скинуть формат mp3 файла. Может это и есть то что вам надо? Файл смльри в приложении, или я могу выложить его у себя на сервере. Приложение: Формат заголовка .MP3-файлов Info from: http://www.enlight.ru Byte 0 Byte 1 Byte 2 Byte 3 ---------T--------T--------T--------¬ ¦76543210¦76543210¦76543210¦76543210¦ LTTTTTTTT+TTTTTTTT+TTTTTTTT+TTTTTTTT- ++++++++-++-+-+-¦ +++-+-¦¦ +-+-¦¦+- ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦¦L--- 00=Emphasis None ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦¦ 01=Emphasis 50/15 microseconds ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦¦ 10=Emphasis Dunno ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦¦ 11=Emphasis CITT j.17 ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦L---- 0=Original NO ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦ 1=Original YES ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ L----- 0=Copyright NO ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ 1=Copyright YES ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ L------- Смотри таблицу <<Mode extension>> ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ L--------- 00=Stereo ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ 01=Joint stereo ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ 10=Dual channel ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ 11=Single Channel (Mono) ¦ ¦ ¦ ¦ ¦ ¦ ¦¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦L----------- 0=Extension None ¦ ¦ ¦ ¦ ¦ ¦ ¦ 1=Extension Private ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ L------------ 0=Unused bits are filled (padding req.) ¦ ¦ ¦ ¦ ¦ ¦ 1=All bits in frame are used ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ L-------------- Смотри таблицу <<Sample Rate Index>> ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ L------------------ Смотри таблицу <<Bitrate>> ¦ ¦ ¦ ¦ ¦ ¦ ¦ L-------------------- 0=Error Protection Bit CRC is ON ¦ ¦ ¦ 1=Error Protection Bit CRC is OFF ¦ ¦ ¦ ¦ ¦ L---------------------- 00=Layer-? ¦ ¦ 01=Layer-3 ¦ ¦ 10=Layer-2 ¦ ¦ 11=Layer-1 ¦ ¦ ¦ L------------------------ 00=MPEG-2.5 (44100 Hz) ¦ 01=MPEG-? ¦ 10=MPEG-2.0 (22050 Hz) ¦ 11=MPEG-1.0 (11025 Hz) ¦ L------------------------------------ Sync Header, всегда 0xFFEx Таблица SAMPLE RATE MPEG-1 MPEG-2 г==T=====¬ г==T=====¬ ·00¦44100· ·00¦22050· ·01¦48000· ·01¦24000· ·10¦32000· ·10¦16000· ·11¦?????· ·11¦?????· <=- ошибка "Stream error!" L==¦=====- L==¦=====- Таблица MODE EXTENSION When encoding with joint stereo, this specifies to which freq. band it is bound. Layer-1,2 Layer-3 г==T==¬ г==T==¬ ·00¦ 4· ·00¦ 0· ·01¦ 8· ·01¦ 4· ·10¦12· ·10¦ 8· ·11¦16· ·11¦16· L==¦==- L==¦==- Таблица BIT RATE (kBit/s) MPEG-1 MPEG-2 г====T=====T=====T=====¬ г====T=====T=====T=====¬ · ¦38000¦44100¦48000· · ¦16000¦22050¦24000· ¦====+=====+=====+=====¦ ¦====+=====+=====+=====¦ ·0000¦ 0 ¦ 0 ¦ 0 · ·0000¦ 0 ¦ 0 ¦ 0 · ·0001¦ 32 ¦ 32 ¦ 32 · ·0001¦ 32 ¦ 8 ¦ 8 · ·0010¦ 64 ¦ 48 ¦ 40 · ·0010¦ 48 ¦ 16 ¦ 16 · ·0011¦ 96 ¦ 56 ¦ 48 · ·0011¦ 56 ¦ 24 ¦ 24 · ·0100¦ 128 ¦ 64 ¦ 56 · ·0100¦ 64 ¦ 32 ¦ 32 · ·0101¦ 160 ¦ 80 ¦ 64 · ·0101¦ 80 ¦ 40 ¦ 40 · ·0110¦ 192 ¦ 96 ¦ 80 · ·0110¦ 96 ¦ 48 ¦ 48 · ·0111¦ 224 ¦ 112 ¦ 96 · ·0111¦ 112 ¦ 56 ¦ 56 · ·1000¦ 256 ¦ 128 ¦ 112 · ·1000¦ 128 ¦ 64 ¦ 64 · ·1001¦ 288 ¦ 160 ¦ 128 · ·1001¦ 144 ¦ 80 ¦ 80 · ·1010¦ 320 ¦ 192 ¦ 160 · ·1010¦ 160 ¦ 96 ¦ 96 · ·1011¦ 352 ¦ 224 ¦ 192 · ·1011¦ 176 ¦ 112 ¦ 112 · ·1100¦ 384 ¦ 256 ¦ 224 · ·1100¦ 192 ¦ 128 ¦ 128 · ·1101¦ 416 ¦ 320 ¦ 256 · ·1101¦ 224 ¦ 144 ¦ 144 · ·1110¦ 448 ¦ 384 ¦ 320 · ·1110¦ 256 ¦ 160 ¦ 160 · ·1111¦ ??? ¦ ??? ¦ ??? · ·1111¦ ??? ¦ ??? ¦ ??? · L====¦=====¦=====¦=====- L====¦=====¦=====¦=====- Layer 2/3 FrameSize=144*bps/Sample_Frequency+PaddingBit Stereo Mono MPEG 1.0 32 17 MPEG 2.x 17 09 А это описание инфоpмационного тэга, тоже должно пpигодиться: Offset 00h db 'TAG' ;сигнатура информационного тэга Offset 03h db rep 1Eh (ASCII) ;Hазвание 30 байт ASCII Offset 21h db rep 1Eh (ASCII) ;Исполнитель 30 байт ASCII Offset 3Fh db rep 1Eh (ASCII) ;Альбом 30 байт ASCII Offset 5Dh db rep 04h (ASCII) ;Год 4 байта ASCII Offset 61h db rep 1Eh (ASCII) ;Комментарий 30 байт ASCII Offset 7Fh db ? ;Жанр Коды жанров 0x00...147 : Blues Classic Rock Country Dance Disco Funk Grunge Hip-Hop Jazz Metal New Age Oldies Other Pop R&B Rap Reggae Rock Techno Industrial Alternative Ska Death Metal Pranks Soundtrack Euro-Techno Ambient Trip-Hop Vocal Jazz+Funk Fusion Trance Classical Instrumental Acid House Game Sound Clip Gospel Noise Alt. Rock Bass Soul Punk Space Meditative Instrumental Pop Instrumental Rock Ethnic Gothic Darkwave Techno-Industrial Electronic Pop-Folk Eurodance Dream Southern Rock Comedy Cult Gangsta Rap Top 40 Christian Rap Pop/Funk Jungle Native American Cabaret New Wave Psychedelic Rave Showtunes Trailer Lo-Fi Tribal Acid Punk Acid Jazz Polka Retro Musical Rock & Roll Hard Rock Folk Folk/Rock National Folk Swing Fast-Fusion Bebob Latin Revival Celtic Bluegrass Avantgarde Gothic Rock Progressive Rock Psychedelic Rock Symphonic Rock Slow Rock Big Band Chorus Easy Listening Acoustic Humour Speech Chanson Opera Chamber Music Sonata Symphony Booty Bass Primus Porn Groove Satire Slow Jam Club Tango Samba Folklore Ballad Power Ballad Rhythmic Soul Freestyle Duet Punk Rock Drum Solo A Cappella Euro-House Dance Hall Goa Drum & Bass Club-House Hardcore Terror Indie BritPop Negerpunk Polsk Punk Beat Christian Gangsta Rap Heavy Metal Black Metal Crossover Contemporary Christian Christian Rock Merengue Salsa Thrash Metal Anime JPop Synthpop 148...254 -- зарезервированы 255 -- отсутствует

Ответ отправил: Caleb (статус: 1-ый класс) Ответ отправлен: 29.05.2006, 05:43 Оценка за ответ: 1 Комментарий оценки: Это не совсем то. Я могу прочитать ID3 таги из файла и так. Как бы с помощью BASS это сделать. Если кто работал с BASS от Un4seen development - ответьте!

Вопрос № 44.553

Здравствуйте эксперты! Вопрос в следующем: необходимо программно в Internet Explorer/ в свойствах обозревателя/ в закладке подключение/ сделать не активной или отключить кнопку "настройка сети".

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

Отвечает: Gh0stik Здравствуйте, Sgainf! Этот вопрос я думаю больше относиться к разделу Реестр, но все таки. Попробуйте сделать записть в реестр такого ключика: HKCUSoftwarePoliciesMicrosoftInternet ExplorerControl Panel ConnectionsTab:DWORD = 1 - скрыть вкладку "Подклучение" (0 - отображает/или удалить ключ). В Delphi это можно сделить примерно так: Procedure .... (создаем ключ) var reg:TRegistry; begin reg:=TRegistry.Create; reg.openkey('SoftwarePoliciesMicrosoftInternet ExplorerControl Panel',true); reg.WriteInteger('ConnectionsTab',1); reg.CloseKey; end; Procedure .... (удаляем ключ) var reg:TRegistry; begin reg:=TRegistry.Create; reg.openkey('SoftwarePoliciesMicrosoftInternet ExplorerControl Panel',true); if valueexists('ConnectionsTab') then reg.DeleteValue('ConnectionsTab'); reg.CloseKey; end; Удачи!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаються события на земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: 10-ый класс) Ответ отправлен: 29.05.2006, 14:02 Оценка за ответ: 5 Комментарий оценки: на строчку - if valueexists('ConnectionsTab') then - выдает ошибку [Error] Unit1.pas(41): Undeclared identifier: 'valueexists', но в принципе можно обойтись и без нее

Вопрос № 44.566

Здравствуйте, эксперты. Вот возникла проблемка по переводу чисел из одной системы счисления в другую. В принципе все сделал, осталось только конвертация ASCII символов в шестнадцатеричное представление (по принципу хекс редактора). Может вы мне подскажете как мне это реализовать? Или пример или исхоник дадите. Я тут нарыл немного. Но я не понимаю, что мне писать Приложение: function HexB(b: Byte): string; const HexChar: array[0..15] of char = \'0123456789ABCDEF\'; begin HexB := HexChar[b shr 4] + HexChar[b and $0F]; end; function HexW(w: Word): string; begin HexW := HexB(Hi(w)) + HexB(Lo(w)); end; function HexL(l: Longint): string; var HL: HiLo absolute l; //Выдает ошибку т.к. не ведает что за HiLo begin HexL := HexW(HL.HiWord) + HexW(HL.LoWord); end; function HexP(p: Pointer): string; var HL: HiLo absolute p; begin HexP := HexW(HL.HiWord) + \':\' + HexW(HL.LoWord); end; //=======Вторая часть============ Но я не понял, что писать в BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD); Может подскажите, или пример выложите. Преобразование ASCII в шестнадцатиричное представление Строка представляет собой массив байтов в виде ASCII-символов. Необходимо организовать преобразование типов по аналогии с Delphi-функциями Ord и Chr. Функция BytesToHexStr преобразует, к примеру, набор байтов [0,1,1,0] в строку \'30313130\', HexStrToBytes выполнит обратное преобразование. unit Hexstr; interface uses String16, SysUtils; type PByte = ^BYTE; procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD); procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer); procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength: WORD); implementation procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD); const HexChars: array[0..15] of Char = \'0123456789ABCDEF\'; var i, j: WORD; begin SetLength(hHexStr, (InputLength * 2)); FillChar(hHexStr, sizeof(hHexStr), #0); j := 1; for i := 1 to InputLength do begin hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]); inc(j); hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j); inc(pbyteArray); end; end; procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength: WORD); var i: WORD; c: byte; begin SetLength(Response, InputLength); FillChar(Response, SizeOf(Response), #0); for i := 0 to (InputLength - 1) do begin c := BYTE(hexbytes[i]) and BYTE($F); if c > 9 then Inc(c, $37) else Inc(c, $30); Response[i + 1] := char(c); end; {for} end; procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer); {pbyteArray указывает на область памяти, хранящей результаты} var i, j: WORD; tempPtr: PChar; twoDigits: string[2]; begin tempPtr := pbyteArray; j := 1; for i := 1 to (Length(hHexStr) div 2) do begin twoDigits := Copy(hHexStr, j, 2); Inc(j, 2); PByte(tempPtr)^ := StrToInt(\'$\' + twoDigits); Inc(tempPtr); end; {for} end; end. unit String16. interface {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); procedure SetString(var Dst: string; Src: PChar; Len: Integer); {$ENDIF} implementation {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); begin if Len > 255 then S[0] := Chr(255) else S[0] := Chr(Len) end; procedure SetString(var Dst: string; Src: PChar; Len: Integer); begin if Len > 255 then Move(Src^, Dst[1], 255) else Move(Src^, Dst[1], Len); SetLength(Dst, Len); end; {$ENDIF} end.

Отправлен: 29.05.2006, 12:26 Вопрос задал: Int20h (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Int20h! const HexChar: array[0..15] of char = \'0123456789ABCDEF\'; хорошо бы сделать глобальной. function HexB(b: Byte): string; begin HexB := HexChar[b shr 4] + HexChar[b and $0F]; end; Вот нормальная ф-ия для конвертации. Если хотите преобразовать ASCII символы, то используйте HexB(Ord(c)) {c: char} А вообще, в Делфи есть стандартная функция IntToHex - посмотрите хелп.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: 7-ой класс) Ответ отправлен: 29.05.2006, 12:43

Отвечает: Савенко Вадим Иванович Здравствуйте, Int20h! Есть такая функция Format(const SFormat: string; const Args: array of const): string; Применительно к Вашему случаю Label1.Caption:= Format('%0:x', [ord('J')]); запишет в метку число 4A, а Label1.Caption:= Format('%0:x', [ord('N')]); запишет 4E. Естественно можно напрямую число задавать: Label1.Caption:= Format('%0:x', [111]); запишет 6F.

Ответ отправил: Савенко Вадим Иванович (статус: 1-ый класс) Ответ отправлен: 29.05.2006, 14:46

Вопрос № 44.571

Здраствуйте,эксперты! Не встечали вы алгоритм по преобразования чисел в слова(например 1234467 в один миллион двести тридцатьчетыре тысячи четыреста шестдесят семь!)???

Отправлен: 29.05.2006, 12:52 Вопрос задал: chikanok (статус: 2-ой класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Coupler Здравствуйте, chikanok! Посмотри статьи delphiworld www.delphiworld.narod.ru - сумма прописью (там их 10 штук)

Ответ отправил: Coupler (статус: Студент) Ответ отправлен: 29.05.2006, 13:00

Отвечает: Решетник Д Здравствуйте, chikanok! .... в приложении один из этих вариантов Приложение: unit UIntToStroka; interface uses SysUtils; const N1: array[0..9] of string = ('ноль', 'один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); const N1000: array[1..9] of string = ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); const N11: array[0..9] of string = ('десять', 'одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать'); const N2: array[1..9] of string = ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто' ); const N3: array[1..9] of string = ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот' ); const NThousand: array[1..3] of string = ('тысяча ', 'тысячи ', 'тысяч '); const NMillion: array[1..3] of string = ('миллион ', 'миллиона ', 'миллионов '); function IntToStroka(n: Integer): AnsiString; implementation function IntToStroka(n: Integer): AnsiString; var i, j, dec, j0: Integer; s: string; degt, degm: boolean; buf: string; begin degt := false; degm := false; s := IntToStr(n); Result := ''; for i := length(s) downto 1 do begin dec := (length(s) - i + 1); // получим разряд j := StrToInt(s[i]); // получим цифру if j = 0 then j0 := 0; if (not (j in [1..9])) and (dec <> 1) then Continue; if Dec in [1, 4, 7, 10] then try if StrToInt(s[i - 1]) = 1 then begin j0 := j; Continue; end; // подготовка к 10..19 тысяч/миллионов except end; if Dec in [2, 5, 8, 11] then if j = 1 then begin case dec of 2: Result := N11[j0] + ' '; // если 10..19 тысяч/миллионов 5: begin Result := N11[j0] + ' ' + NThousand[3] + Result; degt := true; end; 8: begin Result := N11[j0] + ' ' + NMillion[3] + Result; degm := true; end; end; Continue; end; if DEC in [4..6] then begin if (j <> 0) and (not degt) then begin if dec = 4 then case j of 1: buf := NThousand[1]; 2..4: buf := NThousand[2]; // прибавим слово тысяча если ещё не добавляли 5..9: buf := NThousand[3]; end else buf := NThousand[3]; degt := true; end; end; if DEC in [7..9] then begin if (j <> 0) and (not degm) then begin if dec = 7 then case j of 1: buf := NMillion[1]; 2..4: buf := NMillion[2]; // прибавим слово миллион если ещё не добавляли 5..9: buf := NMillion[3]; end else buf := NMillion[3]; degm := true; end; end; Result := buf + Result; while dec > 3 do dec := dec - 3; case Dec of 1: if j <> 0 then if degt and (not degm) then Result := N1000[j] + ' ' + Result else Result := N1[j] + ' ' + Result; // 3 три 2: Result := N2[j] + ' ' + Result; // 23 двадцать три 3: Result := N3[j] + ' ' + Result; // 123 сто двадцать три end; Buf := ''; j0 := j; end; end; end. --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: 7-ой класс) Ответ отправлен: 29.05.2006, 13:03

Отвечает: Ерёмин Андрей Здравствуйте, chikanok! Предыдущие ответы практически исчерпывающие... Хочу лишь ещё представить код преобразования числа в сумму прописью. См. в приложении. Приложение: function NumToStr(n: double; c: byte = 0): string; (* c=0 - 21.05 -> 'Двадцать один рубль 05 копеек.' с=1 - 21.05 -> 'двадцать один' c=2 - 21.05 -> '21-05', 21.00 -> '21=' *) const digit: array[0..9] of string = ('ноль', 'оди', 'два', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят'); var ts, mln, mlrd, SecDes: Boolean; len: byte; summa: string; function NumberString(number: string): string; var d, pos: byte; function DigitToStr: string; begin result := ''; if (d <> 0) and ((pos = 11) or (pos = 12)) then mlrd := true; if (d <> 0) and ((pos = 8) or (pos = 9)) then mln := true; if (d <> 0) and ((pos = 5) or (pos = 6)) then ts := true; if SecDes then begin case d of 0: result := 'десять '; 2: result := 'двенадцать ' else result:=digit[d]+'надцать ' end; case pos of 4: result := result + 'тысяч '; 7: result := result + 'миллионов '; 10: result := result + 'миллиардов ' end; SecDes := false; mln := false; mlrd := false; ts := false end else begin if (pos = 2) or (pos = 5) or (pos = 8) or (pos = 11) then case d of 1: SecDes := true; 2, 3: result := digit[d] + 'дцать '; 4: result := 'сорок '; 9: result := 'девяносто '; 5..8: result := digit[d] + 'ьдесят ' end; if (pos = 3) or (pos = 6) or (pos = 9) or (pos = 12) then case d of 1: result := 'сто '; 2: result := 'двести '; 3: result := 'триста '; 4: result := 'четыреста '; 5..9: result:=digit[d]+'ьсот ' end; if (pos = 1) or (pos = 4) or (pos = 7) or (pos = 10) then case d of 1: result := 'один '; 2,3: result := digit[d] + ' '; 4: result := 'четыре '; 5..9: result := digit[d] + 'ь ' end; if pos = 4 Then begin case d of 0: if ts then result := 'тысяч '; 1: result := 'одна тысяча '; 2: result := 'две тысячи '; 3,4: result := result + 'тысячи '; 5..9: result := result + 'тысяч ' end; ts := false end; if pos = 7 then begin case d of 0: if mln then result := 'миллионов '; 1: result := result + 'миллион '; 2, 3, 4: result := result + 'миллиона '; 5..9: result := result + 'миллионов ' end; mln := false end; if pos = 10 then begin case d of 0: if mlrd then result := 'миллиардов '; 1: result := result + 'миллиард '; 2, 3, 4: result := result + 'миллиарда '; 5..9: result := result + 'миллиардов ' end; mlrd := false end end end; begin result := ''; ts := false; mln := false; mlrd := false; SecDes := false; len := length(number); if (len = 0) or (number = '0') then result := digit[0] else for pos := len downto 1 do begin d := StrToInt(copy(number, len - pos + 1, 1)); result := result + DigitToStr end end; function MoneyString(number: string): string; var s: string[1]; n: string; begin len := length(number); n := copy(number, 1, len-3); result := NumberString(n); s := AnsiUpperCase(result[1]); delete(result, 1, 1); result := s + result; if len < 2 then begin if len = 0 then n := '0'; len := 2; n := '0' + n end; if copy(n, len - 1, 1) = '1' then result := result + 'рублей' else begin case StrToInt(copy(n, len, 1)) of 1: result := result + 'рубль'; 2, 3, 4: result := result + 'рубля' else result := result + 'рублей' end end; len := length(number); n := copy(number, len - 1, len); if copy(n, 1, 1) = '1' then n := n + ' копеек.' else begin case StrToInt(copy(n, 2, 1)) of 1: n := n + ' копейка.'; 2, 3, 4: n := n + ' копейки.' else n := n + ' копеек.' end end; result := result + ' ' + n end; // Основная часть begin case c of 0: result := MoneyString(FormatFloat('0.00', n)); 1: result := NumberString(FormatFloat('0', n)); 2: begin summa := FormatFloat('0.00', n); len := length(summa); if copy(summa, len - 1, 2) = '00' then begin delete(summa, len - 2, 3); result := summa + '=' end else begin delete(summa, len - 2, 1); insert('-', summa, len - 2); result := summa; end; end end; end; --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессор) Россия, Тула WWW: Программирование на DELPHI: Всё для программиста. ICQ: 286837644 ---- Ответ отправлен: 29.05.2006, 14:46

Вопрос № 44.621

Здраствуйте уважаемые эксперты Как можно зделать чтобы на форме небылобы кнопок: Close, Minimize и Maximize, и чтобу форма вобще былабы без этой синеи полоски с верху? Заранее спасибо.

Отправлен: 29.05.2006, 21:43 Вопрос задал: Станислав (статус: 1-ый класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Татьяна Здравствуйте, Станислав! Эта синяя полоска называется заголовком окна, для того, чтобы ее не было установите свойство Borderstyle в bsNone Только не забывайте, что вы не сможете его двигать (необходимы дополнительные обработчики) --------- Возможно все. И ничего возможно тоже.

Ответ отправила: Татьяна (статус: Студент) Ответ отправлен: 29.05.2006, 21:49 Оценка за ответ: 5

Отвечает: Савенко Вадим Иванович Здравствуйте, Станислав! Для того, чтобы скрыть заголовок окна, но при этом иметь возможность передвигать его мышкой, нужно обмануть Windows. Чтобы Windows думала, что курсор находится над заголовком окна. Делаетсяэто так Приложение: ... protected procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest; public procedure CreateParams(var Params: TCreateParams); override; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); begin Message.Result:= HTCAPTION; end; procedure TForm1.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style:= WS_THICKFRAME or WS_POPUP; end; end.

Ответ отправил: Савенко Вадим Иванович (статус: 1-ый класс) Ответ отправлен: 30.05.2006, 06:12

Отвечает: $erBep Здравствуйте, Станислав! Да надо в свойстве "Border Style" формы поставить значение "bsNone" --------- Купи самоучитель - хуже не будет.

Ответ отправил: $erBep (статус: 2-ой класс) Ответ отправлен: 02.06.2006, 14:55

Вопрос № 44.624

Приветсвую. Такое вот дело. Написано консольно приложение, довольно емкое. Стал вопрос о неудобности его использования. Речь идет о скрытии окна или в трей или еще как, но с возможностью в нужным момент его увидеть. Перепесать все на VCL нет возможности. Вот хотелось бы узнать, как можно отправить это приложение мое или в консоль из самого себя, или сторонний ехе написать или еще каким другим способом.

Отправлен: 29.05.2006, 22:24 Вопрос задал: CJ (статус: Практикант) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: chikanok Здравствуйте, CJ! Вы можете спрятать окно консоли послав ему сообщение SW_HIDE, а для противоположного действия SW_SHOW. Поймать его HWND можно функциями FindWindow или FindWindowEx (Например:wnd:=FindWindow('ConsoleWindowClass',nil);,сработает только в том случае если запущено одно консольное приложение,можете уточнить по заголовку(второй параметр функции) где скорее всего путь и имя файла). Для управления можете написать маленькое приложение на WinAPI с зарегистрированной горячей клавишей! Пример в приложении! А вообще можно спрятоть и эту программку если в процедуре ShowWindow(mainWnd,SW_SHOW) заменить на SW_HIDE. Удачи! Приложение: wnd:=FindWindow('ConsoleWindowClass',nil); showWindow(wnd,SW_HIDE); or showWindow(Wnd,SW_SHOW); ...........Маленькая программка uses windows, messages; const HOTKEY1 = 1001;//константа для идентификации горячей клавиши var wc : TWndClassEx; MainWnd : THandle; Mesg : TMsg; wnd:HWND; function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall; var nCode, ctrlID : word; begin case msg of WM_HOTKEY : begin //обработчик события нажатия на зарегистрированную горячую клавишу if wParam=HOTKEY1 then begin wnd:=FindWindow('ConsoleWindowClass',nil); if isWindowVisible(wnd) then showwindow(wnd,SW_HIDE) else showwindow(wnd,SW_SHOW); end; end; WM_DESTROY : begin UnregisterHotKey(mainwnd, HOTKEY1);//уничтожение созданной ранее горячей клавиши postquitmessage(0); Result:=0; end; else Result:=DefWindowProc(wnd,msg,wparam,lparam); end; end;//of WindowProc begin wc.cbSize:=sizeof(wc); wc.style:=CS_HREDRAW OR CS_VREDRAW; wc.lpfnWndProc:=@WindowProc; wc.cbClsExtra:=0; wc.cbWndExtra:=DLGWINDOWEXTRA; wc.hInstance:=HInstance; wc.hIcon:=LoadIcon(0,idi_application); wc.hCursor:=LoadCursor(0,idc_arrow); wc.hbrBackground:=COLOR_BTNFACE+1; wc.lpszMenuName:=nil; wc.lpszClassName:='HotKeyCatcher_class'; RegisterClassEx(wc); MainWnd:= CreateWindow('HotKeyCatcher_class', '', WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0,hInstance,nil); //$4E – шестнадцатеричный код клавиши с символом N if not RegisterHotKey(MainWnd,HOTKEY1,MOD_WIN, $4E) then MessageBox(mainwnd, 'Не удалось зарегистрировать горячую клавишу', '', MB_OK); ShowWindow(MainWnd,SW_SHOW); While GetMessage(Mesg,0,0,0) do begin if mainWnd<>0 then if IsDialogMessage(mainWnd,Mesg) then continue; TranslateMessage(Mesg); DispatchMessage(Mesg); end; end. --------- Главное желание,а там разберёмся!

Ответ отправил: chikanok (статус: 2-ой класс) Ответ отправлен: 29.05.2006, 23:35

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