Option Explicit On
Option Strict On

Imports System.Runtime.InteropServices
Imports System.Text
Imports System.IO
Imports System.Drawing.Imaging

Public Class Form1

    <DllImport("gsdll32.dll", EntryPoint:="gsapi_new_instance", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_new_instance32(ByRef pInstance As IntPtr, ByVal handle As IntPtr) As Integer
    End Function

    <DllImport("gsdll32.dll", EntryPoint:="gsapi_init_with_args", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_init_with_args32(ByVal instance As IntPtr, ByVal argc As Integer, ByVal argv As IntPtr) As Integer
    End Function

    <DllImport("gsdll32.dll", EntryPoint:="gsapi_exit", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_exit32(ByVal instance As IntPtr) As Integer
    End Function

    <DllImport("gsdll32.dll", EntryPoint:="gsapi_delete_instance", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Sub gsapi_delete_instance32(ByVal instance As IntPtr)
    End Sub

    <DllImport("gsdll32.dll", EntryPoint:="gsapi_revision", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Public Shared Function gsapi_revision32(ByRef pVer As GSVersion, ByVal pSize As Integer) As Integer
    End Function

    <DllImport("gsdll64.dll", EntryPoint:="gsapi_new_instance", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_new_instance64(ByRef pInstance As IntPtr, ByVal handle As IntPtr) As Integer
    End Function

    <DllImport("gsdll64.dll", EntryPoint:="gsapi_init_with_args", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_init_with_args64(ByVal instance As IntPtr, ByVal argc As Integer, ByVal argv As IntPtr) As Integer
    End Function

    <DllImport("gsdll64.dll", EntryPoint:="gsapi_exit", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Function gsapi_exit64(ByVal instance As IntPtr) As Integer
    End Function

    <DllImport("gsdll64.dll", EntryPoint:="gsapi_delete_instance", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Private Shared Sub gsapi_delete_instance64(ByVal instance As IntPtr)
    End Sub

    <DllImport("gsdll64.dll", EntryPoint:="gsapi_revision", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.StdCall)>
    Public Shared Function gsapi_revision64(ByRef pVer As GSVersion, ByVal pSize As Integer) As Integer
    End Function

    <StructLayout(LayoutKind.Sequential)>
    Public Structure GSVersion
        Public product As IntPtr
        Public copyright As IntPtr
        Public revision As Integer
        Public revisionDate As Integer
    End Structure

    Private resourceLock As New Object

    Public Sub CallGhostScript(ByVal args As String())
        Dim argc As Integer = args.Length
        Dim argsAnsi(argc - 1) As Object
        Dim argsHandle(argc - 1) As GCHandle
        Dim argsPtr(argc - 1) As IntPtr
        Dim argHandle As GCHandle
        Dim argv As IntPtr
        For i As Integer = 0 To argc - 1
            'argsAnsi(i) = Encoding.GetEncoding("Shift_JIS").GetBytes(args(i))'「gsdll32.dll 9.05」はこっちを使う
            argsAnsi(i) = Encoding.UTF8.GetBytes(args(i))
            argsHandle(i) = GCHandle.Alloc(argsAnsi(i), GCHandleType.Pinned)
            argsPtr(i) = argsHandle(i).AddrOfPinnedObject
        Next
        argHandle = GCHandle.Alloc(argsPtr, GCHandleType.Pinned)
        argv = argHandle.AddrOfPinnedObject
        '32bitと64bitに応じたAPIを使う
        If IntPtr.Size = 4 Then
            CallGhostScript32(argc, argv)
        Else
            CallGhostScript64(argc, argv)
        End If
        For i As Integer = 0 To argc - 1
            argsHandle(i).Free()
        Next
        argHandle.Free()
    End Sub

    '32bit用API
    Private Sub CallGhostScript32(ByVal argc As Integer, ByVal argPtr As IntPtr)
        Dim pInstance As IntPtr
        SyncLock resourceLock
            gsapi_new_instance32(pInstance, IntPtr.Zero)
            Try
                Dim result As Integer = gsapi_init_with_args32(pInstance, argc, argPtr)
                If result < 0 Then
                    Throw New ExternalException("GhostScript(gsdll32.dll)内でエラーが発生しました。", result)
                End If
            Finally
                gsapi_exit32(pInstance)
                gsapi_delete_instance32(pInstance)
            End Try
        End SyncLock
    End Sub

    '64bit用API
    Private Sub CallGhostScript64(ByVal argc As Integer, ByVal argPtr As IntPtr)
        Dim pInstance As IntPtr
        SyncLock resourceLock
            gsapi_new_instance64(pInstance, IntPtr.Zero)
            Try
                Dim result As Integer = gsapi_init_with_args64(pInstance, argc, argPtr)
                If result < 0 Then
                    Throw New ExternalException("GhostScript(gsdll64.dll)内でエラーが発生しました。", result)
                End If
            Finally
                gsapi_exit64(pInstance)
                gsapi_delete_instance64(pInstance)
            End Try
        End SyncLock
    End Sub

    Public GsDefaultArgs As String() = {
        "PDFtoImage", '最初の引数は無効
        "-dSAFER",
        "-dBATCH",
        "-dNOPAUSE",
        "-dNumRenderingThreads=4"
        }

    Const JPEG_QUALITY As Integer = 85
    Private ImageSize As Size
    Private InputFileNames As String()

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Me.Text = "PDFtoJpeg"
        Me.AllowDrop = True
        Me.ImageSize = New Size(362, 512)
    End Sub

    Private Sub ConvPDFtoJpeg(inputFileNames As String())
        If inputFileNames IsNot Nothing Then
            For Each inputFileName As String In inputFileNames
                If Path.GetExtension(inputFileName).ToLower = ".pdf" Then
                    Dim OutputFileName As String = Path.Combine(Path.GetDirectoryName(inputFileName), Path.GetFileNameWithoutExtension(inputFileName) & ".jpg")
                    ConvPDFtoJpeg(inputFileName, OutputFileName)
                End If
            Next
        End If
    End Sub

    Private Sub ConvPDFtoJpeg(InputFileName As String, OutputFileName As String)
        Dim TempFileName As String = ConvPDFtoTiff(InputFileName)
        Dim OutputImage As Bitmap
        Using TiffImage As New Bitmap(TempFileName)
            OutputImage = ResizeImage(TiffImage, Me.ImageSize)
        End Using
        File.Delete(TempFileName)
        SaveJpeg(OutputImage, OutputFileName, JPEG_QUALITY)
        Me.ClientSize = New Size(OutputImage.Size.Width, OutputImage.Size.Height)
        Me.BackgroundImage = OutputImage
    End Sub

    Private Function ConvPDFtoTiff(InputFileName As String) As String
        Dim OutputFileName As String = Path.Combine(Path.GetDirectoryName(InputFileName), Path.GetFileNameWithoutExtension(Path.GetRandomFileName()) & ".tiff")
        Dim Args As New List(Of String)(GsDefaultArgs)
        Args.AddRange(New String() {
            "-sDEVICE=tiff24nc",
            "-dTextAlphaBits=4",
            "-dGraphicsAlphaBits=4",
            "-sPAPERSIZE=a4",
            "-r300x300",
            "-dFirstPage=1",
            "-dLastPage=1",
            "-sOutputFile=" & OutputFileName,
            InputFileName
            })
        CallGhostScript(Args.ToArray)
        Return OutputFileName
    End Function

    Private Function ResizeImage(InputImage As Bitmap, OutputImageSize As Size) As Bitmap
        If InputImage.Width > InputImage.Height Then
            OutputImageSize = New Size(OutputImageSize.Height, OutputImageSize.Width)
        End If
        Dim OutputImage As New Bitmap(OutputImageSize.Width, OutputImageSize.Height)
        Using g As Graphics = Graphics.FromImage(OutputImage)
            g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
            g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
            g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
            g.DrawImage(InputImage, 0, 0, OutputImageSize.Width, OutputImageSize.Height)
        End Using
        Return OutputImage
    End Function

    Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        If Me.BackgroundImage Is Nothing Then
            With e.Graphics
                Dim Message As String = "ここにPDFファイルをドロップしてください"
                Dim TextSize As SizeF = .MeasureString(Message, Me.Font)
                Dim Left As Single = (Me.ClientSize.Width - TextSize.Width) / 2
                Dim Top As Single = (Me.ClientSize.Height - TextSize.Height) / 2
                .DrawString(Message, Me.Font, Brushes.Black, Left, Top)
            End With
        End If
    End Sub

    Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
        If Me.BackgroundImage Is Nothing Then
            Me.Invalidate()
        End If
    End Sub

    Private Sub Form1_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop
        Me.InputFileNames = DirectCast(e.Data.GetData(DataFormats.FileDrop, False), String())
        ConvPDFtoJpeg(Me.InputFileNames)
    End Sub

    Private Sub Form1_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.Copy
        End If
    End Sub

    '品質を指定してJPEG画像を保存する
    ''参考  http://www.atmarkit.co.jp/fdotnet/dotnettips/533jpgquality/jpgquality.html
    Public Sub SaveJpeg(Image As Bitmap, outputPath As String, quality As Integer)
        Dim Encoder As ImageCodecInfo = GetImageEncoder(ImageFormat.Jpeg)
        Using Params As New EncoderParameters With {.Param = {New EncoderParameter(Imaging.Encoder.Quality, quality)}}
            Image.Save(outputPath, Encoder, Params)
        End Using
    End Sub

    Private Function GetImageEncoder(ByVal Format As ImageFormat) As ImageCodecInfo
        For Each Encoder As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
            If Encoder.FormatID = Format.Guid Then
                Return Encoder
            End If
        Next
        Return Nothing
    End Function

End Class