AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Farbwert zu Dezimal

Ein Thema von EWeiss · begonnen am 28. Mär 2019 · letzter Beitrag vom 3. Apr 2019
 
Klaus01

Registriert seit: 30. Nov 2005
Ort: München
5.779 Beiträge
 
Delphi 10.4 Sydney
 
#26

AW: Farbwert zu Dezimal

  Alt 29. Mär 2019, 07:50
.. ein Versuch:
Delphi-Quellcode:
var
  imgSpectrum: Array[0..9,0..9] of Integer;
  h,w: Integer;
  x, dx ,y, dy: Integer;
  c,d,red,green,blue: Integer;
  alpha: Integer;

  fade: Integer;
  mEffect: Byte;
begin
  try
    h := 9;
    w := 9;
    case mEffect of
      0: begin
           d := fade * 255;
           for y:= 0 to h do
             for x := 0 to w do
               begin
                 alpha := ((imgSpectrum[x,y] and $FF000000) shr 24) and $FF;
                 alpha := alpha - d;
                 if alpha < 0 then
                   alpha := 0;
                 c := imgSpectrum[x,y] and $FFFFFF;
                 if alpha > 127 then
                   imgSpectrum[x,y] := c or ((alpha -256) shl 24)
                 else
                   imgSpectrum[x,y] := c or (alpha shl 24);
               end;
         end;
      1: begin
            d:= fade * 10;
            for y := 0 to h do
              for x := 0 to w do
                begin
                  if (x > 0) and (y > 0) and (x < (w-1)) and (y < (h -1))then
                    begin
                      red := 0;
                      green := 0;
                      blue := 0;
                      alpha := 0;
                      for dy := -1 to 1 do
                        for dx := -1 to 1 do
                          begin
                            c := imgSpectrum[x+dx,y+dy];
                            alpha := (((c and $FF000000) shr 24) and $FF) + cardinal(alpha);

                            red := red + ((c and $FF0000) shr 16);
                            green := green + (( c and $FF00) shr 8);
                            blue := blue + (c and $FF);
                          end;
                      red := red div 9;
                      green := green div 9;
                      blue := blue div 9;
                      alpha := (alpha div 9) - d
                      if alpha < 0 then
                        alpha := 0;
                      c := blue or ( green shl 8) or (red shl 16);
                      if alpha > 127 then
                        imgSpectrum[x,y] := c or ((alpha -256) shl 24)
                      else
                        imgSpectrum[x,y] := c or (alpha shl 24); end;
                end;

         end;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
Grüße
Klaus
Klaus

Geändert von Klaus01 (29. Mär 2019 um 09:35 Uhr)
  Mit Zitat antworten Zitat
 


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 20:03 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz