Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 05.12.2012, 13:24
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию HDC в файл

Добрый день знатоки) помогите с переводом из HDC в файл. поясню, функцией GetWindowDC получаю HDC окна, как мне далее, используя только winapi сохранить в файл то что там внутри, если я знаю размеры изображения... выражусь иначе на всякий случай, как мне узнать область памяти где хранится изображение ну и т д, в общем получить ту картинку не используя модуль графикс и т д, только апикой?
Ответить с цитированием
  #2  
Старый 05.12.2012, 13:37
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

через BitBlt отрисуй свой device context на предварительно созданый device context BITMAP'а и сохряняй BITMAP в файл. пример есть в Win32 SDK Reference.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 05.12.2012, 13:53
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

да про BitBlt знаю, я не знаю как создать свой HDC и как потом до указателя на памть всего этого дела дойти, я в графике не очень) интернет копал, нашёл что то на английском и не на делфях, не помого( там не много строчек будет? может поможете подробней?
Ответить с цитированием
  #4  
Старый 05.12.2012, 14:13
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

много писать лень, да и некогда, собираюсь в Assassin’s Creed III зарубить...
а так CreateCompatibleDC, CreateBitmap, SelectObject, BitBlt, GetDIBits...
вообщем можно у TBitmap в Graphics посмотреть сохранение или в Win32 SDK Reference.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #5  
Старый 05.12.2012, 14:25
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ладно, в графикс тбитмап первым делом посмотрел, но там извращение такое %-| фиг чего уследишь) сейчас сишную в делфю перевести пытаюсь

преобразовал вот это
Код:
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
inline int GetFilePointer(HANDLE FileHandle){
    return SetFilePointer(FileHandle, 0, 0, FILE_CURRENT);
}
 
bool SaveBMPFile(char *filename, HBITMAP bitmap, HDC bitmapDC, int width, int height){
    bool Success=0;
    HDC SurfDC=NULL;
    HBITMAP OffscrBmp=NULL;
    HDC OffscrDC=NULL;
    LPBITMAPINFO lpbi=NULL;
    LPVOID lpvBits=NULL;
    HANDLE BmpFile=INVALID_HANDLE_VALUE;
    BITMAPFILEHEADER bmfh;
    if ((OffscrBmp = CreateCompatibleBitmap(bitmapDC, width, height)) == NULL)
        return 0;
    if ((OffscrDC = CreateCompatibleDC(bitmapDC)) == NULL)
        return 0;
    HBITMAP OldBmp = (HBITMAP)SelectObject(OffscrDC, OffscrBmp);
    BitBlt(OffscrDC, 0, 0, width, height, bitmapDC, 0, 0, SRCCOPY);
    if ((lpbi = (LPBITMAPINFO)(new char[sizeof(BITMAPINFOHEADER) + 256 * sizeof(RGBQUAD)])) == NULL)
        return 0;
    ZeroMemory(&lpbi->bmiHeader, sizeof(BITMAPINFOHEADER));
    lpbi->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
    SelectObject(OffscrDC, OldBmp);
    if (!GetDIBits(OffscrDC, OffscrBmp, 0, height, NULL, lpbi, DIB_RGB_COLORS))
        return 0;
    if ((lpvBits = new char[lpbi->bmiHeader.biSizeImage]) == NULL)
        return 0;
    if (!GetDIBits(OffscrDC, OffscrBmp, 0, height, lpvBits, lpbi, DIB_RGB_COLORS))
        return 0;
    if ((BmpFile = CreateFile(filename,
                        GENERIC_WRITE,
                        0, NULL,
                        CREATE_ALWAYS,
                        FILE_ATTRIBUTE_NORMAL,
                        NULL)) == INVALID_HANDLE_VALUE)
        return 0;
    DWORD Written;
    bmfh.bfType = 19778;
    bmfh.bfReserved1 = bmfh.bfReserved2 = 0;
    if (!WriteFile(BmpFile, &bmfh, sizeof(bmfh), &Written, NULL))
        return 0;
    if (Written < sizeof(bmfh))
        return 0;
    if (!WriteFile(BmpFile, &lpbi->bmiHeader, sizeof(BITMAPINFOHEADER), &Written, NULL))
        return 0;
    if (Written < sizeof(BITMAPINFOHEADER))
        return 0;
    int PalEntries;
    if (lpbi->bmiHeader.biCompression == BI_BITFIELDS)
        PalEntries = 3;
    else PalEntries = (lpbi->bmiHeader.biBitCount <= 8) ?
                      (int)(1 << lpbi->bmiHeader.biBitCount) : 0;
    if(lpbi->bmiHeader.biClrUsed)
    PalEntries = lpbi->bmiHeader.biClrUsed;
    if(PalEntries){
    if (!WriteFile(BmpFile, &lpbi->bmiColors, PalEntries * sizeof(RGBQUAD), &Written, NULL))
        return 0;
        if (Written < PalEntries * sizeof(RGBQUAD))
            return 0;
    }
    bmfh.bfOffBits = GetFilePointer(BmpFile);
    if (!WriteFile(BmpFile, lpvBits, lpbi->bmiHeader.biSizeImage, &Written, NULL))
        return 0;
    if (Written < lpbi->bmiHeader.biSizeImage)
        return 0;
    bmfh.bfSize = GetFilePointer(BmpFile);
    SetFilePointer(BmpFile, 0, 0, FILE_BEGIN);
    if (!WriteFile(BmpFile, &bmfh, sizeof(bmfh), &Written, NULL))
        return 0;
    if (Written < sizeof(bmfh))
        return 0;
    return 1;
}]
в это
Код:
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
function SaveBMPFile(filename:PChar;bitmap:HBITMAP;width,height:integer):boolean;
var
  Success:boolean;
  SurfDC,OffscrDC:HDC;
  OffscrBmp,OldBmp:HBITMAP;
  lpbi:PBitmapInfo;
