【分享】Delphi一个抓屏的函数
<font color="#000080"><strong>procedure</strong></font> TMainFrm.ScreenShot(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap);<br/><font color="#000080"><strong>var</strong></font><br/>dc: HDC; lpPal : PLOGPALETTE;<br/><font color="#000080"><strong>begin</strong></font><br/> <font color="#008000">// 检测所需抓屏的区域<br/></font> <font color="#000080"><strong>if</strong></font> ((Width = <font color="#0000ff">0</font>) <font color="#000080"><strong>or</strong></font> (Height = <font color="#0000ff">0</font>)) <font color="#000080"><strong>then</strong></font> exit;<br/> bm.Width := Width;<br/> bm.Height := Height;<br/> <font color="#008000">//获取设备上下文<br/></font> dc := GetDc(<font color="#0000ff">0</font>);<br/> <font color="#000080"><strong>if</strong></font> (dc = <font color="#0000ff">0</font>) <font color="#000080"><strong>then</strong></font> exit;<br/> <font color="#008000">{do we have a palette device?}</font><br/> <font color="#000080"><strong>if</strong></font> (GetDeviceCaps(dc, RASTERCAPS) AND<br/> RC_PALETTE = RC_PALETTE) <font color="#000080"><strong>then</strong></font><br/> <font color="#000080"><strong>begin</strong></font><br/> <font color="#008000">{allocate memory for a logical palette}</font><br/> GetMem(lpPal, sizeof(TLOGPALETTE) + (<font color="#0000ff">255</font> * sizeof(TPALETTEENTRY)));<br/> <font color="#008000">{zero it out to be neat}</font><br/> FillChar(lpPal^, sizeof(TLOGPALETTE) + (<font color="#0000ff">255</font> * sizeof(TPALETTEENTRY)), <font color="#0000ff">#0</font>);<br/> <font color="#008000">{fill in the palette version}</font><br/> lpPal^.palVersion := <font color="#0000ff">$300</font>;<br/> <font color="#008000">{grab the system palette entries}</font><br/> lpPal^.palNumEntries :=<br/> GetSystemPaletteEntries(dc,<font color="#0000ff">0</font>,<font color="#0000ff">256</font>,lpPal^.palPalEntry);<br/> <font color="#000080"><strong>if</strong></font> (lpPal^.PalNumEntries <> <font color="#0000ff">0</font>) <font color="#000080"><strong>then</strong></font><br/> <font color="#000080"><strong>begin</strong></font><br/> <font color="#008000">{create the palette}</font><br/> bm.Palette := CreatePalette(lpPal^);<br/> <font color="#000080"><strong>end</strong></font>;<br/> FreeMem(lpPal, sizeof(TLOGPALETTE) + (<font color="#0000ff">255</font> * sizeof(TPALETTEENTRY)));<br/> <font color="#000080"><strong>end</strong></font>;<br/> <font color="#008000">{copy from the screen to the bitmap}</font><br/> BitBlt(bm.Canvas.Handle,<font color="#0000ff">0</font>,<font color="#0000ff">0</font>,Width,Height,Dc,x,y,SRCCOPY);<br/> <font color="#008000">{release the screen dc}</font><br/> ReleaseDc(<font color="#0000ff">0</font>, dc);<br/><font color="#000080"><strong>end</strong></font>;<br/><br/><font color="#008000">//调用方法<br/></font><font color="#000080"><strong>procedure</strong></font> TMainFrm.Button1Click(Sender: TObject);<br/><font color="#000080"><strong>var</strong></font><br/> tBM : TBitmap;<br/><font color="#000080"><strong>begin</strong></font><br/> <font color="#000080"><strong>try</strong></font><br/> tBM := TBitmap.Create;<br/> ScreenShot(<font color="#0000ff">0</font>,<font color="#0000ff">0</font>,Screen.Width,Screen.height,tBM);<br/> tBM.SaveToFile(<font color="#0000ff">'c:\ScreenShot.BMP'</font>);<br/> <font color="#000080"><strong>finally</strong></font><br/> tBm.FreeImage;<br/> FreeAndNil(tBM);<br/> <font color="#000080"><strong>end</strong></font>;<br/><font color="#000080"><strong>end</strong></font>; 看来delphi代码区是乱码了
页:
[1]