Советы по Delphi

         

Захват изображений


Вот пример кода, позволящего с помощью TBitmap захватить часть изображения и сохранить его в файле. Я включил функцию копирования палитры, необходимой при работе в режиме 256 цветов.

    function  CopyPalette( Palette : HPalette ) : HPalette ; var nEntries   : integer ; LogPalSize : integer ; LogPalette : PLogPalette ; begin Result := 0 ; if Palette = 0 then exit ; GetObject( Palette, sizeof( nEntries ), @nEntries ) ; if nEntries < 1 then exit ; LogPalSize := sizeof( TLogPalette ) + sizeof( TPaletteEntry ) * ( nEntries - 1 ) ;

GetMem( LogPalette, LogPalSize ) ; with LogPalette^ do try palVersion := $300 ; palNumEntries := nEntries ; GetPaletteEntries( Palette, 0, nEntries, palPalEntry[ 0 ] ) ; Result := CreatePalette( LogPalette^ ) ; finally FreeMem( LogPalette, LogPalSize ) ; end ; end ;
procedure TForm1.Button1Click(Sender: TObject); var Bitmap : TBitmap ; begin Bitmap := TBitmap.Create ; try Bitmap.Width := 50 ; Bitmap.Height := 40 ; Bitmap.Palette := CopyPalette( Image1.Picture.Bitmap.Palette ) ; Bitmap.Canvas.CopyRect( Rect( 0, 0, 50, 40 ), Image1.Picture.Bitmap.Canvas, Bounds( 20, 10, 50, 40 ) ) ; Bitmap.SaveToFile( 'c:\windows\temp\junk.bmp' ) ; finally Bitmap.Free ; end ; end;

- Mike Scott. [000912]



Содержание раздела