//  lpvBits:LPVOID;
  BmpFile:THANDLE;
  bmfh:BITMAPFILEHEADER;
  lpvBits:Pointer;
  Written:DWORD;
  PalEntries:integer;
//
  bitmapDC:HDC;
begin
 
  bitmapDC:=GetWindowDC(bitmap);
//  bitmap:=GetBitmapFromDesktop(bitmapDC);
    Success:=false;
    SurfDC:=0;
    OffscrBmp:=0;
    OffscrDC:=0;
    lpbi:=nil;
//  lpvBits=NULL;
  BmpFile:=INVALID_HANDLE_VALUE;
  Result:=false;
  OffscrBmp := CreateCompatibleBitmap(bitmapDC, width, height);
    if (OffscrBmp = NULL)then
        exit;
  OffscrDC := CreateCompatibleDC(bitmapDC);
    if (OffscrDC = NULL)then
        exit;
    OldBmp := HBITMAP(SelectObject(OffscrDC, OffscrBmp));
    BitBlt(OffscrDC, 0, 0, width, height, bitmapDC, 0, 0, SRCCOPY);
  getmem(lpbi,sizeof(BITMAPINFOHEADER) + 256 * sizeof(RGBQUAD));
    if (lpbi = nil)then
        exit;
  FillChar(lpbi.bmiHeader,sizeof(BITMAPINFOHEADER),#0);
    lpbi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
    SelectObject(OffscrDC, OldBmp);
    if(GetDIBits(OffscrDC, OffscrBmp, 0, height, nil, lpbi^, DIB_RGB_COLORS)=0)then
        exit;
  GetMem(lpvBits, lpbi^.bmiHeader.biSizeImage);
//  if lpvBits = nil then ...}
 
    if (lpvBits = nil)then
        exit;
    if (GetDIBits(OffscrDC, OffscrBmp, 0, height, lpvBits, lpbi^, DIB_RGB_COLORS)=0)then
        exit;
  BmpFile:= CreateFile(filename,
                        GENERIC_WRITE,
                        0, nil,
                        CREATE_ALWAYS,
                        FILE_ATTRIBUTE_NORMAL,
                        0);
    if (BmpFile = INVALID_HANDLE_VALUE)then
        exit;
    bmfh.bfType := 19778;
    bmfh.bfReserved1 := 0;
  bmfh.bfReserved2 := 0;
    if (not WriteFile(BmpFile, bmfh, sizeof(bmfh), Written, nil))then
        exit;
    if (Written < sizeof(bmfh))then
        exit;
    if (not WriteFile(BmpFile, lpbi.bmiHeader, sizeof(BITMAPINFOHEADER), Written, nil))then
        exit;
    if (Written < sizeof(BITMAPINFOHEADER))then
        exit;
    if (lpbi.bmiHeader.biCompression = BI_BITFIELDS)then
        PalEntries := 3
    else
  if((lpbi.bmiHeader.biBitCount <= 8))then
//    PalEntries := (int)(1 << lpbi->bmiHeader.biBitCount)
  else
        PalEntries:=0;
    if(lpbi.bmiHeader.biClrUsed<>0)then
    PalEntries := lpbi.bmiHeader.biClrUsed;
    if(PalEntries<>0)then
  begin
    if (not WriteFile(BmpFile, lpbi.bmiColors, PalEntries * sizeof(RGBQUAD), Written, nil))then
        exit;
  if (Written < PalEntries * sizeof(RGBQUAD))then
        exit;
    end;
    bmfh.bfOffBits := GetFilePointer(BmpFile);
    if ( not WriteFile(BmpFile, lpvBits, lpbi.bmiHeader.biSizeImage, Written, nil))then
        exit;
    if (Written < lpbi.bmiHeader.biSizeImage)then
        exit;
    bmfh.bfSize := GetFilePointer(BmpFile);
    SetFilePointer(BmpFile, 0, 0, FILE_BEGIN);
    if (not WriteFile(BmpFile, bmfh, sizeof(bmfh), Written, nil))then
    exit;
    if (Written < sizeof(bmfh))then
        exit;
    result:=true;
end;

но не работает( помогите, подскажите, поправьте пожалуйста

Последний раз редактировалось reqyz, 05.12.2012 в 15:36.
Ответить с цитированием
  #6  
Старый 05.12.2012, 20:16
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ну кто нибудь!!!! помогите, я не в том разделе написал что-ли?
Ответить с цитированием
  #7  
Старый 05.12.2012, 20:18
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

GetDIBits вроде пиксели возвращает, отзовитесь) напишите примерчик..
Ответить с цитированием
  #8  
Старый 05.12.2012, 22:47
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Как то писал для подобных случаев
Код:
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
procedure SaveBitmap(Name : String; bmp : HBITMAP);
var
  FileHandle    : THandle;
  Size, Res,
  HeaderSize    : DWORD;
  BFH       : TBITMAPFILEHEADER;
  BIH       : TBITMAPINFOHEADER;
  FDIB      : TDIBSection;
 
  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result div 8;
  end;
 
  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
  var
    DS      : TDIBSection;
    Bytes   : Integer;
  begin
    DS.dsbmih.biSize := 0;
    Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
    if (Bytes >= (SizeOf(DS.dsbm) + SizeOf(DS.dsbmih))) and (DS.dsbmih.biSize >= SizeOf(DS.dsbmih)) then
      BI := DS.dsbmih
    else
    begin
      FillChar(BI, SizeOf(BI), 0);
      with BI, DS.dsbm do
      begin
    biSize   := SizeOf(BI);
    biWidth  := bmWidth;
    biHeight := bmHeight;
      end;
    end;
    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
    BI.biPlanes   := 1;
    if BI.biSizeImage = 0 then
      BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
  end;
 
begin
  GetObject(bmp, SizeOf(FDIB), @FDIB);
  with FDIB, dsbm, dsbmih do
  begin
    biSize     := sizeof(dsbmih);
    biWidth    := bmWidth;
    biHeight   := bmHeight;
    biPlanes   := 1;
    biBitCount := bmPlanes * bmBitsPixel;
  end;
   
  InitializeBitmapInfoHeader(Bmp, BIH);
  HeaderSize := SizeOf(TBitmapInfoHeader);
  Size := BIH.biSizeImage;
  inc(Size, HeaderSize + SizeOf(BFH));
 
  FillChar(BFH, SizeOf(BFH), 0);
  BFH.bfType    := $4D42;
  BFH.bfSize    := Size;
  BFH.bfOffBits := SizeOf(BFH) + HeaderSize;
 
  FileHandle := CreateFile(PChar(Name + '.bmp'), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(FileHandle, BfH, SizeOf(BFH), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbmih, SizeOf(FDIB.dsbmih), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage, Res, NIL);
  CloseHandle(FileHandle);
end;
Рассчитпно на 24-битный битмап.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
Этот пользователь сказал Спасибо angvelem за это полезное сообщение:
reqyz (06.12.2012)
  #9  
Старый 06.12.2012, 05:32
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Цитата:
Сообщение от angvelem
Как то писал для подобных случаев
Код:
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
procedure SaveBitmap(Name : String; bmp : HBITMAP);
var
  FileHandle    : THandle;
  Size, Res,
  HeaderSize    : DWORD;
  BFH       : TBITMAPFILEHEADER;
  BIH       : TBITMAPINFOHEADER;
  FDIB      : TDIBSection;
 
  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result div 8;
  end;
 
  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
  var
    DS      : TDIBSection;
    Bytes   : Integer;
  begin
    DS.dsbmih.biSize := 0;
    Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
    if (Bytes >= (SizeOf(DS.dsbm) + SizeOf(DS.dsbmih))) and (DS.dsbmih.biSize >= SizeOf(DS.dsbmih)) then
      BI := DS.dsbmih
    else
    begin
      FillChar(BI, SizeOf(BI), 0);
      with BI, DS.dsbm do
      begin
    biSize   := SizeOf(BI);
    biWidth  := bmWidth;
    biHeight := bmHeight;
      end;
    end;
    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
    BI.biPlanes   := 1;
    if BI.biSizeImage = 0 then
      BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
  end;
 
begin
  GetObject(bmp, SizeOf(FDIB), @FDIB);
  with FDIB, dsbm, dsbmih do
  begin
    biSize     := sizeof(dsbmih);
    biWidth    := bmWidth;
    biHeight   := bmHeight;
    biPlanes   := 1;
    biBitCount := bmPlanes * bmBitsPixel;
  end;
   
  InitializeBitmapInfoHeader(Bmp, BIH);
  HeaderSize := SizeOf(TBitmapInfoHeader);
  Size := BIH.biSizeImage;
  inc(Size, HeaderSize + SizeOf(BFH));
 
  FillChar(BFH, SizeOf(BFH), 0);
  BFH.bfType    := $4D42;
  BFH.bfSize    := Size;
  BFH.bfOffBits := SizeOf(BFH) + HeaderSize;
 
  FileHandle := CreateFile(PChar(Name + '.bmp'), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(FileHandle, BfH, SizeOf(BFH), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbmih, SizeOf(FDIB.dsbmih), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage, Res, NIL);
  CloseHandle(FileHandle);
end;
Рассчитпно на 24-битный битмап.

Спасибо) только не работает

получаю HBitmap таким способом:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
function GetDesktopBitmap: HBitmap;
var
 DC, MemDC: HDC;
 Bitmap, OBitmap: HBitmap;
 BitmapWidth, BitmapHeight: integer;
begin
 DC := GetDC(GetDesktopWindow);
 MemDC := CreateCompatibleDC(DC);
 BitmapWidth := GetDeviceCaps(DC, HORZRES);
 BitmapHeight := GetDeviceCaps(DC, VERTRES);
 
 Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
 OBitmap := SelectObject(MemDC, Bitmap);
 BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
 SelectObject(MemDC, OBitmap);
 DeleteDC(MemDC);
 ReleaseDC(GetDesktopWindow, DC);
 Result := Bitmap;
end;

вызываю всё так:
Код:
1
SaveBitmap(SaveDialog1.FileName,GetDesktopBitmap);

в итоге получаю пустой файл( что тут не так? где ошибка?
Ответить с цитированием
  #10  
Старый 06.12.2012, 09:53
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ну, спасибо что хоть зашли сюда, но справляться самому пришлось, привожу рабочий код на делфи, вдруг кто нибудь захочет сохранять HDC в BMP файл:
Код:
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
function DibNumColors(pv:pointer):WORD;
var
  bits:Integer;
  lpbi:PBITMAPINFOHEADER;
  lpbc:PBITMAPCOREHEADER;
begin
  lpbi := PBITMAPINFOHEADER(pv);
  lpbc := PBITMAPCOREHEADER(pv);
 
  if (lpbi^.biSize <> sizeof(BITMAPCOREHEADER))then
  begin
    if (lpbi^.biClrUsed <> 0)then
    begin
      Result:=lpbi^.biClrUsed;
      exit;
    end;
    bits := lpbi^.biBitCount;
  end
  else
    bits := lpbc^.bcBitCount;
 
  case (bits) of
    1: Result := 2;
    4: Result := 16;
    8: Result := 256;
    else
      Result:=0
  end;
end;
 
 
function PaletteSize(lpbi:PBITMAPINFOHEADER):WORD;
var
  NumColors:WORD;
begin
    NumColors := DibNumColors(lpbi);
    if (lpbi^.biSize = sizeof(BITMAPCOREHEADER))then
        Result := (NumColors * sizeof(RGBTRIPLE))
    else
        Result := (NumColors * sizeof(RGBQUAD));
end;
 
 
procedure WriteMapFileHeaderandConvertFromDwordAlignToPacked(fh:HFILE;pbf:PBITMAPFILEHEADER);
begin
  _lwrite(fh, @pbf^.bfType, sizeof (WORD));
  _lwrite(fh, @pbf^.bfSize, sizeof(DWORD) * 3);
end;
 
function lwrite(fh:Integer;pv:Pointer;ul:DWORD):DWORD;
const
  MAXREAD = 32768;
var
  ulT:DWORD;
  hp:PByte;
begin
  ulT := ul;
  hp := pv;
  Result:=0;
 
  while (ul > MAXREAD) do
  begin
    if (_lwrite(fh, LPSTR(hp), MAXREAD) <> MAXREAD)then
      exit;
    dec(ul,MAXREAD);
    inc(hp,MAXREAD);
  end;
  if (_lwrite(fh, LPSTR(hp), ul) <> ul)then
    exit;
 
  result := ulT;
end;
 
 
 
function WriteDIB(szFile:LPSTR;hdib:THANDLE):BOOL;
const
  BFT_BITMAP = $4d42;
  SIZEOF_BITMAPFILEHEADER_PACKED  = (
    sizeof(WORD) +
    sizeof(DWORD) +
    sizeof(WORD) +
    sizeof(WORD) +
    sizeof(DWORD));
var
  hdr:BITMAPFILEHEADER;
  lpbi:PBITMAPINFOHEADER;
  fh:HFILE;
  off:OFSTRUCT;
begin
  result:=false;
  if (hdib = 0)then
    exit;
 
  fh := OpenFile(szFile, off, OF_CREATE or OF_READWRITE);
  if (fh = -1)then
    exit;
 
  lpbi := GlobalLock(hdib);
 
  hdr.bfType          := BFT_BITMAP;
  hdr.bfSize          := DWORD(GlobalSize (hdib) + SIZEOF_BITMAPFILEHEADER_PACKED);
  hdr.bfReserved1     := 0;
  hdr.bfReserved2     := 0;
  hdr.bfOffBits       := DWORD(SIZEOF_BITMAPFILEHEADER_PACKED + lpbi^.biSize +
                          PaletteSize(lpbi));
 
{$IFDEF FIXDWORDALIGNMENT}
  _lwrite(fh, @hdr, SIZEOF_BITMAPFILEHEADER_PACKED);
{$ELSE}
  WriteMapFileHeaderandConvertFromDwordAlignToPacked(fh, @hdr);
{$ENDIF}
 
    lwrite (fh, LPSTR(lpbi), GlobalSize (hdib));
 
    GlobalUnlock (hdib);
    _lclose(fh);
    Result := TRUE;
end;
 
function WIDTHBYTES(i:integer):integer;
begin
  result:=round((i+31)/32*4);
end;
 
function DibFromBitmap(hbm:HBITMAP;biStyle:DWORD;biBits:WORD;hpal:HPALETTE):THANDLE;
var
  bm:BITMAP;
  bi:BITMAPINFOHEADER;
  lpbi:PBITMAPINFOHEADER;
  dwLen:DWORD;
  hdib,h:THANDLE;
  dc:HDC;
  p:pointer;
begin
  Result:=0;
  if (hbm=0)then
    Exit;
 
  if (hpal = 0)then
    hpal := GetStockObject(DEFAULT_PALETTE);//(HPALETTE__ *)
 
  GetObject(hbm,sizeof(bm),LPSTR(@bm));
 
  if (biBits = 0)then
    biBits :=  bm.bmPlanes * bm.bmBitsPixel;
 
  bi.biSize               := sizeof(BITMAPINFOHEADER);
  bi.biWidth              := bm.bmWidth;
  bi.biHeight             := bm.bmHeight;
  bi.biPlanes             := 1;
  bi.biBitCount           := biBits;
  bi.biCompression        := biStyle;
  bi.biSizeImage          := 0;
  bi.biXPelsPerMeter      := 0;
  bi.biYPelsPerMeter      := 0;
  bi.biClrUsed            := 0;
  bi.biClrImportant       := 0;
  dwLen  := bi.biSize + PaletteSize(@bi);
 
  dc := GetDC(0);
  hpal := SelectPalette(dc,hpal,FALSE);
  RealizePalette(dc);
 
  hdib := GlobalAlloc(GHND,dwLen);
 
  if (hdib<0)then
  begin
    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    exit;
  end;
 
  lpbi := GlobalLock(hdib);
 
  lpbi^ := bi;
 
  GetDIBits(dc, hbm, 0, bi.biHeight,nil, PBitMAPINFO(lpbi)^, DIB_RGB_COLORS);
 
  bi := lpbi^;
  GlobalUnlock(hdib);
 
  if (bi.biSizeImage = 0)then
  begin
    bi.biSizeImage := WIDTHBYTES(bm.bmWidth * biBits) * bm.bmHeight;
 
    if (biStyle <> BI_RGB)then
      bi.biSizeImage := round((bi.biSizeImage * 3) / 2);
  end;
 
  dwLen := bi.biSize + PaletteSize(@bi) + bi.biSizeImage;
  h := GlobalReAlloc(hdib,dwLen,0);
  if (h <> 0)then
    hdib := h
  else
  begin
    GlobalFree(hdib);
    hdib := 0;
 
    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    result:=hdib;
    exit;
  end;
 
  lpbi := GlobalLock(hdib);
 
  if (GetDIBits(dc,hbm,0,bi.biHeight,Pointer(longword(lpbi) + lpbi.biSize + PaletteSize(lpbi)),
    PBitMAPINFO(lpbi)^, DIB_RGB_COLORS) = 0)then
  begin
    GlobalUnlock(hdib);
    hdib := 0;
    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    Result := 0;
    exit;
  end;
 
  bi := lpbi^;
  GlobalUnlock(hdib);
 
  SelectPalette(dc,hpal,FALSE);
  ReleaseDC(0,dc);
  result:=hdib;
end;
 
 
function ScreenGrab(szFileName:PChar):boolean;
var
  xshift,yshift,xScreen,yScreen:integer;
  sz:SIZE;
  dstDC,srcDC,memDC:HDC;
  bm:HBITMAP;
  h:THANDLE;
begin
//////////////////////?????? ?????/////////////////////////////
  xshift := 0;
  yshift := 0;
  xScreen := GetSystemMetrics(SM_CXSCREEN);
  yScreen := GetSystemMetrics(SM_CYSCREEN);
    sz.cx := xScreen;
  sz.cy := yScreen;
  dstDC := GetDC(0);
  srcDC := GetWindowDC(0);
  memDC := CreateCompatibleDC(srcDC);
  bm := CreateCompatibleBitmap(dstDC,xScreen, yScreen);
  SelectObject(memDC,bm);
  BitBlt(memDC, 0, 0, sz.cx, sz.cy, srcDC,xshift, yshift, SRCCOPY);
///////////////////////////////////////////////////////////////
  h := DibFromBitmap(bm,0,16,0);
    if(not WriteDIB(szFileName,h))then
        result := FALSE
  else
    result := TRUE;
end;
Ответить с цитированием
  #11  
Старый 06.12.2012, 11:46
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Мой код рабочий, иначе бы не выкладывал , а вот использован неверно.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #12  
Старый 07.12.2012, 05:44
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Цитата:
Сообщение от angvelem
Мой код рабочий, иначе бы не выкладывал , а вот использован неверно.
а как верно?)
Ответить с цитированием
Ответ


Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:25.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025