DBR Delphi-Ecke

// Es bestand die Email-Anfrage, wie man mit der 3D-Funktion "SetWorldTransform"
// eine 2D-Rotation einer Bitmap um ihren Mittelpunkt realisieren kann. Das
// Beispiel bei Microsoft (welches auf vielen Seiten im Netz wiederholt wird)
// brachte nicht das gewünschte Ergebnis. Also habe ich selbst etwas gebastelt.
// Auf dem Weg dahin, ist auch noch das Erzeugen von Parallelogrammen abgefallen.
// Das Drehen aber geschieht in "TrackBar1Change". Dabei steuert "anpassen", ob
// die Größe angepasst oder die Bitmap beschnitten wird. Allerdings ist die
// Performance bei dieser Funktion nicht gerade die beste.
// Hinweis: Die Funktion ist erst ab NT 3.1 verfügbar!

// Getestet mit D4 unter XP

uses math; 
 
var 
  bmp: TBitmap; 
  links, oben: integer; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
  bmp := TBitmap.create; 
  links := 250; 
  oben := 50; 
  Trackbar1.Frequency := 10; 
  Trackbar1.max := 360; 
  Trackbar1.min := 0; 
  Trackbar1.position := 0; 
  Trackbar2.Frequency := 5; 
  Trackbar2.max := 200; 
  Trackbar2.min := 0; 
  Trackbar2.position := 100; 
  Trackbar3.Frequency := 5; 
  Trackbar3.max := 200; 
  Trackbar3.min := 0; 
  Trackbar3.position := 100; 
  Trackbar4.Frequency := 3; 
  Trackbar4.max := 100; 
  Trackbar4.min := 0; 
  Trackbar4.position := 50; 
  image1.left := links; 
  image1.top := oben; 
  image1.autosize := true; 
  bmp.loadfromfile('c:\haus.bmp'); 
  bmp.pixelformat := pf24bit; 
  image1.Picture.bitmap.assign(bmp); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bmp.free; 
end; 
 
// Prozedur für Drehbewegung 
 
procedure drehen(src, dest: TBitmap; winkel: single; 
  Untergrund: TColor; anpassen: boolean); 
var 
  zx, zy, breit, hoch, csn, sn: extended; 
  XForm, XMerk: tagXFORM; 
  oldMode, h: integer; 
begin 
  while winkel > 360 do winkel := winkel - 360; 
  while winkel < 0 do winkel := winkel + 360; 
  dest.pixelformat := pf24bit; 
  sincos(degtorad(winkel), sn, csn); 
  h := src.height; 
  if (sn * csn) < 0 then h := -h; 
  breit := abs(src.width * csn + h * sn); 
  hoch := abs(src.width * sn + h * csn); 
  if anpassen then begin 
    dest.width := round(breit); 
    dest.height := round(hoch); 
    zx := 0; 
    zy := 0; 
  end else begin 
    dest.width := src.width; 
    dest.height := src.height; 
    zx := (breit - src.width) / 2; 
    zy := (hoch - src.height) / 2; 
  end; 
  with dest.canvas do begin 
    brush.color := Untergrund; 
    fillrect(cliprect); 
  end; 
  with XForm do begin 
    eM11 := csn; 
    eM12 := -sn; 
    eM21 := sn; 
    eM22 := csn; 
    eDx := -src.width * eM11 * ord(eM11 < 0) + abs(eM21) * src.height 
      * ord(eM21 < 0) - zx; 
    eDy := -src.height * eM22 * ord(eM22 < 0) + abs(eM12) * src.width 
      * ord(eM12 < 0) - zy; 
  end; 
  oldMode := SetGraphicsMode(dest.canvas.handle, GM_ADVANCED); 
  GetWorldTransform(dest.canvas.handle, XMerk); 
  SetWorldTransform(dest.canvas.handle, XForm); 
  dest.canvas.draw(0, 0, src); 
  SetWorldTransform(dest.canvas.handle, XMerk); 
  SetGraphicsMode(dest.canvas.handle, oldMode); 
end; 
 
// Prozedur für Paralellogramm 
 
procedure paralellogramm(src, dest: TBitmap; Untergrund: TColor; 
  waagerecht, senkrecht: single); 
var 
  XForm, XMerk: tagXFORM; 
  oldMode: integer; 
begin 
  dest.pixelformat := pf24bit; 
  dest.canvas.brush.color := Untergrund; 
  with XForm do begin 
    eM11 := 1; 
    eM12 := senkrecht; 
    eM21 := waagerecht; 
    eM22 := 1; 
    eDx := -src.width * eM11 * ord(eM11 < 0) + abs(eM21) * src.height 
      * ord(eM21 < 0); 
    eDy := -src.height * eM22 * ord(eM22 < 0) + abs(eM12) * src.width 
      * ord(eM12 < 0); 
    if ((eM11 = 0) or (eM22 = 0)) and (eM21 = 0) or 
      (eM11 = eM12) and (eM12 = eM21) and (eM21 = eM22) 
      then begin 
      dest.width := src.width; 
      dest.height := src.height; 
    end else begin 
      dest.Width := trunc(src.width * abs(eM11) + abs(eM21) * src.height); 
      dest.Height := trunc(src.height * abs(eM22) + abs(eM12) * src.width); 
    end; 
  end; 
  if (dest.width = 0) then dest.width := src.width; 
  if (dest.height = 0) then dest.height := src.height; 
  with dest.canvas do 
    fillrect(cliprect); 
  oldMode := SetGraphicsMode(dest.canvas.handle, GM_ADVANCED); 
  GetWorldTransform(dest.canvas.handle, XMerk); 
  SetWorldTransform(dest.canvas.handle, XForm); 
  dest.canvas.draw(0, 0, src); 
  SetWorldTransform(dest.canvas.handle, XMerk); 
  SetGraphicsMode(dest.canvas.handle, oldMode); 
end; 
 
// um den Mittelpunkt drehen 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  drehen(bmp, image1.picture.bitmap, trackbar1.position, clbtnface, true); 
  image1.left := links - (image1.width - bmp.width) div 2; 
  image1.top := oben - (image1.height - bmp.height) div 2; 
end; 
 
// waagerechtes Paralellogramm 
 
procedure TForm1.TrackBar2Change(Sender: TObject); 
begin 
  image1.top := oben; 
  paralellogramm(bmp, Image1.picture.bitmap, clbtnface, 
    (trackbar2.position - 100) / 100, 0); 
  image1.left := links - (image1.width - bmp.width) div 2; 
end; 
 
// senkrechtes Paralellogramm 
 
procedure TForm1.TrackBar3Change(Sender: TObject); 
begin 
  image1.left := links; 
  paralellogramm(bmp, Image1.picture.bitmap, clbtnface, 0, 
    (trackbar3.position - 100) / 100); 
  image1.top := oben - (image1.height - bmp.height) div 2; 
end; 
 
// Paralellogramm in beide Richtungen 
 
procedure TForm1.TrackBar4Change(Sender: TObject); 
begin 
  paralellogramm(bmp, Image1.picture.bitmap, clbtnface, 
    (trackbar4.position - 50) / 100, (trackbar4.position - 50) / 100); 
  image1.top := oben - (image1.height - bmp.height) div 2; 
  image1.left := links - (image1.width - bmp.width) div 2; 
end;