Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
перевести функцию из 32х на 64х
 
#1
08.01.2015 23:15:57
Доброй ночи!
никак не могу перевести функцию с 32х на 64х
менял Dim uGdiInput As GdiplusStartupInput, hGdiPlus As Long
на  Dim uGdiInput As GdiplusStartupInput, hGdiPlus As LongPtr

на 32х офисе аналогичная функция выполняется и обрабатывает картинку
на 64х офисе всё равно выдаётся ошибка, хотя вся функция выполняется
(ошибка не в MsgBox, а в Debug.print, то есть ошибка не выскакивает, но всё равно функция не срабатывает)

Благодарю за помощь!
Изменено: Петр80 - 09.01.2015 01:26:54
 
 
 
#2
08.01.2015 23:41:17
А Вы уверены, что ошибка в dim?
Обычно такое происходит из-за разных деклараций для разных архитектур. Нужно сделать кондиционную декларацию, чтобы при x32 загружалась та, что у Вас прописана, а при x64, та которая должна быть на x64. Но это нужно уже искать - здесь я не помогу.
С уважением,
Федор/Все_просто
 
 
 
#3
08.01.2015 23:47:55
Цитата
Все_просто пишет: ошибка в dim?
не уверен
 
 
 
#4
09.01.2015 10:12:41
т.е. получается эта функция не будет работать на х64 офисе? значит его лучше удалить и ставить х32 ?
 
 
 
#5
09.01.2015 10:15:56
Я вот сейчас систему дома полностью обновляю - думаю из-за макросов есть смысл всё полностью ставить х32. Или win всёж можно ставить х64?
Изменено: Hugo - 09.01.2015 10:17:11
 
 
 
#6
09.01.2015 10:19:44
Цитата
Hugo пишет: Или win всёж можно ставить 64х?
Безобразно, но Однообразно - это (по-армейски), если внутри одной конторы... ;)
Практичнее, говорят, если с выходом во вне, то система 64, а офис - 32. Как вариант.
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#7
09.01.2015 10:19:53
Пётр, у меня на сайте была старая версия кода
http://excelvba.ru/code/ResizeImages


Исправил - теперь не будет проблем с совместимостью:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function GetPictureSizeNew(ByVal FileName$, ByRef imgWidth As Single, ByRef imgHeight As Single) As Boolean
    On Error Resume Next:
    #If VBA7 Then
        Dim hGdiImage As LongPtr, uGdiInput As GdiplusStartupInput, hGdiPlus As LongPtr
    #Else
        Dim hGdiImage As Long, uGdiInput As GdiplusStartupInput, hGdiPlus As Long
    #End If
    uGdiInput.GdiplusVersion = 1
 
    If GdiplusStartup(hGdiPlus, uGdiInput) = Status_OK Then
        If GdipCreateBitmapFromFile(StrPtr(FileName), hGdiImage) = Status_OK Then        'Создаём изображение в памяти
            Call GdipGetImageDimension(hGdiImage, imgWidth, imgHeight)        'Получаем размеры изображения
            GdipDisposeImage hGdiImage        ' освобождаем память
        End If
        GdiplusShutdown hGdiPlus
    End If
    GetPictureSizeNew = imgWidth * imgHeight > 0
End Function
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#8
09.01.2015 10:33:30
Игорь, спасибо, но GetPictureSizeNew работает на х64
не срабатывает LoadImage, который и есть в примере
хотя тот же код на х32 нормально сохраняет картинку
а на Win7 x64 + офисе х64 2010 просто создается пустой файл и выдается debug.print

т.е. для GetPictureSizeNew достаточно строчки
Dim hGdiImage As LongPtr, uGdiInput As GdiplusStartupInput, hGdiPlus As LongPtr
а для LoadImage недостаточно строчки
Dim uGdiInput As GdiplusStartupInput, hGdiPlus As LongPtr
тест проводился на компьютере и ноутбуке с офисом х64. и в обоих случаях он не сработал
но сработал на х32 офисе на другом ноутбуке
таким образом вдруг у кого то он сработает на 64 офисе? если срабатывает - напишите пожалуйста
если не срабатывает и также выдает debug.print значит дело в самом коде
Изменено: Петр80 - 09.01.2015 14:45:40
 
 
 
