Класс для копирования в отдельном потоке с отображением прогресса. Бывает ситуация, когда нужно скопировать большой файл(ы), при этом стандартная ф-ция FileCopy вешает всю программу до тех пор, пока не закончится копирование. Я разработал класс, в котором используется возможности ф-ции CopyFileEx (использовал ANSI версию), отображение прогресса копирования и возможности отмены, а также многопоточность для запуска всех функций в фоновом потоке. При запущенном процессе копирования, нельзя останавливать среду кнопкой стоп, только закрытием (нужно обязательно вызывать деструктор класса), иначе возможны глюки. Также желательно не запускать одновременно копирование большого количества файлов т.к. на каждое копирование создается отдельный поток, и при большом их количестве будут тормоза. Для отдельного потока использовал ассемблерную вставку со следующим кодом: Код (ASM): ; Основная функция вызываемая в новом потоке при копировании Copy: xor eax,eax ; eax <- 0 push eax ; Локальная переменная pbCancel mov ecx,esp ; Сохраняем адрес переменной push eax ; dwCopyFlags push ecx ; Указатель на pbCancel push eax ; lpData push 0x0 ; lpProgressRoutine push 0x0 ; lpNewFileName push 0x0 ; lpExitingFileName call 0x0 ; Вызов CopyFileEx mov dword [0],eax ; Возвращаемое значение xor eax,eax ; dwExitCode call 0x0 ; Вызов ExitThread ; Функция обратного вызова CopyProgressRoutine CopyProgressRoutine: fild qword [esp+12] ; LARGE_INTEGER в вещественное число TotalBytesTransferred fild qword [esp+4] ; LARGE_INTEGER в вещественное число TotalFileSize fdivp ; делим на TotalFileSize fstp dword [0] ; Сохраняем в переменную mov eax, dword [0] ; Возвращаемое значение ret 0x34 Вместо нулей, вписываются данные походу в процедурах LoadStaticValue - это те, которые не будут изменяться и LoadDynamicValue - это имена файлов. Использовать класс можно и один для нескольких копирований или же несколько для одновременного копирования. PS. Т.к. не рекомендуется завершать потоки через TerminateThread, я использовал ExitThread в самом потоке, поэтому при большом количестве файлов, обрабатываемых одновременно, при закрытии окна, каждый класс ждет завершения своего потока и VB6 замирает на это время.
Модуль с расширенными математическими функциями для вещественных и комплексных чисел. Deg - из градусов в радианы; LogX - логарифм по основанию X; Log10 - десятичный логарифм; Log2 - двоичный логарифм; Ceil - округление в большую сторону; Floor - округление в меньшую сторону; Sec - секанс вещественного числа; Csc - косеканс вещественного числа; Ctg - котангенс вещественного числа; Asin - арксинус вещественного числа; Acos - арккосинус вещественного числа; Asec - арксеканс вещественного числа; Acsc - арккосеканс вещественного числа; Atan2 - угол чей тангенс равен отношению двух величин; Actg - арккотангенс вещественного числа; Sinh - гиперболический синус вещественного числа; Cosh - гиперболический косинус вещественного числа; Tanh - гиперболический тангенс вещественного числа; Ctgh - гиперболический котангенс вещественного числа; Sech - гиперболический секанс вещественного числа; Csch - гиперболический косеканс вещественного числа; Asinh - гиперболический арксинус вещественного числа; Acosh - гиперболический арккосинус вещественного числа; Atanh - гиперболический арктангенс вещественного числа; Actan - гиперболический арккотангенс вещественного числа; Asech - гиперболический арксеканс вещественного числа; Acsch - гиперболический арккосеканс вещественного числа; Max - максимум двух чисел; Max3 - максимум трех чисел; Max4 - максимум четырех чисел; Min - минимум двух чисел; Min3 - минимум трех чисел; Min4 - минимум четырех чисел; IEEERemainder - остаток от деления вещественных чисел; rMod - остаток от деления вещественных чисел; cxOne - комплексная единица; cxImgOne - мнимая единица; cxZero - нулевое комплексное число; cxNew - создание нового комплексного числа; cxPolar - создание нового комплексного числа по полярным координатам; cxNeg - аддитивная инверсия комплексного числа; cxInv - мультипликативная инверсия комплексного числа; cxAdd - сложение двух комплексных чисел; cxSub - вычитание двух комплексных чисел; cxMul - умножение двух комплексных чисел; cxDiv - деление двух комплексных чисел; cxDgr - возведение комплексного числа в вещественную степень; cxSqr - квадратный корень комплексного числа; cxMod - модуль комплексного числа; cxPhase - фаза комплексного числа; cxArg - аргумент комплексного числа; cxExp - комплексная экспонента; cxAddReal - сложение комплексного и вещественного числа; cxSubReal - вычитание из комплексного числа вещественного; cxRealSub - вычитание комплексного числа из вещественного; cxMulReal - умножение комплексного числа на вещественное; cxDivReal - деление комплексного числа на вещественное; cxRealDiv - деление вещественного числа на комплексное; cxAddImg - добавить вещественное число к мнимой части; cxSubImg - вычесть вещественное число из мнимой части; cxImgSub - вычесть из мнимой части заданной как вещественное комплексного числа; cxMulImg - умножение комплексного числа на мнимую часть; cxDivImg - деление комплексного числа на мнимую часть; cxImgDiv - деление мнимой части на комплексное число; cxEq - проверить, являются ли комплексные числа равными; cxAbs - абсолютное значение комплексного числа; cxConj - сопряжение комплексного числа; cxLog - натуральный логарифм комплексного числа; cxLogX - логарифм комплексного числа по основанию X; cxSin - синус комплексного числа; cxCos - косинус комплексного числа; cxTan - тангенс комплексного числа; cxCtg - котангенс комплексного числа; cxSec - секанс комплексного числа; cxCsc - косеканс комплексного числа; cxAsin - арксинус комплексного числа; cxAcos - арккосинус комплексного числа; cxAtan - арктангенс комплексного числа; cxActg - арккотангенс комплексного числа; cxAsec - арксеканс комплексного числа; cxAcsc - арккосеканс комплексного числа; cxSinh - гиперболический синус комплексного числа; cxCosh - гиперболический косинус комплексного числа; cxTanh - гиперболический тангенс комплексного числа; cxCtgh - гиперболический котангенс комплексного числа; cxSech - гиперболический секанс комплексного числа; cxCsch - гиперболический косеканс комплексного числа; cxAsinh - гиперболический арксинус комплексного числа; cxAcosh - гиперболический арккосинус комплексного числа; cxAtanh - гиперболический арктангенс комплексного числа; cxActgh - гиперболический арккотангенс комплексного числа; cxAsech - гиперболический арксеканс комплексного числа; cxAcsch - гиперболический арккосеканс комплексного числа; PrintMtrx - напечатать матрицу; mxCreate - создать матрицу; mxNull - создать пустую матрицу; mxIdt - создать единичную матрицу; mxTrans - транспонировать матрицу; mxMulReal - умножение матрицы на число; mxAdd - сложение двух матриц; mxSub - разность двух матриц; mxMul - умножение двух матриц; mxDtm - детерминант матрицы;
Шифрование EXE файла. Всем привет! Представляю пример реализации простого шифрования EXE файла на основе файла лицензии. При некорректном файле лицензии EXE не запустится и выдаст сообщение об ошибочной лицензии, большинство кода будет зашифрованным, в ином случае EXE сам расшифровывает свой код и запускается. Как это работает? Во-первых, чтобы была возможность расшифровывать EXE нужно чтобы код расшифровки не шифровался. Для этого в коде используются функции маркеры: BEGIN_OF_NON_ENCRYPTABLE_REGION и END_OF_NON_ENCRYPTABLE_REGION. Код между ними будет нетронут. Во-вторых, для шифрования файла нужно запустить его с параметром crypt:[файл лицензии], к примеру: В этом случае EXE запускает процедуру самошифрования. В качестве файла лицензии может использоваться любой непустой файл. Если файл уже зашифрован - то возникнет ошибка. Для идентификации зашифрован ли файл используется поле VBHeader.pProjectInfo->dwNull которое не используется в скомпилированном файле и мы можем хранить любую информацию там. Я храню там контрольную сумму, где старший бит определяет факт шифрования. В общем процедура шифрования определяет границы исполняемого кода и XOR'ит его с файлом лицензии, который выступает как кольцевой буфер. Потом контрольная сумма оригинальных данных сохраняется в вышеуказанное поле EXE файла. Шифрованный файл сохраняется как [ModuleName]__encrypted.[extension] в той же директории, оригинальный файл не изменяется. Теперь если запустить файл то программа сначала проверит файл лицензии (он должен называться license.lic и лежать в директории EXE) и если попытается расшифровать его, одновременно вычисляя контрольную сумму. Если после полной расшифровки сумма совпадает - файл успешно расшифрован и запускается основной код, в противном случае выводится сообщение об ошибке. Вот пример это код до шифрования: Этот код после: Спасибо за внимание!
TrickSound - класс для работы с аудио. Привет всем! Этот класс предоставляет простой интерфейс для захвата и воспроизведения звука. Он также не требует никаких дополнительных зависимостей и работает автономно. Объект данного класса генерирует событие NewData когда устройство захвата заполняет внутренний буфер звуковыми данными или устройству воспроизведения требуется очередная порция звуковых данных. Для того чтобы инициализировать воспроизведение вызовите метод InitPlayback, для захвата InitCapture. Затем нужно вызвать StartProcess для того чтобы начать воспроизведение/захват. Я сделал два примера использования этого класса: простой синтезатор и простой диктофон.
Класс для асинхронного ожидания объектов ядра Разработал класс для асинхронного ожидания объектов ядра. Класс генерирует событие при установке объекта в сигнальное состояние или при таймауте. Работает с любыми объектами. Класс имеет 3 метода vbWaitForSingleObject, vbWaitForMultipleObjects, IsActive, Abort. Первые два аналогичны вызову одноименных API функций без префикса "vb" и запускают ожидание объекта в новом потоке. Методы завершаются немедленно. При завершении функций в новом потоке генерируется событие OnWait, в параметрах которого содержится описатель объекта и возвращенное значение. При удачном завершении методы возвращают True, иначе False, также генерируются исключения. IsActive - возвращает True, если идет ожидание, иначе False. Abort - прерывает ожидание, при удачном выполнении возвращает True. Экземпляр класса может обрабатывать только один вызов за раз. В примере я подготовил 3 случая использования данного класса: отслеживание тика ожидающего таймера, отслеживание завершения приложения, отслеживание файловых операций в папке. Как это работает. Создается окно для приема уведомлений в главном потоке. При вызове метода ожидания создается новый поток с одноименной API функцией. Когда функция отрабатывает (по сигнальному состоянию, таймауту или ошибке) она передает сообщение нашему окну, которое обрабатывая его генерирует событие для текущего экземпляра объекта. Все манипуляции сделаны на ассемблере, что позволило обойтись одним классом (без модулей), к тому же для всех экземпляров используется один код. Также сделал небольшие проверки в IDE (в скомпилированном виде они отсутствуют), поэтому можно останавливать кнопкой "в среде", жать паузы без последствий (события просто не будут вызваны). Единственный способ "вылета" может произойти если запустить ожидание, остановить его кнопкой стоп (не вызвать деструктор). Потом опять запустить среду - если в этот момент отработает событие из прошлого запуска - будет вылет, т.к. того объекта уже нет. Код на ассемблере: Код (ASM): [BITS 32] WAITFORSINGLEOBJECT: mov ecx, [esp+4] push ecx push dword [ecx+4] ; dwTime push dword [ecx] ; hHandle call 0x12345678 ; WaitForSingleObject pop ecx mov dword [ecx+32], eax ; Long -> Variant lea eax, [ecx+12] push eax ; Параметры в RAISE (lParam) push eax ; --- (wParam) push 0x400 ; WM_ONWAIT (uMsg) push dword [ecx+8] ; hWnd call 0x12345678 ; PostMessage ret 0x4 WAITFORMULTIPLEOBJECTS: mov ecx, [esp+4] push ecx push dword [ecx+4] ; dwTime push dword [ecx+8] ; WaitAll push dword [ecx] ; lpHandles push dword [ecx+12] ; nCount call 0x12345678 ; WaitForMultipleObjects pop ecx mov dword [ecx+40], eax ; Long -> Variant lea eax, [ecx+20] push eax ; Параметры в RAISE (lParam) push eax ; --- (wParam) push 0x400 ; WM_ONWAIT (uMsg) push dword [ecx+16] ; hWnd call 0x12345678 ; PostMessage ret 0x4 WINDOWPROC: cmp word [esp+8], 0x400 ; If Msg = WM_ONWAIT jz WM_ONWAIT jmp 0x12345678 ; DefWindowProc WM_ONWAIT: ; Процедура для исключения падения в IDE call 0x12345678 ; call EbMode test al,al ; Если остановлен jz CLEAR cmp al,1 ; Если запущен jz RAISE jmp 0x12345678 ; DefWindowProc CLEAR: ; Очистка push dword [esp+4] ; hwnd call 0x12345678 ; DestroyWindow jmp 0x12345678 ; DefWindowProc ; Конец заглушки RAISE: ; Возбуждение события mov esi, dword [esp+0xc] ; Указатель на источник sub esp, 44 ; 44 байт параметров mov edi, esp ; Указатель на стек cld ; df = 0 (увеличение счетчиков) xor ecx,ecx mov cl,11 ; 44 Байт (параметры _vbaRaiseEvent и аргументы rep movsd call 0x12345678 ; __vbaRaiseEvent add esp, 44 ret 0x10
Модуль для удаления всех ресурсов после выполнения программы. Всем привет. Я бы хотел продемонстрировать небольшой проект, который содержит модуль для удаления файлов после завершения работы EXE. Это может быть полезно к примеру для программы которая использует какие-либо библиотеки для своей работы и нужно обеспечить удаление этих компонентов с жесткого диска после выполнения программы. Этот модуль позволяет даже удалить собственный EXE после завершения работы. Принцип работы очень прост, модуль содержит шеллкод написанный на VB6 который внедряется в процесс "зомби" и ждет завершения программы. После завершения программы шеллкод удаляет файлы которые пользователь передал в него, т.е. исключаются какие-либо блокировки со стороны EXE файла, поэтому мы можем все удалять даже сам EXE. После выполнения всех действий шеллкод завершает работу процесса "зомби". Для того чтобы обеспечить удаление файлов после работы EXE нужно вызвать функцию CleanFiles передавая в качестве параметра список файлов для удаления. Можно вызвать эту функцию как в начале работы приложения, в этом случае файлы будут удалены даже если приложение завершилось аварийно, так и в конце работы приложения. В аттаче небольшой пример использования который распаковывает внутренний OCX, а после завершения приложения удаляет его и собственный EXE файл.
DirectX в VB6 Всем привет. В архиве содержится библиотека типов "DirectX 9 for Visual Basic 6.0 type library by The trick" (dx9vb.tlb) содержащая описание следующих интерфейсов: IDirect3D9; IDirect3DDevice9; IDirect3DSurface9; IDirect3DResource9; IDirect3DSwapChain9; IDirect3DTexture9; IDirect3DBaseTexture9; IDirect3DVolumeTexture9; IDirect3DVolume9; IDirect3DCubeTexture9; IDirect3DVertexBuffer9; IDirect3DIndexBuffer9; IDirect3DStateBlock9; IDirect3DVertexDeclaration9; IDirect3DVertexShader9; IDirect3DPixelShader9; IDirect3DQuery9; Также в этой библиотеке задекларированы множество типов, констант и энумов. Также в архиве содержится несколько модулей написанных на VB6: D3DX_COLOR.bas - для работы с цветами D3DX_MATRICES.bas - для работы с матрицами D3DX_QUATERNION.bas - для работы с кватернионами D3DX_VECTOR2.bas, D3DX_VECTOR3.bas, D3DX_VECTOR4.bas - для работы с векторами D3DX_MISC.bas - различные функции которые не вошли не в одну из вышеоисанных категорий Эти модули содержат аналоги соответствующих функций D3DX. Также в архиве содержится несколько тестовых примеров работы. Скачать.
DirectSound в VB6 Параллельно с Direct3D9 я делал библиотеку типов и модуль с вспомогательными функциями для DirectSound. В архиве библиотека типов dsvb.tlb и модуль DS_Functions.bas. В дальнейшем добавлю модуль класса для поддержки асинхронных уведомлений, пока можно пользоваться этим. В модуле DS_Functions содержатся следующие функции: DSCreateSoundBufferFromFile - создает объект с интерфейсом IDirectSoundBuffer8 из файла. Поддерживаются только WAVE и MP3 файлы. MP3 файлы могут содержать только ID3v1 и ID3v2 теги, какие-либо другие возможно не распознаются/не будут работать. Слишком длинные (по времени) файлы не поддерживаются. Для потокового воспроизведения нужно писать потоковое декодирование на основе кода функции DSCreateSoundBufferFromMemory. DSCreateSoundBufferFromMemory - тоже самое, но вместо файла передается указатель на данные файла в памяти и их размер. Также в архиве содержится пример плеера который реализует некоторые методы IDirectSoundBuffer8 интерфейса (громкость, панорама, частота, эффекты). TLB также особо сильно не тестировалась, поэтому что-то может не работать. Если что-то не работает пишите сюда. Скачать.
Класс - MP3 проигрыватель из памяти. Всем привет. Я разработал класс для асинхронного воспроизведения MP3 файлов в памяти. Например это может пригодится для воспроизведения фоновой музыки из ресурсов или из сети минуя запись в файл. Воспроизводить можно несколько файлов одновременно, но некоторые параметры воспроизведения (громкость, панорама) для всех проигрывателей будут общими. Класс разработан так, что корректно обрабатывает ситуации остановки среды кнопками "стоп", "пауза" и выхода по End. По тегам, корректно обрабатываются только ID3v1 и ID3v2 теги, другие не распознаются и файл скорее всего не будет играться. Методы: Initialize - инициализирует проигрыватель, в качестве первого параметра передается указатель на данные MP3 файла. Второй параметр указывает на размер данных. Третий параметр определяет нужно ли копировать файл во внутренний буфер внутри объекта и воспроизводить файл оттуда; Play - запускает воспроизведение, параметр looped при первом воспроизведении определяет будет ли файл зацикливаться; Pause - приостанавливает воспроизведение, следующее воспроизведение начнется с текущей позиции; StopPlaying - останавливает воспроизведение; SetPositionMs - устанавливает текущую позицию воспроизведения (мс); GetPositionMs - возвращает текущую позицию воспроизведения (мс); GetDurationMs - возвращает длину файла в миллисекундах; GetBitrate - возвращает битрейт на момент воспроизведения (кб/с); IsPlaying - определяет играется ли файл; Свойства: Volume - задает/возвращает текущую громкость воспроизведения (0...1); Pan - задает/возвращает текущую панораму воспроизведения ((левый канал)-1...1(правый канал)).
Хеш - таблица VB6 Представляю автономный класс реализующий хеш-таблицу, который во многих случаях может стать заменой словаря (Dictionary) из Scripting runtime. Реализованы все те же методы что и у словаря, а также добавлены новые. Включена поддержка перечисления через For Each, также можно задавать режим перечисления ключи/значения, также по сравнению с предыдущей версией исправлены баги вылета из среды при остановки в теле циклов For Each, а также нет никаких ограничений на вложенные циклы. Работает достаточно быстро, на моей машине приблизительно также (даже чуть быстрее) как словарь при двоичном сравнении, при текстовом сравнении работает почти в 2-раза быстрее словаря. В качестве ключей допускаются Variant переменные с типам от vbEmpty до vbDecimal включительно. Числовые ключи должны быть уникальны, т.е. -1, True, -1e0 - один и тот же ключ как и в словаре. Новый метод EnumMode - определяет текущий режим перечисления. Допустимые значения ENUM_BY_KEY, ENUM_BY_VALUE. При входе в цикл For Each начинает перечисляться тот параметр, который задан этим свойством. Например можно перечислять в главном цикле ключи, во вложенном значения, или сначала ключи потом значения. Также задавая это свойство в окнах Locals или Watch можно переключать отображение с ключей на значения и обратно. Сама реализация представляет собой массив двусвязных списков, где индексы массива - хеш-значения соответствующих ключей. Для поддержки перечисления используется объект-перечислитель. Реализация интерфейса IEnumVariant и IUnknown для перечислителя написана на ассемблере: Код (ASM): [BITS 32] QueryInterface: mov eax,[esp+4] ; ObjPtr inc dword [eax+4] ; Counter++ mov ecx, [esp+0xc] mov [ecx],eax ; ppvObject = ObjPtr xor eax,eax ; Success ret 0xc AddRef: mov eax,[esp+4] ; ObjPtr inc dword [eax+4] ; Counter++ mov eax, [eax+4] ; Counter return ret 0x4 Release: mov eax,[esp+4] ; ObjPtr dec dword [eax+4] ; Counter-- jz RemoveObject ; if (Counter == 0) mov eax, [eax+4] ; Counter return ret 0x4 RemoveObject: push eax ; lpMem push 0x00000001 ; HEAP_NO_SERIALIZE call 0x12345678 ; GetProcessHeap push eax ; hHeap call 0x12345678 ; HeapFree xor eax,eax ; Counter = 0 ret 0x4 IEnumVariant_Next: push ebx push edi push esi mov esi, [esp+0x10] ; ObjPtr mov ebx, [esp+0x14] ; ebx = celt mov edi, [esp+0x18] ; rgVar NextItem: movsx eax, word [esi+0x8] ; Pointer.Hash inc eax jz ExitCycle ; if (Pointer.Hash == -1) dec eax mov ecx, [esi+0xc] ; DataPtr mov ecx, [ecx+eax*8+4] ; ecx = tItem.tElement movzx eax, word [esi+0xA] ; Pointer.Index imul ax, ax, 0x28 ; movzx eax, ax ; eax = Pointer.Index * sizeof(tElement) mov ecx, [ecx+0xc] ; ecx = *tElement(0) lea ecx, [ecx+eax] ; *tElement(Pointer.Index) mov eax, [ecx+0x20] add ecx, [esi+0x14] ; ecx += OffsetVarinat mov [esi+0x8], eax ; Pointer = tElement(Pointer.Index).Next push ecx ; pvargSrc push edi ; pvargDest == rgVar call 0x12345678 ; VariantCopy add edi, 0x10 dec ebx jne NextItem ExitCycle: test ebx, ebx setne dl ; if (ebx = 0) dl = 0 else dl = 1 movzx esi, dl ; edx = dl mov edi, [esp+0x1c] ; pCeltFetched test edi, edi je ExitFunction mov eax, [esp+0x14] ; eax = celt sub eax, ebx mov [edi], eax ; pCeltFetched = count ExitFunction: mov eax, esi pop esi pop edi pop ebx ret 0x10 IEnumVariant_Skip: mov edx, [esp+0x04] ; ObjPtr mov eax, [edx+0x8] ; Pointer.Hash mov edx, [edx+0xc] ; DataPtr NextItem_2: inc ax jz ExitCycle_2 ; if (Pointer.Hash == -1) dec ax movzx ecx, ax ; ecx = Pointer.Hash mov ecx, [edx+ecx*8+4] ; ecx = tItem.tElement shr eax, 0x10 ; eax = Pointer.Index imul ax, ax, 0x28 ; mov ecx, [ecx+0xc] ; ecx = *tElement(0) mov eax, [ecx+eax+0x20] ; eax = tElement(Pointer.Index).Next dec dword [esp+0x08] ; celt-- jne NextItem_2 xor edx, edx ExitCycle_2: test edx, edx setne dl ; if (edx = 0) dl = 0 else dl = 1 mov eax, edx ret 0x08 IEnumVariant_Reset: mov eax, [esp+0x04] ; ObjPtr mov edx, [eax+0x10] ; First mov [eax+0x08], edx ; Pointer = First xor eax, eax ret 0x4 Код создается только при создании первого объекта, и используется всеми последующими объектами. Адрес хранится в переменных окружения. Также я написал небольшое тестовое приложение для сравнения скоростей словаря и моей хеш-таблицы. Кнопка "Add 100000" добавляет 100000 записей в словарь/таблицу и отображает время работы. Кнопка "Clear" очищает словарь/таблицу. Кнопка "Access all" перечисляет все элементы используя доступ по ключу. Кнопка "For each" перечисляет все элементы используя For Each цикл. Огромная благодарность Алексу (Dragokas) за дебаггинг.
Распознавание речи используя API.AI Небольшой пример использования средств API.AI для распознавания голосовых команд.
Пользовательская отрисовка окна В Windows 7 появилась замечательная вещь - индикация прогресса на кнопках панели задач. Чтобы использовать данную возможность на VB6 (и в любых других языках) нужно создать объект TaskBarList, получить интерфейс ITaskBarList3 и воспользоваться его методами SetProgressState и SetProgressValue. В своем модуле я добавил возможность задавать состояние индикатора прогресса на панели задач, а также продублировал этот индикатор на саму форму + добавил возможность использования анимированных иконок в заголовке формы (также поддерживаются и обычные иконки). Из данного примера можно узнать, как самому отрисовывать неклиентскую область окна, делать кнопки которые подсвечиваются при наведении. В примере используется двойная буфферизация, поэтому все работает гладко и без мерцаний. Данный модуль можно прециплять к любому проекту с любыми формами.
Перевод из строки в число и обратно. VB-шные функции для перевода и проверки чисел в строки (и обратно) очень неудобные, в плане того что туда можно много чего написать, и они их "съедят". Можно написать числа в шестнадцатеричной системе или в скобках, в экспоненциальной записи и т.п. С одной стороны это хорошо, но с другой может быть проблемой. Я написал 2 функции которые переводят десятичные целые числа неограниченной размерности из одного представления в другое. Может быть полезно например для отображения (установки) LARGE_INTEGER или любых других больших (сверхбольших) чисел. Код (Visual Basic): Option Explicit Private Declare Function GetMem2 Lib "msvbvm60" (Src As Any, Dst As Any) As Long Private Sub Form_Load() Dim Value() As Byte, Res As String StrToUI "1234567891011121314151617181920", Value Res = UIToStr(Value) End Sub ' Перевод беззнакового целого числа из байтового представления в строку Private Function UIToStr(bValue() As Byte) As String Dim i As Long, f As Boolean, loc() As Byte loc = bValue Do i = Div10UI(loc) UIToStr = CStr(i) & UIToStr f = False For i = UBound(loc) To 0 Step -1 If loc(i) Then f = True: Exit For Next Loop While f End Function ' Перевод беззнакового целого числа из строкового представления в массив байт Private Sub StrToUI(sValue As String, Out() As Byte) Dim i As Long, lpStr As Long, v As Integer, b(0) As Byte ReDim Out(0) If Len(sValue) Then lpStr = StrPtr(sValue) For i = 0 To Len(sValue) - 1 GetMem2 ByVal lpStr, v v = v - &H30 If v < 0 Or v > 9 Then Err.Raise 13: Exit Sub b(0) = v If i Then Mul10UI Out AddUI Out, b() lpStr = lpStr + 2 Next Else: Err.Raise 5 End If End Sub Private Sub AddUI(Op1() As Byte, Op2() As Byte) Dim i As Long, p As Long, o As Long, q As Long If UBound(Op1) < UBound(Op2) Then ReDim Preserve Op1(UBound(Op2)) Do If i <= UBound(Op2) Then o = Op2(i) Else o = 0 q = CLng(Op1(i)) + o + p p = (q And &H100&) \ &H100 Op1(i) = q And &HFF i = i + 1 Loop While CBool(o Or p) And i <= UBound(Op1) If p Then ReDim Preserve Op1(i): Op1(i) = p End Sub Private Function Div10UI(Value() As Byte) As Long Dim i1 As Long, i2 As Long, acc() As Byte, loc() As Byte, q As Long, p As Long For i1 = 0 To (UBound(Value) + 1) * 8 Div10UI = (Div10UI * 2) Or p If Div10UI < 10 Then p = 0 Else p = 1: Div10UI = Div10UI - 10 For i2 = 0 To UBound(Value) q = (CLng(Value(i2)) * 2) Or p p = (q And &H100) \ &H100 Value(i2) = q And &HFF& Next Next End Function Private Sub Mul10UI(Value() As Byte) Dim i As Long, p As Long, q As Long For i = 0 To UBound(Value) q = (CLng(Value(i)) * 4 + Value(i)) * 2 + p p = (q And &HFF00&) \ &H100 Value(i) = q And &HFF Next If p Then ReDim Preserve Value(i): Value(i) = p End Sub
Новый васм умилил меня VB. Это всё Ваши творения? Думал, что его уже не используют, языков нынче много.
да, VB - это один из тех языков программирования и сред, которые просто не хотят умирать... я помню времена, когда майкрософт хотела его выпилить с релизом 8ой венды в пользу VB.NET, но он живет и по сей день... кстати любителям VB советую так же посмотреть PureBasic и FreeBasic...
FreeBasic отвратителен и не заслуживает упоминания. Дело не в синтаксисе языка, сколько в подходе разрабочиков (опенсорц такой опенцсорц, далее поймете почему). Таки разница между free (open) платформой и paid, часто громадна. Пример. Захотел я игру написать. И вот нужно мне вывести на экран текст. Логично для этого использовать TTF-шрифты из виндов. И там, где в других средах вопросов не возникает, во FreeBasic я сталкиваюсь с тем, что в нем этого просто нет. Нельзя вывести надпись на экран используя шрифты. Из готового/встроенного есть библиотека тайлов, где чтобы выводить шрифт, я должен как в незапамятные времена, подготовить битмап (png с прозрачностью), и фигачить из него. Или есть _своя либа для шрифтов, со своим форматом, и даже написанным конвертером из TTF. На вопрос, а как сделать, используя родные шрифты, мне предлагают фрактальный костыль /костыль, сделанный из костылей/ - прогу, где намешан FreeBasic, встроенный Асм для математики (ручной разбор вектор-формата, или у меня уже фантазия играет?), и вызовов ВинАпи - ок, я бы такое проглотил - но оно не умеет кириллические шрифты, вот незадача. Нет решения. Схожие муки испытал, пытаясь подключить либу для работы с Png/Jpg, оно содержит .a файлы, имеющие отн-е к Линукс-системам. Игрища с вызовом компилятора (а компиль там опенсорцный, mingw если не ошибась) с разными опциями и неистовое гугление оставили осадок в виде сомнений в собственном IQ. Видимо, встроить GDI вызовы виндовых библиотек в FreeBasic - разработчикам не позволяет религия - я должен писать это сам. Или давайте костылить, писать либы, разбирать в либах форматы битмапов вручную, это же так увлекательно (во времена дос не было другого выбора, но сейчас вроде не та эпоха). Нет решения. PureBasic понравился больше. Очевидный плюс - то что вышеописанное делается "изкаропки", как собственно и должно быть, т.к. оно уже встроено в ОСь. Немного напрягает, что везде нужно делать If/endif. FreeBasic резко умер годах в 2006-09, судя по упадку сайтов и журналов (да, были целые журналы игроделов, посвяященные FB/QB; собственно, кроме бесплатности, у FB есть преимущество в виде поддержки синтаксиса QBasic, - проги из QB можно запустить в FB без переделок). PureBasic кроссплатформенный, если не извращаться и использовать только средства языка, код перекомпилируется что под Вин, что под Линукс. PureBasic стоит денег (двусмысленная фраза, да, он платный, но этими деньгами оплачивается его потенциал). Версия 5 умеет x64, но на мой взгляд, для x32 код лучше компилировать более старыми версиями вроде 4-й, результирующий EXE получается сильно меньше/шустрее.