![]() |
|
|||||||
| 論壇說明 |
|
歡迎您來到『史萊姆論壇』 ^___^ 您目前正以訪客的身份瀏覽本論壇,訪客所擁有的權限將受到限制,您可以瀏覽本論壇大部份的版區與文章,但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限,請註冊成為我們的一份子,註冊的程序十分簡單、快速,而且最重要的是--註冊是完全免費的! 請點擊這裡:『註冊成為我們的一份子!』 |
![]() |
|
|
主題工具 | 顯示模式 |
|
|
|
|
#1 (permalink) |
|
管理版主
![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() |
根據 http://www.atlaspost.com/landmark-339129.htm 上的 Bitmap File Header
其水平與垂直解析度記載於 0026h H-Resolution 4 水平解析度(單位:像素/公尺)【註8】 002Ah V-Resolution 4 垂直解析度(單位:像素/公尺) ... 語法:
【註8】若要換算為 dpi,則將此欄數值要除以39.37(吋/公尺) 例如,此欄數值若為 2834 (pixels per meter), 則 2834 ÷ 39.37 = 72 (pixels per inch) = 72 dpi 語法:
'**圖像改解析度**
Dim byteData(&h2B) As Byte
Open .FileName For Binary Access Read As #1
Get #1, , byteData()
Close #1
'將影像解析度改成 150 dpi = 150*39.37 =取整數=> 5906 = 十六進制 17 12
byteData(&H26) = &H12
byteData(&H27) = &H17
byteData(&H2A) = &H12
byteData(&H2B) = &H17
Open .FileName For Binary Access Write As #1
Put #1, , byteData()
Close #1
'**************
因為電腦讀檔案是以堆疊方式讀出 所以寫入時也就是用倒序方式寫入讀檔 所以要倒過來先填入 &H23 再填 &H2E byteData(&H26) = &H23 byteData(&H27) = &H2E 此帖於 2009-08-02 04:54 PM 被 mini 編輯. |
|
|
送花文章: 2059,
|
|
向 mini 送花的會員:
|
|
|
#8 (permalink) |
|
管理版主
![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() |
加了個 ChangeFileDPI 副程式
及改良 Command2_Click() 不過你那個存檔方式還是只能存成 BMP格式 (只是改個副檔名成 .jpg實際上是掩耳盜鈴 ...) 語法:
Private Sub Command2_Click()
Dim i As Integer
For i = Image1.LBound To Image1.UBound
Image1(i).Picture = LoadPicture()
Next
Picture1.Refresh
End Sub
Private Sub Command3_Click()
Dim i As Integer, X As Long, Y As Long
Picture1.AutoRedraw = True
Picture1.Width = Image1(0).Width * 4
Picture1.Height = Image1(0).Height * 2
X = 0: Y = 0
For i = 0 To 7
If Image1(i).Picture <> 0 Then
Picture1.PaintPicture Image1(i).Picture, X, Y, Image1(i).Width, Image1(i).Height
End If
X = X + Image1(0).Width
If i = 3 Then
X = 0
Y = Y + Image1(0).Height
End If
Next
With CommonDialog2
.FileName = ""
.Filter = "JPEG files (*.jpg) |*.jpg|BMP files (*.bmp) |*.bmp"
.ShowSave
If .FileName = "" Then Exit Sub
SavePicture Picture1.Image, .FileName '存檔成 BMP
ChangeFileDPI .FileName '改成適當DPI
End With
End Sub
'改成適當DPI
Private Sub ChangeFileDPI(sFileName As String, Optional iDPI = 300#) '預設 DPI為 300
Dim lFileID As Long
Dim byteData() As Byte
Dim sDPI As String, sMode As String
Dim bHiByte As Byte, bLoByte As Byte
sMode = LCase(Right(sFileName, 3)) '得到最右邊的副檔名並統一轉成小寫
If sMode = "bmp" Then iDPI = iDPI * 39.37 '如果是 BMP檔需換算
sDPI = Right("0000" & Hex(iDPI), 4) '將數字轉成四位形式的十六進位字串
bHiByte = CByte("&H" & Left(sDPI, 2)) '取左邊兩個
bLoByte = CByte("&H" & Right(sDPI, 2)) '取右邊兩個
lFileID = FreeFile '向系統取得一個尚未被使用的檔案代碼
'**改變 JPEG圖檔 解析度**
If sMode = "jpg" Then
ReDim byteData(17) As Byte
'*取出適當的File Header資訊
Open sFileName For Binary Access Read As #lFileID
Get #lFileID, , byteData()
Close #lFileID
'換上所需的 DPI資訊
byteData(14) = bHiByte
byteData(15) = bLoByte
byteData(16) = bHiByte
byteData(17) = bLoByte
'**改變 BMP圖檔 解析度**
ElseIf sMode = "bmp" Then
ReDim byteData(&H2B) As Byte
Open sFileName For Binary Access Read As #lFileID
Get #lFileID, , byteData()
Close #lFileID
byteData(&H26) = bLoByte
byteData(&H27) = bHiByte
byteData(&H2A) = bLoByte
byteData(&H2B) = bHiByte
Else
Exit Sub
End If
'*存回
Open sFileName For Binary Access Write As #lFileID
Put #lFileID, , byteData()
Close #lFileID
End Sub
而不是固定用 300等固定值 此帖於 2009-08-04 08:20 AM 被 mini 編輯. |
|
|
送花文章: 2059,
|
![]() |
|
|
相似的主題
|
||||
| 主題 | 主題作者 | 討論區 | 回覆 | 最後發表 |
| 疑問 - VB6.0載入圖檔自動排列 | chung1206 | 程式語言討論區 | 11 | 2009-07-31 08:50 PM |
| PhotoImpact 8可以做到圖片放大但是解析度不變嗎 | 80704 | 一般電腦疑難討論區 | 4 | 2003-08-09 10:18 AM |
| 請問大大用什麼軟體可以讓圖片放大但是解析度不變?? | 80704 | 一般電腦疑難討論區 | 5 | 2003-07-27 10:23 PM |
| 請問製作網頁上的照片所限制的大小或解析度應為?? | carrie_tsg | 一般電腦疑難討論區 | 4 | 2003-04-28 05:05 PM |
| 解析度調整到1024*768,但是字與圖片都太小 | Taggen | 硬體疑難使用問題討論區 | 4 | 2003-02-05 05:35 PM |