Ekranın Resmini Çekme

~~*MeLeK*~~ · 28-01-2008, 12:10

procedure TForm1.ScreenShot(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap);
var
dc: HDC;
lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;

bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;

{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;

{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;

28-01-2008, 12:10	#1 (permalink)
~~MeLeK~~ Banlandı Üyelik tarihi: 22-11-2007 Nerden: napıcan ziyaretemi geLcen!! Mesajlar: 0 Konular: 2724 Üye No: 11416 Ruh halim: Rep Gücü : 0 Rep Puanı : 0 Rep Seviyesi :	Ekranın Resmini Çekme procedure TForm1.ScreenShot(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap); var dc: HDC; lpPal : PLOGPALETTE; begin {test width and height} if ((Width = 0) OR (Height = 0)) then exit; bm.Width := Width; bm.Height := Height; {get the screen dc} dc := GetDc(0); if (dc = 0) then exit; {do we have a palette device?} if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin {allocate memory for a logical palette} GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY))); {zero it out to be neat} FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0); {fill in the palette version} lpPal^.palVersion := $300; {grab the system palette entries} lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry); if (lpPal^.PalNumEntries <> 0) then begin {create the palette} bm.Palette := CreatePalette(lpPal^); end; FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY))); end; {copy from the screen to the bitmap} BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY); {release the screen dc} ReleaseDc(0, dc); end;

Konu Araçları
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid-şeklinde gösterime geç Ağaç şeklinde gösterime geç

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	son Mesaj
Metin2 Oto Çekme	£эGєИđ	Yardım ve İpuçları	21	20-07-2008 22:56
+7 çekme hilesi	eqoer	Knight Online Genel	0	15-07-2008 22:16
Neyin Resmini Görmek İstiyosunuz?	WeeeeeW	Forum Oyunları	5	07-04-2008 18:45
Alwush :) Resmini İstiyoruz :)	AnTy	Metin2 Genel	64	22-03-2008 07:16
penaltı çekme	Rapçitürk	Oyunlar - Arcade	0	28-02-2008 10:37