PhotoForm.frm 3.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} PhotoForm
  3. Caption = "对象批量转位图 by filon [玉环]"
  4. ClientHeight = 1800
  5. ClientLeft = 45
  6. ClientTop = 375
  7. ClientWidth = 4710
  8. OleObjectBlob = "PhotoForm.frx":0000
  9. ShowModal = 0 'False
  10. StartUpPosition = 1 'CenterOwner
  11. End
  12. Attribute VB_Name = "PhotoForm"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = False
  15. Attribute VB_PredeclaredId = True
  16. Attribute VB_Exposed = False
  17. #If VBA7 Then
  18. Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  19. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  20. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  21. #Else
  22. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  23. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  24. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  25. #End If
  26. Private Const GWL_STYLE = (-16) '设置窗口样式
  27. Private Const WS_MINIMIZEBOX As Long = &H20000 '最小化
  28. Private Sub CovPhotos_Click()
  29. On Error Resume Next
  30. ActiveDocument.BeginCommandGroup
  31. Dim a, Color As String
  32. Dim b As Boolean
  33. Dim i, dpi As Integer
  34. If ABox1.Value = False Then
  35. a = False
  36. Else
  37. a = True
  38. End If
  39. b = True
  40. If BBox2.Value = False Then b = False
  41. dpi = CInt(ComboBox2.text)
  42. Select Case ComboBox1.text
  43. Case Is = "灰度"
  44. Color = cdrGrayscaleImage
  45. Case Is = "CMYK颜色"
  46. Color = cdrCMYKColorImage
  47. Case Is = "RGB颜色"
  48. Color = cdrRGBColorImage
  49. Case Is = "黑白"
  50. Color = cdrBlackAndWhiteImage
  51. End Select
  52. Dim s As Shapes
  53. Set s = ActiveSelection.Shapes
  54. If s Is Nothing Then
  55. MsgBox "请先选中一个形状!"
  56. Exit Sub
  57. Else
  58. For i = 1 To s.Count
  59. Set s(i) = ActiveShape.ConvertToBitmapEx(Color, False, a, dpi, cdrNormalAntiAliasing, True, False, 95)
  60. Next i
  61. End If
  62. ActiveDocument.EndCommandGroup
  63. End Sub
  64. Private Sub UserForm_Initialize()
  65. Dim hWndForm As Long
  66. Dim IStyle As Long
  67. hWndForm = FindWindow("ThunderDFrame", Me.Caption) '获取窗口句柄
  68. IStyle = GetWindowLong(hWndForm, GWL_STYLE) '获取当前标题栏样式
  69. IStyle = IStyle Or WS_MINIMIZEBOX '设置最小化按钮
  70. SetWindowLong hWndForm, GWL_STYLE, IStyle '显示最小化按钮
  71. On Error Resume Next
  72. ComboBox1.AddItem "灰度"
  73. ComboBox1.AddItem "CMYK颜色"
  74. ComboBox1.AddItem "RGB颜色"
  75. ComboBox1.AddItem "黑白"
  76. ComboBox2.AddItem "300", 0
  77. ComboBox2.AddItem "450", 1
  78. ComboBox2.AddItem "600", 2
  79. End Sub