Страница: 1 |
Вопрос: Помогите с кодом | Добавлено: 19.02.08 12:51 |
Автор вопроса: ![]() |
вот код
Private Type BITMAPINFOHEADER '40 bytes biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPFILEHEADER '14 bytes bfType As String * 2 '"magic cookie" - must be "BM" bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors() As Long 'array of RGBQUADs End Type Public Function BMPFillInfoStruct(ByVal filename As String) As Boolean Dim hfile As Long, bfh As BITMAPFILEHEADER Dim BMi As BITMAPINFO Dim WritePos As Long Dim FileDat() As Byte Dim rgbf() As Byte hfile = FreeFile() 'On Error Resume Next ReDim FileDat(FileLen(filename) - 54) Open filename For Binary Access Read As #hfile Get #hfile, , bfh Get #hfile, 15, BMi.bmiHeader 'start at the 15th byte Get #hfile, 55, FileDat Close #hfile 'Close file ' Select Case BMi.bmiHeader.biBitCount Case 24: hj = 2 Case 32: hj = 3 Case Else: MsgBox ("Только 24 и 32 битные изображения"): End End Select ReDim rgbf(BMi.bmiHeader.biWidth - 1, BMi.bmiHeader.biHeight - 1, hj) For h = BMi.bmiHeader.biHeight - 1 To 0 Step -1 For w = 0 To BMi.bmiHeader.biWidth - 1 'bgr rgbf(w, h, hj) = FileDat(l) l = l + 1 rgbf(w, h, hj - 1) = FileDat(l) l = l + 1 rgbf(w, h, hj - 2) = FileDat(l) l = l + 1 If hj = 3 Then rgbf(w, h, hj) = FileDat(l): l = l + 1 Form1.PSet (w, h), RGB(rgbf(w, h, 0), rgbf(w, h, 1), rgbf(w, h, 2)) Next w Next h ' BMPFillInfoStruct = True 'indicate success End Function Private Sub Command1_Click() Dim bits() As Byte Dim hfile As Long, bfh As BITMAPFILEHEADER Dim BMi As BITMAPINFO l = Len(Text1.Text) gh = 4 - (l Mod 4) If gh = 4 Then gh = 0 Text1.Text = Text1.Text + Space(gh) ReDim bits(Len(Text1.Text) * 4) For lk = 0 To Int(Len(Text1.Text) / 4) - 1 For jk = 1 To 4 bits(lk * 4 + jk) = Asc(Mid(Text1.Text, lk * 4 + jk, 1)) Next jk Next lk Open "c:\boot\test.bmp" For Binary As 2 Get 2, , bfh Get 2, 15, BMi.bmiHeader 'start at the 15th byte Close 2 BMi.bmiHeader.biWidth = lk + 1 Open "c:\Boot\1.bmp" For Binary As 1 Put 1, , bfh Put 1, 15, BMi.bmiHeader 'start at the 15th byte Put 1, 55, bits Close 1 End Sub Этот код из текста в text1 создаёт bmp файл и сохраняет его.с помощью paint его можно переделать в tiff с огромным увеличением свободного места 2.1 мб -> 22,9 кб даже Rar,Zip до 100 еле догоняют (117,240) Есть одна проблема только работает медлено и не открывает. Существующюю картинку он отрисует только(она перевернутая и цветовые байты задом наперёд), помогите с преобразованием из BMP в TXT. |
Ответы | Всего ответов: 9 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ICQ: 649109 Вопросов: 31 Ответов: 391 |
Профиль | Цитата | #1 | Добавлено: 19.02.08 13:22 |
по поводу преобразования их БМП в ТХТ
можно начать отсюда задача непростая http://en.wikipedia.org/wiki/Optical_character_recognition еще неплохая статья http://www.xakep.ru/post/31268/default.asp |
Номер ответа: 2 Автор ответа: ![]() ![]() ICQ: 175256 Вопросов: 32 Ответов: 108 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 21.02.08 08:31 |
гг.
Ты на код посмотри. Тут не преобразование картинки в текст а некоторый способ сохранения текста в другом виде. Скопируй текст в форму добавь текстбокс и кнопочку(VB6). запусти скопируй файл текстовый(содержимое) в текстбокс и нажми на кнопку. И если у тебя есть папку boot на диске C: тотебя не выкинет с ошибкой и создаст в этой папке файл размером кол.символов/3 на 1 пиксель.Там даже чисто теоритически ты букв не увидишь. |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 21.02.08 09:40 |
l = Len(Text1.Text)
gh = 4 - (l Mod 4) If gh = 4 Then gh = 0 Text1.Text = Text1.Text + Space(gh) ReDim bits(Len(Text1.Text) * 4) For lk = 0 To Int(Len(Text1.Text) / 4) - 1 For jk = 1 To 4 bits(lk * 4 + jk) = Asc(Mid(Text1.Text, lk * 4 + jk, 1)) Next jk Next lk только наоборот ![]() |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | Цитата | #4 | Добавлено: 21.02.08 12:11 |
Мне кажется, или оформление ника Executioner такое же, как у меня? ![]() |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 21.02.08 12:12 |
гг, рядом, но не такое же ![]() |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #6 | Добавлено: 21.02.08 13:58 |
Да, я не стал юзать стили, а сделал тегами. И шрифт Tahoma. ![]() |
Номер ответа: 7 Автор ответа: ![]() ![]() ICQ: 175256 Вопросов: 32 Ответов: 108 |
Web-сайт: Профиль | Цитата | #7 | Добавлено: 22.02.08 08:16 |
Также не также, какая разница? Как код заставить работать обратно? |
Номер ответа: 8 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #8 | Добавлено: 22.02.08 22:01 |
хоть объясни что это/ зачем это |
Номер ответа: 9 Автор ответа: ![]() ![]() ICQ: 175256 Вопросов: 32 Ответов: 108 |
Web-сайт: Профиль | Цитата | #9 | Добавлено: 24.02.08 16:09 |
С помощью этого можно преобразовать текст в файл с расширением bmp, и оч сильно его потом сжать используя paint иформат tiff. степень сжатия получатся очень выше чем в раре и зипе раз в 15,26 |
Страница: 1 |
|