#9
09.01.2015 10:39:51
Меня волнует есть ли в х64 все те нужные библиотеки, что есть в х32. scrrun.dll например. И в нужных нам версиях.
 
 
 
#10
09.01.2015 10:43:28
на win х64 C:\Windows\System32\scrrun.dll присутствует. размер 198 КБ, версия продукта 5.8.7600.16385
если это то, что интересует. вопрос не в Win x32 x64, а вопрос в офисе х32 х64
в C:\Program Files\Microsoft Office такая библиотека отсутствует
или наверное тут у большинства х32 офис и проверить работу функции особо некому?
Изменено: Петр80 - 09.01.2015 10:51:17
 
 
 
#11
09.01.2015 10:51:42
вот заведомо рабочий код из моей программы (PastePictures), которая у многих пользователей работает под 64-битной системой, и никто не жалуется
(на сайте выложена чуть более ранняя версия кода, которая на 64-битной системе не проверялась)

функция только иначе называется - код тот же, вроде
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Function ResizeImage(ByVal FileName As String, ByVal newFilename As String, ByVal NewWidth&, ByVal NewHeight&) As Boolean
    On Error Resume Next
    Dim tJpgEncoder As GUID, tParams As EncoderParameters, uGdiInput As GdiplusStartupInput
    #If VBA7 Then
        Dim hGdiImage As LongPtr, hBitmap As LongPtr, quality As LongPtr, hGdiPlus As LongPtr, lRes As LongPtr
        Dim lGDIP As LongPtr, hDC As LongPtr, hBrush As LongPtr, Graphics As LongPtr, hResizedBitmap As LongPtr
    #Else
        Dim hGdiImage As Long, hBitmap As Long, quality As Long, hGdiPlus As Long, lRes As Long
        Dim lGDIP As Long, hDC As Long, hBrush As Long, Graphics As Long, hResizedBitmap As Long
    #End If
 
    uGdiInput.GdiplusVersion = 1: quality = 80
 
    If GdiplusStartup(hGdiPlus, uGdiInput) = Status_OK Then        'Запускаем GDI+
 
        If GdipCreateBitmapFromFile(StrPtr(FileName), hGdiImage) = Status_OK Then        'Создаём изображение в памяти
            'Делаем из изображения уменьшенное
            hDC = CreateCompatibleDC(ByVal 0&)        ' Create a memory DC and select a bitmap into it, fill it in with the backcolor
 
            hBitmap = CreateBitmap(NewWidth&, NewHeight&, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)
            If hBitmap = 0 Then
                Debug.Print "LastDllError=" & Err.LastDllError
                Debug.Print FileName
                Stop
            End If
            hBitmap = SelectObject(hDC, hBitmap)
            PatBlt hDC, 0, 0, NewWidth&, NewHeight&, PATCOPY        ' не знаю, зачем это, - но без этой строки вдруг появилась проблема
 
            ' Resize the picture
            GdipCreateFromHDC hDC, Graphics
            GdipSetInterpolationMode Graphics, InterpolationModeHighQualityBicubic
 
            lRes = GdipDrawImageRectI(Graphics, hGdiImage, 0, 0, NewWidth&, NewHeight&)
            GdipDeleteGraphics Graphics
            GdipDisposeImage hGdiImage
 
            ' Get the bitmap back
            hBitmap = SelectObject(hDC, hBitmap)
            DeleteDC hDC
 
            If GdipCreateBitmapFromHBITMAP(hBitmap, 0, hResizedBitmap) = 0 Then
 
                CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder        ' Initialize the encoder GUID
                tParams.Count = 1        ' Initialize the encoder parameters
                With tParams.Parameter        ' Quality
                    CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID        ' Set the Quality GUID
                    .NumberOfValues = 1: .Type = 4: .Value = VarPtr(quality)
                End With
 
                lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, tParams)        ' Save the image
                If lRes = 0 Then ResizeImage = True Else Debug.Print "Ошибка сохранения уменьшенного файла: " & lRes
                GdipDisposeImage hResizedBitmap        ' Destroy the bitmap
            Else
                Debug.Print "Ошибка преобразования размеров файла"
            End If
        End If
        GdiplusShutdown hGdiPlus
    Else
        Debug.Print "Ошибка при загрузке GDI+!"
    End If
