Picture im TImage negativ darstellen?

[smart]

Wie kann man ein Picture im TImage negativ darstellen?

[Matze]

Vielleicht gibt dir das einen Denkanstoß: Code aus der Code-Library

[Khabarakh]

[EDIT]Hab jetzt auch mal den roten Kasten gesehen . Aber der Eintrag in der CodeLibrary ist ja nicht wirklich die beste Lösung. Also doch noch mein Originalpost (verkürzt):

1. Lösung: direkt im TImage über Canvas.Pixels (einfachste).
2. Lösung: In ein Bitmap laden und dann über Scanline (schneller und profesioneller)
3. Lösung: Pixels im TBitmap32 (GR32-Lib) (noch schneller)

[smart]

Vielen Dank für Eure Antworten. Bin mit Canvas.Pixels weiter gekommen.

[Matze]

Äh, für jeden Pixel einzelnd oder wie meint ihr das jetzt?

[Binärbaum]

Zitat von Matze:

Äh, für jeden Pixel einzelnd oder wie meint ihr das jetzt?

Darauf läuft die erste Lösung von Khabarakh hinaus. Ist zwar nicht sehr elegant, aber es funktioniert.

MfG
Binärbaum

[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

[smart]

Kann man Deinen Code auch Icons?

[Muetze1]

Moin!

Meine Routine akzeptiert genauso wie die oben verlinkte Routine ein TBitmap als Parameter und arbeitet mit denen - wenn du dein TIcon zu einem TBitmap konvertierst, kannst du meine Routine nutzen.

MfG
Muetze1