Захват части изображения
Автор: Mike Scott
Вот пример кода, позволящего с помощью 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;
|
|
