Picture im TImage negativ darstellen?

[Muetze1]

Moin!

Da hier ja nun schon eine Lösung in der CodeLibrary verlinkt wurde und ich dort nix verändern kann, werde ich hier nochmal meine Routine dafür posten die sich zusätzlich noch um eine angebbare Transparenzfarbe kümmert, die sie unverändert lässt so dass z.B. ein TransparentBlt() mit und ohne Invert funktioniert:

Delphi-Quellcode:

  // inverts the bitmap (selection view), but takes care of the transparent color
Procedure InvertBitmap(Var ABitmap : TBitmap; Const ATransparentColor : TColor);
Var
  i, j,

    // 2, 16, 256 Colors
  lPaletteEntries : Integer;
  lPalette        : TDIBPalette;
  lLastGDIObj     : HGDIOBJ;

    // 15 bit, 16 bit
  lDIBSection     : TDIBSECTION;
  lRGBWord        : PWord;
  lRightShift,
  lLeftShift      : Array[0..3] Of Word;

    // 24 bit
  lRGBTriple      : PRGBTriple;

    // 32 bit
  lRGBQuad        : PRGBQuad;

    // Transparent Color
  lQuadTransColor : TRGBQuad;
  lWordTransColor : Word;

  Function  BuildLeftShift(Const AMask : Cardinal): Word;
  Var
    lCounter : Word;
    lMask    : Cardinal;
  Begin
    lCounter := 0;
    lMask    := AMask;

    If ( lMask > 0 ) Then
    Begin
      While ( ( lMask And 1 ) = 0 ) Do
        lMask := lMask Shr 1;

      While ( ( lMask And 1 ) = 1 ) Do
      Begin
        Inc(lCounter);
        lMask := lMask Shr 1;
      End;

      Result := 8 - lCounter;
    End
    Else
      Result := 0;
  End;

  Function  BuildRightShift(Const AMask : Cardinal): Word;
  Var
    lCounter : Word;
    lMask    : Cardinal;
  Begin
    lCounter := 0;
    lMask    := AMask;

    If ( lMask > 0 ) Then
    Begin
      While ( ( lMask And 1 ) = 0 ) Do
      Begin
        lMask := lMask Shr 1;
        Inc(lCounter);
      End;
    End;

    Result := lCounter;
  End;

