It is currently Tue Oct 16, 2018 8:57 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: Does anyone know how to Change JPG/BMP DPI resolution
PostPosted: Fri Oct 05, 2018 12:16 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Jun 23, 2010 5:13 pm
Posts: 173
Hi,
listing hundreds of tabs in PureBasic forum, trying tens of ways of choosing the problem did not give the wanted result.

I have tried GDI+ and GraphicMagic with following codes:

Code:
      *image3 = ScaleImage(*image, 300, 300, @ExceptionInf)
      If *image3
        PokeS(@*image3\filename[0], OutFile$ + "_scale.jpg", -1, #PB_Ascii)
        If WriteImage(*imageInfo, *image3)
          Debug "Scale Ok"
        EndIf
        DestroyImage(*image3)
      Else
        Debug PeekS(ExceptionInf\description, -1, #PB_Ascii)
      EndIf

      *image3 = SampleImage(*image, 300, 300, @ExceptionInf)
      If *image3
        PokeS(@*image3\filename[0], OutFile$ + "_sample.jpg", -1, #PB_Ascii)
        If WriteImage(*imageInfo, *image3)
          Debug "Sample Ok"
        EndIf
        DestroyImage(*image3)
      EndIf

Above Sample and Scale do pixel scaling

and:
Code:

Procedure GDIp_GetEncoderClsid(libGDI, format$, *Clsid.CLSID)
Protected number
Protected Size
Protected *pImageCodecInfo.ImageCodecInfo
Protected i, *memory

CallFunction(libGDI,"GdipGetImageEncodersSize",@number, @Size)
If Size = 0
     ProcedureReturn -1
EndIf

*memory = AllocateMemory(Size)
If *memory = #Null
     ProcedureReturn -1
EndIf

*pImageCodecInfo = *memory
CallFunction(libGDI,"GdipGetImageEncoders",number, Size, *pImageCodecInfo)

For i = 1 To number
  If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
          CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
          FreeMemory(*memory)
          ProcedureReturn i
     EndIf
     *pImageCodecInfo + SizeOf(ImageCodecInfo)
Next
FreeMemory(*memory)
ProcedureReturn -1
EndProcedure

Procedure.l GDIp_HBitmap2File(libGDI, *image, sFile$, *encoderCLSID.GUID, Compression = 0)
  Define Result.i = CallFunction(libGDI,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), *encoderCLSID, Compression)
  ProcedureReturn Result
EndProcedure 
Procedure.l GDIp_HBitmap2AutoFile(libGDI, *image, sFile$)
  Define encoderCLSID.GUID
  Define ext$ = LCase(GetExtensionPart(sFile$))
  If ext$ = "bmp" Or ext$ = "jpg" Or ext$ = "jpeg" Or ext$ = "png" Or ext$ = "tif" Or ext$ = "gig"
    Select ext$
      Case "bmp"
        GDIp_GetEncoderClsid(libGDI, #Bmp_Encoder, @encoderCLSID)
      Case "jpg", "jpeg"
        GDIp_GetEncoderClsid(libGDI, #Jpeg_Encoder, @encoderCLSID)
      Case "png"
        GDIp_GetEncoderClsid(libGDI, #Png_Encoder, @encoderCLSID)
      Case "tif"
        GDIp_GetEncoderClsid(libGDI, #Tif_Encoder, @encoderCLSID)
      Case "gif"
        GDIp_GetEncoderClsid(libGDI, #Gif_Encoder, @encoderCLSID)
    EndSelect
    GDIp_HBitmap2File(libGDI, *Image, sFile$, @encoderCLSID)
  EndIf
EndProcedure 

Procedure.f GDIp_GetHBitmapHOResolution(libGDI, *image)
  Define hRes.f
  CallFunction(libGDI,"GdipGetImageHorizontalResolution",*image, @hRes)
  ProcedureReturn hRes
EndProcedure 
 
Procedure.f GDIp_GetHBitmapVEResolution(libGDI, *image)
  Define vRes.f
  Define Result.i = CallFunction(libGDI,"GdipGetImageVerticalResolution",*image, @vRes)
  ProcedureReturn vRes 
EndProcedure

Procedure GDIp_SetHBitmapResolution(libGDI, *image, xdpi.f, ydpi.f)
  Define Result.i = CallFunction(libGDI,"GdipBitmapSetResolution",*image, xdpi, ydpi)
  ProcedureReturn Result
EndProcedure 


Define hRes.f = GDIp_GetHBitmapHOResolution(libGDI, *image):Debug "hResolution : "+ StrF(hRes,0) +" DPI"
Define vRes.f = GDIp_GetHBitmapVEResolution(libGDI, *image):Debug "vResolution   : "+ StrF(vRes,0) +" DPI"

GDIp_SetHBitmapResolution(libGDI, *image, 300, 300)

Define hRes.f = GDIp_GetHBitmapHOResolution(libGDI, *image):Debug "PostHorizontal resolution : "+ StrF(hRes,0) +" DPI"
Define vRes.f = GDIp_GetHBitmapVEResolution(libGDI, *image):Debug "PostVertical resolution   : "+ StrF(vRes,0) +" DPI"

Define sFile$ = GetPathPart(file$)+GetFilePart(file$, #PB_FileSystem_NoExtension)+"_300."+"bmp"
GDIp_HBitmap2AutoFile(libGDI, *image, sFile$)


There is a PNG way with using PHY_Chunk
Code:
Procedure SetChunk_pHYs(*mem, dpi)
  !mov eax, [p.v_dpi]
  ; convert dpi to pixels / meter
  !mov ecx, 0x9d7af5ec
  !mul ecx
  !add eax, 0x02000000
  !adc edx, 0
  !shrd eax, edx, 26
  ; calculate crc
  !bswap eax
  !mov ecx, 0x69789a9c
  !mov edx, 64
  !.l0:
  !test edx, 31
  !jnz .l1
  !xor ecx, eax
  !.l1: shr ecx, 1
  !jnc .l2
  !xor ecx, 0xedb88320
  !.l2: sub edx, 1
  !jnz .l0
  !xor ecx, 1
  !mov edx, 8
  !.l3: shr ecx, 1
  !jnc .l4
  !xor ecx, 0xedb88320
  !.l4: sub edx, 1
  !jnz .l3
  !not ecx
  !bswap ecx
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rdx, [p.p_mem]
    !mov dword [rdx],   0x09000000  ; length
    !mov dword [rdx+4], 0x73594870  ; type
    !mov dword [rdx+8], eax         ; data (9 bytes)
    !mov dword [rdx+12],eax
    !mov byte  [rdx+16],1
    !mov dword [rdx+17],ecx         ; crc
  CompilerElse
    !mov edx, [p.p_mem]
    !mov dword [edx],   0x09000000  ; length
    !mov dword [edx+4], 0x73594870  ; type
    !mov dword [edx+8], eax         ; data (9 bytes)
    !mov dword [edx+12],eax
    !mov byte  [edx+16],1 
    !mov dword [edx+17],ecx         ; crc
  CompilerEndIf
EndProcedure
Procedure PNG_SetDPI(PNGFile.s, dpi)
If FileSize(PNGFile) > 0
  UsePNGImageEncoder()
  UsePNGImageDecoder()
  imgPNG = LoadImage(#PB_Any, PNGFile)
  If IsImage(imgPNG)
    *PNGData = EncodeImage(imgPNG, #PB_ImagePlugin_PNG)
    *pHYsChunk = AllocateMemory(21)
    SetChunk_pHYs(*pHYsChunk, dpi); 300 dpi
    FreeImage(imgPNG)
   
    pngHandle = CreateFile(#PB_Any, PNGFile)
    WriteData(pngHandle, *PNGData, 33)
    WriteData(pngHandle, *pHYsChunk, 21)
    WriteData(pngHandle, *PNGData + 33, MemorySize(*PNGData)-33)
    CloseFile(pngHandle)
 
    FreeMemory(*pHYsChunk)
    FreeMemory(*PNGData)
    Debug "Done"
  Else
    Debug "Failed2LoadPNG"
  EndIf
Else
  Debug "Failed2OpenFile"
EndIf
EndProcedure


Could not make it work with JPG


Top
 Profile  
Reply with quote  
 Post subject: Re: Does anyone know how to Change JPG/BMP DPI resolution
PostPosted: Thu Oct 11, 2018 11:42 am 
Offline
User
User

Joined: Sun Nov 23, 2014 1:18 pm
Posts: 23
I read the resolution from a JPG with the following code:
Code:
Procedure.s get_JPG_dpi(datei.s)
  ; DPI-Resolution from JPG-file
  ; -> xDPI|yDPI
 
  Protected file_handle
  Protected dummy.a, word.u
  Protected tag.a
  Protected seg_len.u
  Protected jfif.s
  Protected rev.w
  Protected units.a
  Protected xdensity.u
  Protected ydensity.u
  Protected comment.s
 
  file_handle = ReadFile(#PB_Any, datei)
  If file_handle = 0
    MessageRequester("Error", "File could not be opened!" + #LF$ + "(" + datei + ")")
    ProcedureReturn ""
  EndIf
 
  ; Start Of Image (SOI) always at start
  word = ReadWord(file_handle)
 
  If word  <> $D8FF   
    MessageRequester("Error", "File is no JPG!")
    CloseFile(file_handle)
    ProcedureReturn ""
  EndIf
 
  ; search for JFIF-tag...
  Repeat
    ; Tag-Marker ($FF) at start...
    dummy = ReadByte(file_handle)
    If dummy <> $FF
      MessageRequester("Error", "Mistake in JPG-structure")
      CloseFile(file_handle)
      ProcedureReturn ""
    EndIf
   
    ; read tag
    tag = ReadByte(file_handle)
   
    ; APP0-tag ($E0) found?
    If tag = $E0
      ; length of segment [2]
      dummy = ReadByte(file_handle)
      seg_len = dummy * 256
      dummy = ReadByte(file_handle)   
      seg_len = seg_len + dummy
     
      ; "JFIF" [5]
      jfif = ReadString(file_handle, #PB_Ascii, 5)
     
      ; JFIF-Version [2]
      dummy = ReadByte(file_handle)
      rev = dummy * 256
      dummy = ReadByte(file_handle)   
      rev = rev + dummy
     
      ; units are measured in (0=none, 1=dots per inch, 2=dots per cm) [1]
      units = ReadByte(file_handle)
      If units <> 1
        MessageRequester("Error", "unit is not dpi!" + #LF$ + "(" + datei + ")")
        CloseFile(file_handle)
        ProcedureReturn ""
      EndIf
     
      ; X-resolution [2]
      dummy = ReadByte(file_handle)
      xdensity = dummy * 256
      dummy = ReadByte(file_handle)   
      xdensity = xdensity + dummy
     
      ;Y-resolution [2]
      dummy = ReadByte(file_handle)
      ydensity = dummy * 256
      dummy = ReadByte(file_handle)   
      ydensity = ydensity + dummy
     
      ; skip rest
      FileSeek(file_handle, seg_len - 14, #PB_Relative)
     
    ; Data-tag ($DA) ... end is reached
    ElseIf tag = $DA
      Break
     
    ; skip all other tags
    Else
      ; segment length [2]     
      dummy = ReadByte(file_handle)
      seg_len = dummy * 256
      dummy = ReadByte(file_handle)   
      seg_len = seg_len + dummy
     
      FileSeek(file_handle, seg_len - 2, #PB_Relative)
    EndIf
  Until Eof(file_handle)
   
  CloseFile(file_handle)
 
  ProcedureReturn Str(xdensity) + "|" + Str(ydensity)
EndProcedure

You could eaysily change it to alter the dpi resolution in the JPG but you have to consider that a change in dpi does not effect the pixel inside the image. If you double the dpi in both directions without changing the image, it will result in a 4-times smaller image (same pixels but 2x2 more density).


Top
 Profile  
Reply with quote  
 Post subject: Re: Does anyone know how to Change JPG/BMP DPI resolution
PostPosted: Thu Oct 11, 2018 6:05 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Jun 23, 2010 5:13 pm
Posts: 173
Thank You very much for reply.
I already done that (With Rashad's hint of SoftDPI - didn't know about that but now OK:)

Now created new topic with saving raw 8bit bytes to 8bit jpeg (bmp done but Jpeg problem)


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye