| Вопрос: Metafile | Добавлено: 15.02.08 14:35 |
Автор вопроса:  VβÐUηìt | Web-сайт: смекаешь.рф
|
|
Function SaveDesktop()
Dim l As Long Dim p As Long p = GetWindowDC(GetDesktopWindow) l = CreateMetaFile(App.Path & "\desktop.tmp") With Screen PtList(1).X = Screen.Width / Screen.TwipsPerPixelX End With With Screen PtList(2).Y = Screen.Height / Screen.TwipsPerPixelY End With Call PlgBlt(l, PtList(0), p, 0, 0, PtList(1).X, PtList(2).Y, 0, 0, 0) DeleteMetaFile (l) Call DeleteDC(p) End Function Function DrawDesktop() Dim l As Long Dim p As Long Cls p = GetWindowDC(GetDesktopWindow) l = GetMetaFile(App.Path & "\desktop.tmp") Call PlgBlt(hdc, PtList(0), l, 0, 0, PtList(1).X, PtList(2).Y, 0, 0, 0) Call DeleteMetaFile(l) Call DeleteDC(p) End Function Я хочу, чтобы прога методом SaveDesktop сохраняла рабочий стол в файл, а затем методом PlgBlt рисовала его на себе немножко косо. Однако GetMetaFile не загрузает сохраненный десктоп. Почему? |
| Ответы | Всего ответов: 6 |
|
Номер ответа: 1 Автор ответа:  Artyom Разработчик Вопросов: 130 Ответов: 6602 |
Профиль | Цитата | #1 | Добавлено: 15.02.08 17:27 |
| Мета-файл это по-моему совсем не то что тебе нужно. | ||
|
Номер ответа: 2 Автор ответа: VβÐUηìtВопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 15.02.08 18:43 |
| Хм... Ну, мне нужно сохранить изображение рабочего стола с возможностью последующей заргрузки для обработки. На C это вроде бы делается через метафайлы. | ||
|
Номер ответа: 3 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 15.02.08 23:27 |
|
Вот это просто убийственно!
With Screen PtList(1).X = Screen.Width / Screen.TwipsPerPixelX End With With Screen PtList(2).Y = Screen.Height / Screen.TwipsPerPixelY End With Объясни зачем тут нужен With? если в той одной строчке ты не всё равно пишешь Screen.Height, а не .Height и т.д. |
||
|
Номер ответа: 4 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #4 | Добавлено: 15.02.08 23:34 |
вообще не понимаю с какого хрена этот код мог бы заработать )
Вот пример от AllAPI который рисует искривленный скриншот. AutoRedraw у формы отключить надо. Option Explicit
Ну а сохранять можешь тупо через SavePicture.
Const BI_RGB = 0 Const DIB_RGB_COLORS = 0 ' color table in RGBs Const DIB_PAL_COLORS = 1 ' color table in palette indices Const PATCOPY = &HF00021 ' (DWORD) dest = pattern Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest Const PATPAINT = &HFB0A09 ' (DWORD) dest = DPSnoo Private Type POINTAPI x As Long y As Long End Type Private Type BITMAPINFOHEADER '40 bytes biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER End Type Private Type tBITMAP Header As BITMAPINFO Bytes(0 To 63) As Byte End Type Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" (lpPackedDIB As Any, ByVal iUsage As Long) As Long Private Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long Private 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 Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Sub Form_Paint() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@allapi.net Dim hBrush As Long, tBr As tBITMAP, Cnt As Long, hOld As Long Dim Pt(0 To 2) As POINTAPI 'set the coцrdinates of the parallelogram Pt(0).x = 30 Pt(0).y = 10 Pt(1).x = 300 Pt(1).y = 0 Pt(2).x = 0 Pt(2).y = 300 'resize and modify a screenshot PlgBlt Me.hdc, Pt(0), GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, ByVal 0&, ByVal 0&, ByVal 0& 'initialize the tBITMAP-structure With tBr.Header.bmiHeader .biSize = Len(tBr.Header.bmiHeader) .biCompression = BI_RGB .biHeight = 8 .biPlanes = 1 .biWidth = 8 .biBitCount = 1 End With For Cnt = 0 To 7 tBr.Bytes(Cnt) = 128 Next Cnt 'create a pattern brush hBrush = CreateDIBPatternBrushPt(tBr, DIB_RGB_COLORS) 'select the brush into the form's DC hOld = SelectObject(Me.hdc, hBrush) 'Perform the Pattern Block Transfer PatBlt Me.hdc, 0, 0, 30, 30, PATCOPY 'restore the old brush and delete our pattern brush  eleteObject SelectObject(Me.hdc, hOld)
End Sub |
||
|
Номер ответа: 5 Автор ответа:  Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 16.02.08 11:19 |
|
Ну а сохранять можешь тупо через SavePicture.
Ага, тока надо сначала из хэндла картинки получить OLE Picture. |
||
|
Номер ответа: 6 Автор ответа: VβÐUηìtВопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | Цитата | #6 | Добавлено: 16.02.08 19:19 |
|
Посибо)
P.S. With Screen
PtList(1).X = Screen.Width / Screen.TwipsPerPixelX End With With Screen PtList(2).Y = Screen.Height / Screen.TwipsPerPixelY End With Oops ))
|
||
Страница: 1 |