AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Picture im TImage negativ darstellen?

Picture im TImage negativ darstellen?

Ein Thema von smart · begonnen am 15. Feb 2005 · letzter Beitrag vom 16. Feb 2005
Antwort Antwort
Benutzerbild von smart
smart

Registriert seit: 19. Dez 2004
Ort: Bochum
1.266 Beiträge
 
Delphi 2007 Professional
 
#1

Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 17:31
Wie kann man ein Picture im TImage negativ darstellen?
Heike Kretschmann
  Mit Zitat antworten Zitat
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 17:40
Vielleicht gibt dir das einen Denkanstoß: Code aus der Code-Library
  Mit Zitat antworten Zitat
Benutzerbild von Khabarakh
Khabarakh

Registriert seit: 18. Aug 2004
Ort: Brackenheim VS08 Pro
2.876 Beiträge
 
#3

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 17:45
[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)
Sebastian
Moderator in der EE
  Mit Zitat antworten Zitat
Benutzerbild von smart
smart

Registriert seit: 19. Dez 2004
Ort: Bochum
1.266 Beiträge
 
Delphi 2007 Professional
 
#4

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 17:52
Vielen Dank für Eure Antworten. Bin mit Canvas.Pixels weiter gekommen.
Heike Kretschmann
  Mit Zitat antworten Zitat
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#5

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 18:07
Äh, für jeden Pixel einzelnd oder wie meint ihr das jetzt?
  Mit Zitat antworten Zitat
Benutzerbild von Binärbaum
Binärbaum

Registriert seit: 19. Jan 2005
Ort: Elstra
764 Beiträge
 
Delphi 7 Enterprise
 
#6

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 18:55
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
There are exactly 10 kinds of people: those who understand binary, and those who don't.
---
"Software reift beim Kunden. Bei Hardware ist es anders: Hardware fault beim Kunden." - Rainer G. Spallek
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#7

Re: Picture im TImage negativ darstellen?

  Alt 15. Feb 2005, 23:48
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
  Mit Zitat antworten Zitat
Benutzerbild von smart
smart

Registriert seit: 19. Dez 2004
Ort: Bochum
1.266 Beiträge
 
Delphi 2007 Professional
 
#8

Re: Picture im TImage negativ darstellen?

  Alt 16. Feb 2005, 09:11
Kann man Deinen Code auch Icons?
Heike Kretschmann
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#9

Re: Picture im TImage negativ darstellen?

  Alt 16. Feb 2005, 17:49
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:40 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz