Delphi 1

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

Вот пример кода, позволящего с помощью 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 ;

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]