End Function

а это - объявления функций WinAPI

Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
#If VBA7 Then
    Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As LongPtr
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
    Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As LongPtr, ByVal n1 As LongPtr, ByVal n2 As LongPtr, ByVal un2 As LongPtr) As LongPtr
 
    Declare PtrSafe Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As LongPtr, ByVal hPal As LongPtr, Bitmap As LongPtr) As LongPtr
    Declare PtrSafe Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As LongPtr, ByVal FileName As LongPtr, clsidEncoder As GUID, encoderParams As Any) As LongPtr
    Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal str As LongPtr, id As GUID) As LongPtr
 
    Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (Token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As GpStatus
    Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal FileName As LongPtr, Bitmap As LongPtr) As GpStatus
    Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal Bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As GpStatus
    Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As LongPtr) As GpStatus
    Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal Token As LongPtr) As LongPtr
    Declare PtrSafe Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
    Declare PtrSafe Function GdipGetImageDimension Lib "GDIPlus" (ByVal Image As LongPtr, Width As Single, Height As Single) As GpStatus
    Declare PtrSafe Function GdipGetImageWidth Lib "GDIPlus" (ByVal Image As LongPtr, Width As LongPtr) As GpStatus
    Declare PtrSafe Function GdipGetImageHeight Lib "GDIPlus" (ByVal Image As LongPtr, Height As LongPtr) As GpStatus
    Declare PtrSafe Function GdipGetImageHorizontalResolution Lib "GDIPlus" (ByVal Image As LongPtr, resolution As Single) As GpStatus
    Declare PtrSafe Function GdipGetImageVerticalResolution Lib "GDIPlus" (ByVal Image As LongPtr, resolution As Single) As GpStatus
    Declare PtrSafe Function GdipGetImageThumbnail Lib "GDIPlus" (ByVal Image As LongPtr, ByVal thumbWidth As LongPtr, ByVal thumbHeight As LongPtr, thumbImage As LongPtr, _
                                                                  Optional ByVal callback As LongPtr = 0, Optional ByVal callbackData As LongPtr = 0) As GpStatus
    Declare PtrSafe Function GdipLoadImageFromFile Lib "GDIPlus" (ByVal FileName As String, Image As LongPtr) As GpStatus
    Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As Any) As LongPtr
 
    Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As LongPtr, ByVal nWidth As LongPtr, ByVal nHeight As LongPtr) As LongPtr
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Declare PtrSafe Function PatBlt Lib "gdi32" (ByVal hDC As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr, ByVal nHeight As LongPtr, ByVal dwRop As LongPtr) As LongPtr
    Declare PtrSafe Function CreateBitmap Lib "gdi32" (ByVal nWidth As LongPtr, ByVal nHeight As LongPtr, ByVal nPlanes As LongPtr, ByVal nBitCount As LongPtr, lpBits As Any) As LongPtr
    Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr
    Declare PtrSafe Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hDC As LongPtr, GpGraphics As LongPtr) As LongPtr
    Declare PtrSafe Function GdipSetInterpolationMode Lib "gdiplus.dll" (ByVal Graphics As LongPtr, ByVal InterMode As LongPtr) As LongPtr
    Declare PtrSafe Function GdipDrawImageRectI Lib "gdiplus.dll" (ByVal Graphics As LongPtr, ByVal Img As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal Width As LongPtr, ByVal Height As LongPtr) As LongPtr
    Declare PtrSafe Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal Graphics As LongPtr) As LongPtr
    Declare PtrSafe Function GdipDrawImageRectRectI Lib "gdiplus.dll" (ByVal Graphics As LongPtr, ByVal GpImage As LongPtr, ByVal dstx As LongPtr, ByVal dsty As LongPtr, ByVal dstwidth As LongPtr, ByVal dstheight As LongPtr, ByVal srcx As LongPtr, ByVal srcy As LongPtr, ByVal srcwidth As LongPtr, ByVal srcheight As LongPtr, ByVal srcUnit As LongPtr, ByVal imageAttributes As LongPtr, ByVal callback As LongPtr, ByVal callbackData As LongPtr) As LongPtr
 
 
