Зачем загружать в битмап, это же даст тот же растр
как-то так| Код | procedure TForm8.btnOpenClick(Sender: TObject);
const
CellSize = 100;
var
i: Integer;
Header: TEnhMetaHeader;
Size: UINT;
Bits: AnsiString;
begin
if OpenPictureDialog1.Execute
then begin
Image1.Stretch := False;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
if GetEnhMetafileHeader(Image1.Picture.Metafile.Handle, SizeOf(Header), @Header) = 0
then RaiseLastOsError;
with TMetaFileCanvas.Create(Image1.Picture.Metafile, 0) do
try
Draw(0, 0, Image1.Picture.Metafile);
Pen.Width := 0;
for i := 0 to Image1.Picture.Width div CellSize do
begin
MoveTo(i * CellSize, 0);
LineTo(i * CellSize, Image1.Picture.Height - 1);
end;
for i := 0 to Image1.Picture.Height div CellSize do
begin
MoveTo(0, i * CellSize);
LineTo(Image1.Picture.Width - 1, i * CellSize);
end;
finally
Free
end;
Size := GetEnhMetaFileBits(Image1.Picture.Metafile.Handle, 0, nil);
if Size = 0 then RaiseLastOsError;
SetLength(Bits, Size);
GetEnhMetaFileBits(Image1.Picture.Metafile.Handle, Size, @Bits[1]);
PEnhMetaHeader(@Bits[1]).szlMillimeters := Header.szlMillimeters;
Image1.AutoSize := True;
Image1.Picture.Metafile.Handle := SetEnhMetaFileBits(Size, @Bits[1]);
Image1.AutoSize := False;
Image1.Stretch := True
end;
end;
|
масштабирование
| Код | procedure TForm8.btnZoomInClick(Sender: TObject);
begin
Image1.SetBounds(Image1.Left, Image1.Top, Round(Image1.Width * 1.1), Round(Image1.Height * 1.1));
end;
procedure TForm8.btnZoomOutClick(Sender: TObject);
begin
Image1.SetBounds(Image1.Left, Image1.Top, Round(Image1.Width * 0.9), Round(Image1.Height * 0.9));
end; |
|
