Bitmap to Magnifying Glass

Dieses Beispiel zeigt, wie man ein Bitmap als Lupe einsetzen kann.

Das Bitmap sollte transparent sein und eine schwarze Hintergrundfarbe haben.

Außerdem sollte die Bittiefe möglichst 8 Bit haben.

TypeRGB       = Record
                        Bleu, Vert, Rouge : Byte;
                  End;
  TypeTRGBArray = Array [0..400] Of TypeRGB;
  TypePRGBArray = ^TypeTRGBArray;
  TypeRebond    = Array [1..180] Of Integer;

Var Form1 : TForm1;
    BMPImage,
    BMPBuffer,
    BMPMask,
    BMPLoupe : TBitmap;
    XPos, YPos, Dx   : Integer;
    AncXPos, AncYPos : Integer;
    Rebond    : TypeRebond;
    CptRebond : Byte;
    Souris : tPoint;
    
//

Procedure TForm1.FormCreate(Sender: TObject);
var
 Cpt : Integer;
begin
 Randomize;
 BMPImage := TBitmap.Create;
 BMPImage.LoadFromFile('Image.bmp');  // Hintergrundbild
 BMPImage.PixelFormat := pf24Bit;
 BMPBuffer:= TBitmap.Create;
 BMPBuffer.PixelFormat := pf24Bit;
 BMPBuffer.Width := 128; BMPBuffer.Height := 128;
 BMPMask := TBitmap.Create;
 BMPMask.LoadFromFile('Mask.bmp');  // Lupe
 BMPMask.PixelFormat := pf24Bit;
 BMPLoupe := TBitmap.Create;
 BMPLoupe.PixelFormat := pf24Bit;
 BMPLoupe.Width := 128; BMPLoupe.Height := 128;
 BMPLoupe.Transparent := True;
 BMPLoupe.TransparentColor := RGB(0, 0, 0);
 XPos := Random(272) + 64;
 Dx := (Random(2)*2)-1;    
 for Cpt := 1 To 180 Do    
         Rebond[Cpt] := Trunc(Sin(Cpt*(Pi/180))*250);
     CptRebond := Random(30) + 90;
     YPos := 336 - Rebond[CptRebond]; 
     AncXPos := XPos; AncYPos := YPos; 
     BMPBuffer.Canvas.CopyRect(Bounds(0, 0, 128, 128),
     BMPImage.Canvas, Bounds(AncXPos-64, AncYPos-64, 128, 128));
End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
     BMPImage.Free;
     BMPBuffer.Free;
     BMPMask.Free;
     BMPLoupe.Free;
End;

Procedure TForm1.AppliquerMasque;
Var X, Y, lR, lV, lB, mR, mV, mB : Integer;
    ScanLoupe, ScanMasque        : TypePRGBArray;
Begin
     For Y := 0 To 127 Do
         Begin
              ScanLoupe := BMPLoupe.ScanLine[Y];
              ScanMasque := BMPMask.ScanLine[Y];
              For X := 0 To 127 Do
                  Begin
                       mR := ScanMasque[X].Rouge;
                       mV := ScanMasque[X].Vert;
                       mB := ScanMasque[X].Bleu;
                       If (mR = 0) And (mV = 0) And (mB = 255) Then
                          Begin 
                               lR := ScanLoupe[X].Rouge;
                               lV := ScanLoupe[X].Vert;
                               lB := ScanLoupe[X].Bleu + 128;
                               If lB > 255 Then lB := 255;
                          End
                       Else Begin 
                                 lR := mR;
                                 lV := mV;
                                 lB := mB;
                            End;
                       ScanLoupe[X].Rouge := lR;
                       ScanLoupe[X].Vert  := lV;
                       ScanLoupe[X].Bleu  := lB;
                  End;
         End;
End;

Procedure TForm1.TimerAnimTimer(Sender: TObject);
Var Cpt : Byte;
Begin
 For Cpt := 1 To 4 Do
  Begin
     If (Souris.X >= 64) And (Souris.X <= 336) And (Souris.Y >= 64) And (Souris.Y <= 336) Then
        Begin
             XPos := Souris.X;
             YPos := Souris.Y;
        End
     Else 
     Begin 
               Inc(XPos, Dx); If (XPos = 64) Or (XPos = 336) Then Dx := -Dx;
              CptRebond := (CptRebond Mod 180) + 1;
              YPos := 336 - Rebond[CptRebond];
     End;
          
     BMPImage.Canvas.Draw(AncXPos-64, AncYPos-64, BMPBuffer);
     BMPBuffer.Canvas.CopyRect(Bounds(0, 0, 128, 128),
                               BMPImage.Canvas, Bounds(XPos-64, YPos-64, 128, 128));
                               
     AncXPos := XPos; AncYPos := YPos; 
     BMPLoupe.Canvas.CopyRect(Bounds(0, 0, 128, 128),
                              BMPImage.Canvas, Bounds(XPos-32, YPos-32, 64, 64));
                              
     AppliquerMasque;
     BMPImage.Canvas.Draw(XPos-64, YPos-64, BMPLoupe);
     Image1.Canvas.Draw(0, 0, BMPImage);
  End;
End;

Procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Begin
     Souris.X := X;
     Souris.Y := Y;
End;