DBR Delphi-Ecke

// Getestet mit D4 unter WinME

// 1.
// Hiermit kann man ein Bitmap horizontal (HorzFlip),
// vertikal (VertFlip) oder in beide Richtungen (BothFlip)
// spiegeln (Letzteres entspricht einer Drehung um 180 Grad).
// Siehe auch: Bitmaps in einem bestimmten Winkel drehen

procedure HorzFlip(bmp: TBitmap); 
begin 
  stretchblt(bmp.canvas.handle, 0, 0, bmp.width, bmp.height, 
    bmp.canvas.handle, bmp.width - 1, 0, -bmp.width, bmp.height, SRCCOPY); 
end; 
 
procedure VertFlip(bmp: TBitmap); 
begin 
  stretchblt(bmp.canvas.handle, 0, 0, bmp.width, bmp.height, 
    bmp.canvas.handle, 0, bmp.height - 1, bmp.width, -bmp.height, SRCCOPY); 
end; 
 
procedure BothFlip(bmp: TBitmap); 
begin 
  stretchblt(bmp.canvas.handle, 0, 0, bmp.width, bmp.height, 
    bmp.canvas.handle, bmp.width - 1, bmp.height - 1, -bmp.width, 
    -bmp.height, SRCCOPY); 
end; 
 
// Beispielaufruf (bei einem Image "refresh" nicht vergessen) 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  bothflip(image1.picture.bitmap); 
  image1.refresh; 
end;

//-----------------------------------------------------------------

// 2.
// Nach einiger Überlegung habe ich eine Methode gefunden, Bitmaps
// mit 24 Bit Farbtiefe um 90, 180 oder 270 Grad im Uhrzeigersinn zu
// drehen, sowie horizontal oder vertikal zu spiegeln. Bitmaps mit
// anderer Farbtiefe werden in 24 Bit umgewandelt, damit man auch
// diese drehen/spiegeln kann.(siehe aber 5.)

type 
  work = (grad90, grad180, grad270, horz, vert); 
  b3 = array[0..2] of byte; 
 
var 
  a: array of array of b3; 
 
procedure rotate_flip(bmp: tbitmap; art: work); 
var 
  x, y, h, w, w3: word; 
  p: pbytearray; 
  i: byte; 
  procedure rechnen(b, c: word); 
  var j: byte; 
  begin 
    for j := 0 to 2 do p[x + j] := a[b][c][j]; 
  end; 
begin 
  bmp.pixelformat := pf24bit; 
  setlength(a, bmp.height); 
  h := bmp.height - 1; 
  for x := 0 to h do setlength(a[x], bmp.width); 
  w3 := bmp.width * 3 - 1; 
  for y := 0 to h do begin 
    p := bmp.scanline[y]; 
    x := 0; 
    while x <= w3 do begin 
      for i := 0 to 2 do a[h - y][x div 3][i] := p[x + i]; 
      inc(x, 3); 
    end; 
  end; 
  if (art = grad90) or (art = grad270) then begin 
    x := bmp.height; 
    bmp.height := bmp.width; 
    bmp.width := x; 
    h := bmp.height - 1; 
    w3 := bmp.width * 3 - 1; 
  end; 
  w := bmp.width - 1; 
  for y := 0 to h do begin 
    p := bmp.scanline[y]; 
    x := 0; 
    while x <= w3 do begin 
      case art of 
        vert: rechnen(y, x div 3); 
        grad90: rechnen(x div 3, y); 
        grad180: rechnen(y, w - x div 3); 
        horz: rechnen(h - y, w - x div 3); 
      else rechnen(w - x div 3, h - y); 
      end; 
      inc(x, 3); 
    end; 
  end; 
  a := nil; 
end; 
 
// Beispielaufruf (bei einem Image "refresh" nicht vergessen) 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  rotate_flip(image1.picture.bitmap, grad90); 
  image1.refresh; 
end; 
 
// Falls ein Image ein JPeg enthält, und dieses nach dem Drehen 
// auch noch erhalten sein soll, muss man Umwandlungen vornehmen: 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  b: TBitmap; 
  j: TJpegImage; 
begin 
  b := TBitmap.create; 
  j := TJpegImage.create; 
  b.assign(image1.picture.graphic); 
  rotate_flip(b, grad90); 
  j.Assign(b); 
  b.free; 
  image1.picture.assign(j); 
  j.free; 
end;

//-----------------------------------------------------------------

// 3.
// Wenn man Bitmaps nur schrittweise jeweils um 90 Grad drehen will,
// kann man den folgenden Code benutzen:

type 
  TripleArray = array[0..21844] of TRGBTriple; 
  PTriple = ^TripleArray; 
 
