Показать сообщение отдельно
  #11  
Старый 20.09.2009, 20:33
Аватар для 0nni
0nni 0nni вне форума
Начинающий
 
Регистрация: 13.12.2008
Адрес: Туапсе
Сообщения: 161
Репутация: 20
По умолчанию

Воспользуйся регионами:
Код:
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.
__________________
...сказал, и загрустил от бесспорной своей правоты
Ответить с цитированием