Begin
  lQuadTransColor.rgbRed   := GetRValue(ColorToRGB(ATransparentColor));
  lQuadTransColor.rgbGreen := GetGValue(ColorToRGB(ATransparentColor));
  lQuadTransColor.rgbBlue  := GetBValue(ColorToRGB(ATransparentColor));
  lQuadTransColor.rgbReserved := 0;

  If ( ABitmap.PixelFormat In [pf1Bit, pf4Bit, pf8Bit] ) Then
  Begin
    lLastGDIObj := SelectObject(ABitmap.Canvas.Handle, ABitmap.Handle);
    Try
      lPaletteEntries := GetDIBColorTable(ABitmap.Canvas.Handle, 0, 256, lPalette);

      If ( lPaletteEntries > 0 ) Then
      Begin
        For i := 0 To ( lPaletteEntries - 1 ) Do
        Begin
          If ( Not ( ( lPalette[i].rgbRed   = lQuadTransColor.rgbRed   ) And
                     ( lPalette[i].rgbGreen = lQuadTransColor.rgbGreen ) And
                     ( lPalette[i].rgbBlue  = lQuadTransColor.rgbBlue  ) ) ) Then 
          Begin
            lPalette[i].rgbRed   := lPalette[i].rgbRed   Xor $ff;
            lPalette[i].rgbGreen := lPalette[i].rgbGreen Xor $ff;
            lPalette[i].rgbBlue  := lPalette[i].rgbBlue  Xor $ff;
          End;
        End;

        SetDIBColorTable(ABitmap.Canvas.Handle, 0, lPaletteEntries, lPalette);
      End;
    Finally
      SelectObject(ABitmap.Canvas.Handle, lLastGDIObj);
    End;
  End
  Else // kein Farbtabellen-Bitmap (15 Bit und höher)
  Begin
    If ( ABitmap.PixelFormat In [pfCustom, pfDevice] ) Then
      ABitmap.PixelFormat := pf32bit;

    Case ABitmap.PixelFormat Of
      pf15bit,   // 15 bpp
      pf16bit :  // 16 bpp
        Begin
          If ( GetObject(ABitmap.Handle, SizeOf(TDIBSECTION), @lDIBSection) = SizeOf(TDIBSECTION) ) Then
          Begin
            If ( lDIBSection.dsBmih.biBitCount > 8 ) Then
            Begin
              For i := 0 To 3 Do
              Begin
                lRightShift[i] := BuildRightShift( lDIBSection.dsBitfields[i] );
                lLeftShift[i]  := BuildLeftShift ( lDIBSection.dsBitfields[i] );
              End;

              lWordTransColor := ( ( (lQuadTransColor.rgbRed   Shr lLeftShift[0]) Shl lRightShift[0]) Or
                                   ( (lQuadTransColor.rgbGreen Shr lLeftShift[1]) Shl lRightShift[1]) Or
                                   ( (lQuadTransColor.rgbBlue  Shr lLeftShift[2]) Shl lRightShift[2]) );

              For i := 0 To ( ABitmap.Height - 1 ) Do
              Begin
                lRGBWord := ABitmap.ScanLine[i];

                For j := 0 To ( ABitmap.Width - 1 ) Do
                Begin
                  If ( lWordTransColor <> lRGBWord^ ) Then
                    lRGBWord^ := lRGBWord^ Xor $ffff;

                  Inc(lRGBWord);
                End;
              End;
            End;
          End;
        End;

      pf24bit :  // 24 bpp
        Begin
          For i := 0 To (ABitmap.Height - 1) Do
          Begin
            lRGBTriple := ABitmap.ScanLine[i];

            For j := 0 To ( ABitmap.Width - 1 ) Do
            Begin
              If ( ( lRGBTriple^.rgbtRed   <> lQuadTransColor.rgbRed   ) And
                   ( lRGBTriple^.rgbtGreen <> lQuadTransColor.rgbGreen ) And
                   ( lRGBTriple^.rgbtBlue  <> lQuadTransColor.rgbBlue  ) ) Then
              Begin
                lRGBTriple^.rgbtRed   := lRGBTriple^.rgbtRed   Xor $ff;
                lRGBTriple^.rgbtGreen := lRGBTriple^.rgbtGreen Xor $ff;
                lRGBTriple^.rgbtBlue  := lRGBTriple^.rgbtBlue  Xor $ff;
              End;

              Inc(lRGBTriple);
            End;
          End;
        End;  

      pf32bit :  // 32 bpp
        Begin
          For i := 0 To ( ABitmap.Height - 1 ) Do
          Begin
            lRGBQuad := ABitmap.ScanLine[i];

            For j := 0 To ( ABitmap.Width - 1 ) Do
            Begin
              If ( ( lRGBQuad^.rgbRed   <> lQuadTransColor.rgbRed   ) And
                   ( lRGBQuad^.rgbGreen <> lQuadTransColor.rgbGreen ) And
                   ( lRGBQuad^.rgbBlue  <> lQuadTransColor.rgbBlue  ) ) Then
              Begin
                lRGBQuad^.rgbRed   := lRGBQuad^.rgbRed   Xor $ff;
                lRGBQuad^.rgbGreen := lRGBQuad^.rgbGreen Xor $ff;
                lRGBQuad^.rgbBlue  := lRGBQuad^.rgbBlue  Xor $ff;
              End;

              Inc(lRGBQuad);
            End;
          End;
        End;
    End;
  End;
End;

MfG
Muetze1