var 
  bmp: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bmp := TBitmap.create; 
  bmp.loadfromfile('d:\bilder\frau.bmp'); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bmp.free; 
end; 
 
procedure Rotate90Clockwise(bitmap: TBitmap); 
var 
  p: PTriple; 
  x, y: integer; 
  ergebnis: TBitmap; 
begin 
  bitmap.pixelformat := pf24bit; 
  ergebnis := TBitmap.create; 
  ergebnis.width := bitmap.height; 
  ergebnis.height := bitmap.width; 
  ergebnis.pixelformat := pf24bit; 
  for y := 0 to bitmap.height - 1 do begin 
    p := bitmap.scanline[y]; 
    for x := bitmap.width - 1 downto 0 do 
      PTriple(ergebnis.scanline[bitmap.width - x - 1])[y] := p[x]; 
  end; 
  bitmap.width := ergebnis.width; 
  bitmap.height := ergebnis.height; 
  bitmap.canvas.draw(0, 0, ergebnis); 
  ergebnis.free; 
end; 
 
// Bei jedem Klick wird das Bitmap um 90 Grad
// gegen den Uhrzeigersinn gedreht
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Rotate90Clockwise(bmp); 
  refresh; 
  canvas.draw(0, 0, bmp); 
end;

//-----------------------------------------------------------------

// 4.
// Der folgende Code dreht Bitmaps unabhängig von ihrem Pixelformat
// nach rechts oder links jeweils um 90° entsprechend der Angabe
// von "Uhrzeigersinn":

procedure b90(SrcBitmap: TBitmap; UhrzeigerSinn: boolean); 
var 
  x, y, xx, yy: integer; 
  DestBitmap: TBitmap; 
begin 
  DestBitmap := TBitmap.create; 
  DestBitmap.width := SrcBitmap.height; 
  DestBitmap.height := SrcBitmap.width; 
  for x := 0 to SrcBitmap.width do 
    for y := 0 to SrcBitmap.height do 
    begin 
      if UhrzeigerSinn then 
      begin 
        xx := x; 
        yy := pred(DestBitmap.width - y); 
      end 
      else 
      begin 
        yy := y; 
        xx := pred(SrcBitmap.width - x); 
      end; 
      setpixel(DestBitmap.canvas.handle, y, xx, 
        GetPixel(SrcBitmap.canvas.handle, x, yy)); 
    end; 
  SrcBitmap.Assign(DestBitmap); 
  DestBitmap.Free; 
end;

//-----------------------------------------------------------------

// 5. (Ergänzung zu 2.)
// Natürlich funktioniert das auch mit Bitmaps in 32 Bit, indem man
// alle Dreien in eine Vier ändert und 0..2 mit 0..3 ersetzt.

type 
  work = (grad90, grad180, grad270, horz, vert); 
  b3 = array [0 .. 3] of byte; 
 
var 
  a: array of array of b3; 
 
procedure TForm4.rotatex(bmp: tbitmap; art: work); 
var 
  X, Y, h, w, w3: word; 
  p: pbytearray; 
  i: byte; 
  procedure rechnen(b, c: word); 
  var 
    j: byte; 
  begin 
    for j := 0 to 3 do 
      p[X + j] := a[b][c][j]; 
  end; 
 
begin 
  bmp.pixelformat := pf32bit; // <-----
  setlength(a, bmp.height); 
  h := bmp.height - 1; 
  for X := 0 to h do 
    setlength(a[X], bmp.width); 
  w3 := bmp.width * 4 - 1; 
  for Y := 0 to h do 
  begin 
    p := bmp.scanline[Y]; 
    X := 0; 
    while X <= w3 do 
    begin 
      for i := 0 to 3 do 
        a[h - Y][X div 4][i] := p[X + i]; 
      inc(X, 4); 
    end; 
  end; 
  if (art = grad90) or (art = grad270) then 
  begin 
    X := bmp.height; 
    bmp.height := bmp.width; 
    bmp.width := X; 
    h := bmp.height - 1; 
    w3 := bmp.width * 4 - 1; 
  end; 
  w := bmp.width - 1; 
  for Y := 0 to h do 
  begin 
    p := bmp.scanline[Y]; 
    X := 0; 
    while X <= w3 do 
    begin 
      case art of 
        vert: 
          rechnen(Y, X div 4); 
        grad90: 
          rechnen(X div 4, Y); 
        grad180: 
          rechnen(Y, w - X div 4); 
        horz: 
          rechnen(h - Y, w - X div 4); 
      else 
        rechnen(w - X div 4, h - Y); 
      end; 
      inc(X, 4); 
    end; 
  end; 
  a := nil; 
end;