unit mAIN;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs;
type
TForm1 = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
procedure FormClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
bmp : TBitmap;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure DrawBitmaptRect(dc : hdc; bmp : HBITMAP; Rect : TRect);
var
cdc : HDC;
bInfo : TBitmapInfo;
prevSetStretchBltMode : Integer;
dx, dy, dr : Double;
BitmapCx, BitmapCy : Integer;
ClipCx, ClipCy : Integer;
OffsX, OffxY : Integer;
begin
cdc := CreateCompatibleDC(dc);
SelectObject(cdc, bmp);
GetObject(bmp, SizeOf(bInfo), @Binfo);
ClipCx := Rect.Right - Rect.Left;
ClipCy := Rect.Bottom - Rect.Top;
OffsX := Rect.Left;
OffxY := Rect.Top;
BitmapCx := Binfo.bmiHeader.biWidth;
BitmapCy := bInfo.bmiHeader.biHeight;
//Считаем оптимальный размер
if (BitmapCx > ClipCx)or(BitmapCy > ClipCy) then
begin
dx := ClipCx / BitmapCx;
dy := ClipCy / BitmapCy;
//dr := min(dx, dy);
//if dx < dy then dr := dx else dr := dy;
if dx > dy then dr := dx else dr := dy;
Rect.Right := Trunc(BitmapCx * dr);
Rect.Bottom := Trunc(BitmapCY * dr);
end
else
begin
Rect.Right := BitmapCx;
Rect.Bottom := BitmapCy;
end;
//Центрируес
Rect.Left := (ClipCx - Rect.Right) div 2;
Rect.Top := (ClipCy - Rect.Bottom) div 2;
OffsetRect(Rect, OffsX, OffxY);
//Рисуем со сглаживанием
prevSetStretchBltMode := SetStretchBltMode(dc, HALFTONE);
with Rect do
StretchBlt(dc,
Left, Top, Right - OffsX, Bottom - OffxY,
cdc,
0, 0, BitmapCx, BitmapCy,
SRCCOPY);
SetStretchBltMode(dc, prevSetStretchBltMode);
DeleteDC(cdc);
end;
procedure TForm1.FormClick(Sender: TObject);
begin
if not OpenPictureDialog1.Execute then exit;
bmp.LoadFromFile(OpenPictureDialog1.FileName);
Caption := OpenPictureDialog1.FileName + ' - zeView';
Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
sz : TSize;
Str : string;
begin
bmp := TBitmap.Create;
str := 'Click to open bitmap file...';
GetTextExtentPoint32(bmp.Canvas.Handle, Pchar(str), Length(str), sz);
bmp.Width := sz.cx;
bmp.Height := sz.cy;
bmp.Canvas.TextOut(0, 0, str);
DoubleBuffered := true;
OpenPictureDialog1.Filter := '*.bmp|*.bmp';
Caption := 'zeView';
end;
procedure TForm1.FormPaint(Sender: TObject);
var
ClipRgn : HRGN;
Rt : TRect;
begin
//Моя функция не образает т.к. по логике изображение не выходит
//за граници прямоугольника
//в твоем случае такая логика не работает, поэтому
//можно использовать регионы
Rt := rect(8, 8, ClientWidth - 8, ClientHeight - 8);
ClipRgn := CreateRectRgn(8, 8, ClientWidth - 8, ClientHeight - 8);
SelectClipRgn(Canvas.Handle, ClipRgn);
DrawBitmaptRect(Canvas.Handle, bmp.Handle, rt);
SelectClipRgn(Canvas.Handle, 0);
DeleteObject(ClipRgn);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
end.