TDBImage zoomen

[Uwe Merckens]

Hallo Gemeinde,

ist es möglich und wenn ja wie kann man die Größe eines in einem DBImage angezeigten Bildes stufenlos zoomen.

Gruß
Uwe

[andy600]

Hallo Uwe,

das folgende Beispiel erläutert ganz gut, wie man eine Grafik stufenlos zoomen kann. Es wird zwar kein DBImage verwendet, das Prinzip sollte sich aber problemlos übertragen lassen.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, shellapi;

type
  TForm1 = class(TForm)
    img_display: TImage;
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    img_mem: TImage;

    function func_GetStretchRatio(PictureWidth, PictureHeight, NewWidth, NewHeight: Integer): TRect;

  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//**********************************************************************
{
-->DATE<--20070824

-->AUTOR<-- AS
-->DESC<--  Grafik in Speicher laden

-->ENDDESC<--
}
//**********************************************************************

procedure TForm1.FormCreate(Sender: TObject);
begin
  img_mem := TImage.Create(Self);
  img_mem.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.bmp');

  // Flackern vermeiden
  Self.DoubleBuffered := true;
end;


//**********************************************************************
{
-->DATE<--20070824

-->AUTOR<-- AS
-->DESC<--  beim Resize des Formulars Grafik skalieren

-->ENDDESC<--
}
//**********************************************************************

procedure TForm1.FormResize(Sender: TObject);
var ratio: TRect;
    img_tmp: TImage;
begin
  // neue Abmessungen für Grafik ermitteln
  ratio := func_GetStretchRatio(img_mem.Picture.Width, img_mem.Picture.Height,
                                img_display.Width, img_display.Height);

  // temporäres Image erstellen
  img_tmp := TImage.Create(Self);
  img_tmp.Height := ratio.Bottom - ratio.Top;
  img_tmp.Width  := ratio.Right - ratio.Left;

  {
  // funktioniert auch, liefert aber sehr schlechte Qualität
  img_tmp.Canvas.StretchDraw(ratio, img_mem.Picture.Graphic);
  }

  // auf gewünschte Größe skalieren
  SetStretchBltMode(img_tmp.Canvas.Handle, STRETCH_HALFTONE);
  SetBrushOrgEx(img_tmp.Canvas.Handle, 0, 0, nil);
  StretchBlt(img_tmp.Canvas.Handle, 0, 0, ratio.Right - ratio.Left,
             ratio.Bottom - ratio.Top, img_mem.Canvas.Handle, 0, 0,
             img_mem.Picture.Width, img_mem.Picture.Height, SRCCOPY);

  // skalierte Grafik anzeigen
  img_display.Picture := nil;
  img_display.Picture.Assign(img_tmp.Picture);

  // temporäres Image freigeben
  img_tmp.Free;
end;


//**********************************************************************
{
-->DATE<--20070824

-->AUTOR<-- AS
-->DESC<--  neue Grafikabmessung ermitteln (Seitenverhältnis beachten)

-->ENDDESC<--
}
//**********************************************************************

function TForm1.func_GetStretchRatio(PictureWidth, PictureHeight, NewWidth, NewHeight: Integer):TRect;
begin
  Result := Rect(0, 0, NewWidth, NewHeight);

  Result.Bottom := Trunc(PictureHeight * (NewWidth / PictureWidth));
  if Result.Bottom > NewHeight then
  begin
    Result.Right := Trunc(Result.Right * (NewHeight / Result.Bottom));
    Result.Bottom := NewHeight;
  end;
end;


//**********************************************************************
{
-->DATE<--20070824

-->AUTOR<-- AS
-->DESC<--  Speicher freigeben

-->ENDDESC<--
}
//**********************************************************************

procedure TForm1.FormDestroy(Sender: TObject);
begin
  img_mem.Free;
end;

end.

Gruß Andy