Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Помогите с кодом Добавлено: 19.02.08 12:51  

Автор вопроса:  Bonapart | Web-сайт: team16.tut.su | ICQ: 175256 
вот код
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
Автор ответа:
 astoro



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
Автор ответа:
 Bonapart



ICQ: 175256 

Вопросов: 32
Ответов: 108
 Web-сайт: team16.tut.su
 Профиль | | #2
Добавлено: 21.02.08 08:31
гг.
Ты на код посмотри. Тут не преобразование картинки в текст а некоторый способ сохранения текста в другом виде.
Скопируй текст в форму добавь текстбокс и кнопочку(VB6).
запусти скопируй файл текстовый(содержимое) в текстбокс и нажми на кнопку.
И если у тебя есть папку boot на диске C: тотебя не выкинет с ошибкой и создаст в этой папке файл размером кол.символов/3 на 1 пиксель.Там даже чисто теоритически ты букв не увидишь.

Ответить

Номер ответа: 3
Автор ответа:
 



Администратор

ICQ: 278109632 

Вопросов: 42
Ответов: 3949
 Web-сайт: domkratt.com
 Профиль | | #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
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #4
Добавлено: 21.02.08 12:11
Мне кажется, или оформление ника Executioner такое же, как у меня? :)

Ответить

Номер ответа: 5
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #5
Добавлено: 21.02.08 12:12
гг, рядом, но не такое же :)

Ответить

Номер ответа: 6
Автор ответа:
 



Администратор

ICQ: 278109632 

Вопросов: 42
Ответов: 3949
 Web-сайт: domkratt.com
 Профиль | | #6
Добавлено: 21.02.08 13:58
Да, я не стал юзать стили, а сделал тегами. И шрифт Tahoma. =)

Ответить

Номер ответа: 7
Автор ответа:
 Bonapart



ICQ: 175256 

Вопросов: 32
Ответов: 108
 Web-сайт: team16.tut.su
 Профиль | | #7
Добавлено: 22.02.08 08:16
Также не также, какая разница? Как код заставить работать обратно?

Ответить

Номер ответа: 8
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #8
Добавлено: 22.02.08 22:01
хоть объясни что это/ зачем это

Ответить

Номер ответа: 9
Автор ответа:
 Bonapart



ICQ: 175256 

Вопросов: 32
Ответов: 108
 Web-сайт: team16.tut.su
 Профиль | | #9
Добавлено: 24.02.08 16:09
С помощью этого можно преобразовать текст в файл с расширением bmp, и оч сильно его потом сжать используя paint иформат tiff. степень сжатия получатся очень выше чем в раре и зипе раз в 15,26

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам