使用上古神器帮姐姐完成寸照自动排版/打印

前言

本来今天还是写关于MySQL系列文章，结果做了一个小程序，就没写。

由于姐姐开的摄影店，时不时就有人来照1/2寸照，拍摄后进行修图美白，然后进行排版，1寸的话排列8张，2寸是4张，然后导出png，进行打印，所以我想的是可以用程序简化后两步骤。

这回没有选择Java写，而是选择上古神器Visual Basic。

操作流程

对于程序操作流程是这样想的：首先要更改注册表，增加对png、jpg图片右键菜单选项，选择寸照打印，这样就会启动我们的程序，然后根据当前尺寸大小，自动排列8张或4张，最后调用默认打印机打印。

里面还要设计一个细节，当白底的时候，为每个照片都加一个白边，其他就不需要了。

绘制图像

VB中绘制图像是个难题，但有了GDI+，一切都变得很简单，首先去网上搜索一个VB GDI+模块进行导入，因为这些函数在VB默认的API浏览器中是搜不到的，自己慢慢写又太麻烦了。

绘制的流程如下：

1. 获取启动参数

首先要拿到图片地址，VB中可以使用command函数获取启动参数，启动参数是右键菜单单机时候传入的，然后判断这个文件是否存在。

Private Sub Verification()
mImagePath = Command
If (Dir(mImagePath) = "") Then
    MsgBox "文件不存在"
    End
End If
End Sub

2.初始化GDI+

下一步是初始化GDI+库，并加载图像， 使用GDI+的时候首先需要通过GdiplusStartup函数初始化才行，但是这个GDI+模块已经做好了初始化的函数，只需要调用即可。

Public Function InitGDIPlusTo(ByRef token As Long, _
                            Optional OnErrShowMsg As Boolean = True, Optional OnErrEndApp As Boolean = True, _
                            Optional ErrMsgText As String = "GDI+ 初始化错误。程序即将关闭。", _
                            Optional ErrMsgStyle As VbMsgBoxStyle = vbCritical, _
                            Optional ErrMsgTitle As String = "初始化错误") As GpStatus
  
  If token <> 0 Then
      Debug.Print "InitGDIPlusTo> GdiPlus已被初始化"
      Exit Function
  End If
  
  Dim uInput As GdiplusStartupInput
  Dim ret As GpStatus
  
  uInput.GdiplusVersion = 1
  ret = GdiplusStartup(token, uInput)
  If ret <> Ok Then
      If OnErrShowMsg Then MsgBox ErrMsgText, ErrMsgStyle, ErrMsgTitle
      If OnErrEndApp Then End
  End If
  
  InitGDIPlusTo = ret
End Function
'直接调用
mToken = GDI.InitGDIPlus

然后使用GdipLoadImageFromFile加载，第一个参数是图片地址，但是需要传入字符串地址，所以要通过StrPtr函数转换，第二个是图片返回句柄，加载成功后，hImageRes变量会大于0，（这个传递方式是引用传递。）

Call GDI.GdipLoadImageFromFile(StrPtr(mImagePath), hImageRes)

3.排列图片

加载图像后，获取图像宽度，如果宽度小于400，则可以认为这是1寸照，因为一寸照在2.5cmx3.5cm，分别率在300的情况下，宽高像素是295x413，需要排列8张。(2寸宽大于400)

GDI+绘制的话需要在Graphics对象上绘制，所以就先要创建Graphics对象。

创建Graphics对象有很多办法，其中之一是从Bitmap/Image对象中获取，所以可以先创建一个空的Bitma，,接着通过GdipGetImageGraphicsContext创建与Bitmap对象关联的Graphics对象，后续绘图就可以在这个对象上绘，相当于一块画板。

至于这个大小为什么是1500x1050，其实就是实际承载寸照的纸张大小。因为纸张大小是12.7x8.9，分辨率300.

Dim mBitmap As Long
Dim mBitmapGraphics As Long
//创建空Bitmap
Call GdipCreateBitmapFromScan0(1500, 1050, 0, PixelFormat32bppARGB, ByVal 0, mBitmap)
//获取这个Bitmap关联的Graphics对象
Call GDI.GdipGetImageGraphicsContext(mBitmap, mBitmapGraphics)
//调用DrawBitmap绘图
DrawBitmap mBitmapGraphics, hImageRes, 34, 22

接下来就是绘制，首先获取点0，0位置的颜色值，判断rgb值都大于200，我们则可以认为他是白底，那么我们就需要绘制边框，否则最终不好裁剪。

然后就是根据是1寸还是2寸图片，分别绘制图像就行。

Private Sub DrawBitmap(ByVal graphics As Long, ByVal image As Long, ByVal lrSpacing, ByVal tbSpacing As Integer)
Dim mTotalWidth  As Integer, mWidth As Long, mHeight As Long
Dim mDrawBorder As Boolean
Dim mPicCount As Integer

Dim offSetX As Integer, offSetY As Integer
Dim mPen As Long, mBackgroundBrush As Long
Call GDI.GdipBitmapGetPixel(image, 0, 0, rgbValue)

r = (rgbValue / 2 ^ 16) And &HFF
g = (rgbValue / 2 ^ 8) And &HFF
b = (rgbValue / 2 ^ 0) And &HFF

If r > 200 And g > 200 And b > 200 Then
    mDrawBorder = True
End If

Call GDI.GdipGetImageWidth(image, mWidth)
Call GDI.GdipGetImageHeight(image, mHeight)

mPicCount = IIf(mWidth < 400, 3, 1)
If mPicCount = 1 Then Call GdipImageRotateFlip(image, Rotate90FlipNone)

Call GDI.GdipGetImageWidth(image, mWidth)
Call GDI.GdipGetImageHeight(image, mHeight)

mTotalWidth = ((mPicCount + 1) * mWidth) + ((mPicCount + 1) * lrSpacing)
mTotalHeight = (2 * mHeight) + tbSpacing0
offSetX = (1500 - mTotalWidth) / 2
offSetY = (1050 - mTotalHeight) / 2

 mPen = GDI.NewPen(&H4A323232, 2)
mBackgroundBrush = GDI.NewBrush(&HFFFFFFFF)
 Call GDI.GdipFillRectangle(graphics, mBackgroundBrush, 0, 0, 1500, 1050)
For i = 0 To mPicCount
    Call GDI.GdipDrawImageRect(graphics, image, offSetX + (i * mWidth) + (i * lrSpacing), offSetY, mWidth, mHeight)
    If (mDrawBorder) Then Call GDI.GdipDrawRectangle(graphics, mPen, offSetX + (i * mWidth) + (i * lrSpacing), offSetY, mWidth, mHeight)
Next
For i = 0 To mPicCount
    Call GDI.GdipDrawImageRect(graphics, image, offSetX + (i * mWidth) + (i * lrSpacing), offSetY + mHeight + tbSpacing, mWidth, mHeight)
      If (mDrawBorder) Then Call GDI.GdipDrawRectangle(graphics, mPen, offSetX + (i * mWidth) + (i * lrSpacing), offSetY + mHeight + tbSpacing, mWidth, mHeight)
Next

End Sub

打印

打印花了好长时间，因为以前没做过，倒现在不懂，为什么向打印机DC贴图的时候，宽高为是326,x477。你猜我是怎么来的，看下图：

没错，是试出来的，此时内存中图像大小是1500x1050是没问题的，但是向打印机不能输出1500x1050。

打印的过程中还要旋转一下图像，否则打印出来的是竖着的。

通过CreateDC创建打印机的DC对象，由于GDI+不能向DC中绘制图像，先要使用GdipCreateFromHDC创建与这个DC关联的Graphics对象，接着就可以绘制了。

最重要的是设置纸张大小，但是在这里面要设置成1270x890，都要扩大10倍，鬼知道原因。

Private Sub PrintBitmap(ByVal Bitmap As Long)

  Dim OutString As String
  Dim lf As logfont
  Dim temp As String
  Dim result As Long
  Dim hOldfont As Long
  Dim hPrintDc As Long
  Dim hFont As Long
  Dim di As DOCINFO

  Dim dm As DEVMODE
  dm = GetPrinterProperty("EPSON L805 Series")
  
  dm.dmPaperLength = 1270
  dm.dmPaperWidth = 890

  Dim mPrintGraphics As Long
  di.cbSize = 20
  di.lpszDocName = "寸照"
  hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, dm)
  result = StartDoc(hPrintDc, di)
  result = StartPage(hPrintDc)
 
  GDI.GdipCreateFromHDC hPrintDc, mPrintGraphics

  Call GdipImageRotateFlip(Bitmap, Rotate90FlipNone)
  Call GDI.GdipDrawImageRectI(mPrintGraphics, Bitmap, 0, 0, 326, 477)
   
  Call EndPage(hPrintDc)
  Call EndDoc(hPrintDc)
  Call DeleteDC(hPrintDc)
End Sub

注册表增加右键菜单

我们还要对png\jpg文件增加右键菜单，考虑到程序读写HKEY_CURRENT_USER\下不需要权限，但是找了好几个子项，都不能修改成功。

但是好赖还是找到了，位置如下。

\HKEY_CURRENT_USER\Software\Classes\SystemFileAssociations\

比如要增加对jpg文件右键菜单，可以依次创建下面项：

SystemFileAssociations\.jpg\shell\寸照打印\command

"寸照打印"是右击.jpg文件时候会在弹出的菜单中显示，如下：

还要在command下的默认项中要增加程序启动路劲。

F:\寸照\寸照.exe %0

前面就是我们程序所在路径，后面是一个参数表示方式，这个参数会转换成点击的文件路径，传递给我们程序。

但是没有使用程序增加，而是写了个脚本。

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Classes\SystemFileAssociations\.jpg\shell\寸照打印\command]
@="F:\\寸照\\寸照.exe %0"