Type GUID: Data1 As LongPtr: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte: End Type
Type PICTDESC: size As LongPtr: Type As LongPtr: hPic As LongPtr: hPal As LongPtr: End Type
Type GdiplusStartupInput: GdiplusVersion As LongPtr: DebugEventCallback As LongPtr: SuppressBackgroundThread As LongPtr: SuppressExternalCodecs As LongPtr: End Type
Type EncoderParameter: GUID As GUID: NumberOfValues As LongPtr: Type As LongPtr: Value As LongPtr: End Type
Type EncoderParameters: Count As LongPtr: Parameter As EncoderParameter: End Type
Enum GpStatus
    Status_OK = 0: Status_GenericError = 1: Status_InvalidParameter = 2: Status_OutOfMemory = 3: Status_ObjectBusy = 4: Status_InsufficientBuffer = 5
    Status_NotImplemented = 6: Status_Win32Error = 7: Status_WrongState = 8: Status_Aborted = 9: Status_FileNotFound = 10: Status_ValueOverflow = 11
    Status_AccessDenied = 12: Status_UnknownImageFormat = 13: Status_FontFamilyNotFound = 14: Status_FontStyleNotFound = 15: Status_NotTrueTypeFont = 16
    Status_UnsupportedGdiplusVersion = 17: Status_GdiplusNotInitialized = 18: Status_PropertyNotFound = 19: Status_PropertyNotSupported = 20
End Enum
 
#Else
    Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
 
    Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, Bitmap As Long) As Long
    Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
    Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
 
    Declare Function GdiplusStartup Lib "GDIPlus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
    Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal FileName As Long, Bitmap As Long) As GpStatus
    Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal Bitmap As Long, hbmReturn As Long, ByVal background As Long) As GpStatus
    Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As GpStatus
    Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal Token As Long) As Long
    Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Declare Function GdipGetImageDimension Lib "GDIPlus" (ByVal Image As Long, Width As Single, Height As Single) As GpStatus
    Declare Function GdipGetImageWidth Lib "GDIPlus" (ByVal Image As Long, Width As Long) As GpStatus
    Declare Function GdipGetImageHeight Lib "GDIPlus" (ByVal Image As Long, Height As Long) As GpStatus
    Declare Function GdipGetImageHorizontalResolution Lib "GDIPlus" (ByVal Image As Long, resolution As Single) As GpStatus
    Declare Function GdipGetImageVerticalResolution Lib "GDIPlus" (ByVal Image As Long, resolution As Single) As GpStatus
    Declare Function GdipGetImageThumbnail Lib "GDIPlus" (ByVal Image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, _
                                                          Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As GpStatus
    Declare Function GdipLoadImageFromFile Lib "GDIPlus" (ByVal FileName As String, Image As Long) As GpStatus
    Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
 
    Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
    Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
    Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
    Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
    Declare Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hDC As Long, GpGraphics As Long) As Long
    Declare Function GdipSetInterpolationMode Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal InterMode As Long) As Long
    Declare Function GdipDrawImageRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal Img As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Long
    Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal Graphics As Long) As Long
    Declare Function GdipDrawImageRectRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal GpImage As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal callback As Long, ByVal callbackData As Long) As Long
 
 
Type GUID: Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte: End Type
Type PICTDESC: size As Long: Type As Long: hPic As Long: hPal As Long: End Type
Type GdiplusStartupInput: GdiplusVersion As Long: DebugEventCallback As Long: SuppressBackgroundThread As Long: SuppressExternalCodecs As Long: End Type
Type EncoderParameter: GUID As GUID: NumberOfValues As Long: Type As Long: Value As Long: End Type
Type EncoderParameters: Count As Long: Parameter As EncoderParameter: End Type
Enum GpStatus
    Status_OK = 0: Status_GenericError = 1: Status_InvalidParameter = 2: Status_OutOfMemory = 3: Status_ObjectBusy = 4: Status_InsufficientBuffer = 5
    Status_NotImplemented = 6: Status_Win32Error = 7: Status_WrongState = 8: Status_Aborted = 9: Status_FileNotFound = 10: Status_ValueOverflow = 11
    Status_AccessDenied = 12: Status_UnknownImageFormat = 13: Status_FontFamilyNotFound = 14: Status_FontStyleNotFound = 15: Status_NotTrueTypeFont = 16
    Status_UnsupportedGdiplusVersion = 17: Status_GdiplusNotInitialized = 18: Status_PropertyNotFound = 19: Status_PropertyNotSupported = 20
