Lupe programmieren

procedure Lupe(Original, Lupe: TImage; Region: Hrgn; LupeRect: TRect; Mitte: TPoint; Faktor: integer);
{ Original: das Bild, das vergrößert werden soll
  Lupe: das Bild, in das das Ergebnis gezeichnet werden soll
  Region: gibt die Möglichkeit, eine "richtig" runde Lupe zu zeichnen; Achtung: die Region wird weder
          erstellt noch gelöscht!!
  LupeRect: In welches Rechteck des Lupe-Images soll gezeichnet werden
  Mitte: Der Punkt im Originalbild, um den herum vergrößert werden soll
  Faktor: der Faktor, um den vergrößert werden soll
  ACHTUNG: bei Original und Lupe muß es sich jeweils um Bitmaps handeln, sonst gibt es eine
           Fehlermeldung!
}
var OriginalRect: TRect;
begin
  Faktor := abs(Faktor);
  OriginalRect.Top:=Mitte.Y;
  OriginalRect.left:=Mitte.X;
  OriginalRect.Bottom:=OriginalRect.Top;
  OriginalRect.right:=OriginalRect.Left;
  OriginalRect.Top:= OriginalRect.Top-((LupeRect.Bottom-LupeRect.Top) div Faktor) div 2;
  OriginalRect.Bottom:= OriginalRect.Bottom+((LupeRect.Bottom-LupeRect.Top) div Faktor) div 2;
  OriginalRect.Left:= OriginalRect.Left-((LupeRect.right-LupeRect.Left) div Faktor) div 2;
  OriginalRect.Right:= OriginalRect.Right+((LupeRect.right-LupeRect.Left) divV Faktor) div 2;
  SelectObject(Lupe.canvas.handle,Region);
  BitBlt(Lupe.canvas.handle, LupeRect.Left, LupeRect.Top, LupeRect.Right, LupeRect.Bottom,
  Lupe.canvas.handle, 0, 0, blackness);
  // Damit es an den Rändern nicht zu Verzerrungen kommt
  StretchBlt(Lupe.canvas.handle, LupeRect.Left, LupeRect.Top, LupeRect.Right-LupeRect.Left,
  LupeRect.Bottom-LupeRect.Top, Original.canvas.handle, OriginalRect.Left, OriginalRect.Top,
  OriginalRect.Right-OriginalRect.left, OriginalRect.Bottom-OriginalRect.Top, srccopy);
  Lupe.Refresh;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var Region, r2, r3: Hrgn;
begin
  Region := CreateEllipticRgn(10, 10, 200, 100);
  // wird diese Zeile weggelassen, dann gibt es eine rechteckige Lupe
  // in der Hilfe stehen einige weitere nette Möglichkeiten zu Regionen, z.B. können diese
  // mit CombineRgn verbunden werden, vgl. unten
  Lupe(image1, image2, region, Rect(10, 10, 200, 100), Point(X, Y), 2);
  // LupeRect sollte mit der Region übereinstimmen, sonst klappt es mit der
  // Zentrierung nicht
  DeleteObject(region);
  // nie vergessen, wenn eine Region erstellt wurde
  (* Folgender Code ergibt eine "8er"-Lupe
  Region := CreateEllipticRgn(0, 0, 10, 10); // Hauptsache, die Region besteht irgendwie
  r2 := CreateEllipticRgn(0, 0, 50, 50);
  r3 := CreateEllipticRgn(0, 50, 50, 100);
  CombineRgn(Region, r2, r3, rgn_or);
  Lupe(image1, image2, region, Rect(0, 0, 100, 100), Point(X, Y), 2);
  DeleteObject(region);
  DeleteObject(r2);
  DeleteObject(r3);
  *)
end;