function DrawParallelogram(dc: HDC; 
  X, Y, diffX1, diffY1, diffX2, diffY2: integer; bmp, mask: TBitmap): boolean; 
var 
  i: integer; 
  Punkte: array[0..2] of TPoint; 
begin 
  result := false; 
  try 
    if assigned(mask) then begin 
      i := mask.handle; 
      if (mask.pixelformat <> pf1bit) or (mask.width <> bmp.width) 
        or (mask.height <> bmp.height) then exit; 
    end else i := 0; 
    Punkte[0] := point(x, y); 
    Punkte[1] := point(x + bmp.width + diffX1, y + diffY1); 
    Punkte[2] := point(x + diffX2, y + bmp.height + diffY2); 
    result := PlgBlt(dc, Punkte, bmp.canvas.handle, 
      0, 0, bmp.width, bmp.height, i, 0, 0); 
  except 
  end; 
end; 
 

// Beispiel X (keine Äderung)

procedure TForm1.Button1Click(Sender: TObject); 
var 
  bm: TBitmap; 
  X, Y: integer; 
begin 
  X := 120; 
  Y := 140; 
  bm := TBitmap.create; 
  bm.loadfromfile('frau.bmp'); 
  if not DrawParallelogram(canvas.handle, X, Y, 0, 0, 0, 0, bm, nil) then 
    showmessage('FEHLER'); 
  bm.free; 
end; 

// Beispiel 1:

procedure TForm1.Button5Click(Sender: TObject); 
var bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.loadfromfile('c:\frau.bmp'); 
  if not 
    DrawParallelogram(canvas.handle, 225, 60, -25, -20, -40, -50, bm, nil) 
    then showmessage('FEHLER'); 
  bm.free; 
end; 
 

// Beispiel 2:

procedure TForm1.Button3Click(Sender: TObject); 
var 
  mask, bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.loadfromfile('c:\frau.bmp'); 
  mask := TBitmap.create; 
  with mask do begin 
    width := bm.width; 
    height := bm.height; 
    pixelformat := pf1bit; 
    with canvas do begin 
      brush.color := clblack; 
      fillrect(cliprect); 
      brush.color := clwhite; 
      pen.style := psClear; 
      ellipse(0, 0, width, height); 
    end; 
  end; 
  if not 
    DrawParallelogram(canvas.handle, 355, 10, -45, 30, 40, -15, bm, mask) 
    then showmessage('FEHLER'); 
  mask.free; 
  bm.free; 
end; 

var 
  mittex, mittey: double; 
  bm, mask: TBitmap; 
  links, oben, grad: integer; 
  Punkte: array[0..2] of TPoint; 
 
function x(w, b: double): integer; 
begin 
  result := round(cos(0.0174532925 * w - 1.5707963268) * b / 2 + mittex); 
end; 
 
function y(w, h: double): integer; 
begin 
  result := round(sin(0.0174532925 * w - 1.5707963268) * h / 2 + mittey); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bm := TBitmap.create; 
  bm.loadfromfile('c:\frau.bmp'); 
  with bm, bm.canvas do begin 
    brush.style := bsclear; 
    pen.color := clbtnshadow; 
    pen.width := 3; 
    ellipse(0, 0, width, height);  // Rand-Flickern minimieren
  end; 
  mask := TBitmap.create; 
  with mask do begin 
    width := bm.width; 
    height := bm.height; 
    pixelformat := pf1bit; 
    with canvas do begin 
      brush.color := clblack; 
      fillrect(cliprect); 
      brush.color := clwhite; 
      pen.style := psClear; 
      ellipse(0, 0, width, height); 
    end; 
  end; 
  links := 225; 
  oben := 20; 
  mittex := bm.width / 2 + links; 
  mittey := bm.height / 2 + oben; 
  grad := -45; 
  Timer1.interval := 12; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
  mask.free; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  Punkte[0] := point(x(grad, mittex), y(grad, mittey)); 
  Punkte[1] := point(x(grad + 90, mittex), y(grad + 90, mittey)); 
  Punkte[2] := point(x(grad + 270, mittex), y(grad + 270, mittey)); 
  PlgBlt(canvas.handle, Punkte, bm.canvas.handle, 
    0, 0, bm.width, bm.height, mask.handle, 0, 0); 
  inc(grad); 
  if grad > 359 then grad := 0;                                 
end;