End Enum
#End If
 
 
Type PWMFRect16: Left As Integer: Top As Integer: Right As Integer: Bottom As Integer: End Type
Public Const CF_BITMAP = 2, IMAGE_BITMAP = 0, LR_COPYRETURNORG = &H4, CF_ENHMETAFILE As Long = 14
Public Const PLANES = 14, BITSPIXEL = 12, PATCOPY = &HF00021, InterpolationModeHighQualityBicubic = 7
Изменено: Игорь - 09.01.2015 10:55:32
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#12
09.01.2015 11:07:22
Цитата
Игорь пишет: работает под 64-битной системой
"система" имеется ввиду x64 win или x64 офис?

если никто не жаловался - значит я буду первым

вот прикрепил этот обновленный код, который также не срабатывает на х64 офисе, прокатывается по коду и выдает debug.print, создавая при этом пустой файл
поэтому и прошу - у кого есть х64 офис проверить код (просто запустить его) - создаст он новую картинку или создаст также только пустой файл
для этого требуется иметь Win x64, офис х64 и любую картинку
(на Win x64 по умолчанию ставится х32 офис)
Изменено: Петр80 - 09.01.2015 14:46:15
 
 
 
#13
09.01.2015 13:17:20
Почитайте здесь.
There is no knowledge that is not power
 
 
 
#14
09.01.2015 20:55:39
если у кого то нет офиса 64,
могу в личку скинуть настроенный образ диска VirtualBox с вин64 и офисом 64, где на рабочем столе лежит xls файл и картинка для теста.
останется только запустить и проверить
Изменено: Петр80 - 09.01.2015 20:56:36
 
 
 
#15
09.01.2015 21:50:42
Кидайте. А VMware есть?
Изменено: Johny - 09.01.2015 21:51:04
There is no knowledge that is not power
 
 
 
#16
09.01.2015 21:53:15
В личке нет возможности прикрепить файл.  
 
 
 
#17
09.01.2015 22:21:32
Я надеюсь, что ТС догадался скинуть ССЫЛКУ на образ.  :D
There is no knowledge that is not power
 
 
 
#18
10.01.2015 11:51:58
VMware пока нет к сожалению, Vbox выслал

на WinXP офис 2010 x64 не ставится
а 2007го и 2003 офиса нет х64
соответственно минимально возможная комбинация - Win7/Vista x64 + Office 2010 x64
Изменено: Петр80 - 10.01.2015 11:52:53
 
 
 
#19
10.01.2015 17:30:52
разница в значениях до проблемной строчки в коде в х32 и х64 офисе

http://s017.radikal.ru/i415/1501/1d/604f3552f4a9.jpg
 
 
 
#20
10.01.2015 19:30:24
Благодаря Johny удалось не только кому-то показать, что код действительно не работает на х64 офисе
но и модифицировать код, чтобы он частично работал.
в оригинале можно задать новый размер + качество сжатия в %
в скорректированном коде для х64 офиса получается только задать новый размер

не срабатывала tParams у функции GdipSaveImageToFile, в которой задается quality
возможно как то можно сделать, чтобы код работал и с параметром quality, но пока только без него

вместо :

Цитата
 tParams.Count = 1    ' Initialize the encoder parameters
 With tParams.Parameter    ' Quality
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"  )  , .GUID    ' Set the Quality GUID
.NumberOfValues = 1: .Type = 4: .Value = VarPtr(quality)
 End With
 lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, tParams)     ' Save the image
использовать:
Цитата
  tParams.Count = 0    ' Initialize the encoder parameters
   lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, ByVal 0& )
или
Цитата
tParams.Count = 0 ' Initialize the encoder parameters
lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, Null)
Изменено: Петр80 - 10.01.2015 21:43:55
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...