Never been to TextSnippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)

About this user

« Newer Snippets
Older Snippets »
7 total  XML / RSS feed 

Zmiana wartości RGB z blokadą przepełnienia

procedure ChangeRGB(var Bitmap:TBitmap;R,G,B:integer);
var
H,V:integer;
DstRow:^TRGBTriple; // to jest wskaźnik dopixela
begin
 Bitmap.PixelFormat:=pf24bit;
 for V:=0 to Bitmap.Height -1 do
  begin
      DstRow:=Bitmap.ScanLine[V];
      for H:=0 to Bitmap.Width -1 do
      begin
      DstRow^:=ChangeRGBColor(DStrow^,R,G,B);
       Inc(DstRow);
     end;
  end;
end;

Color Noise

procedure ColorNoise( Bitmap: TBitmap; Amount: Integer);
var
WSK:^Byte;
H,V,a: Integer;
begin
Bitmap.PixelFormat:=pf24bit;
  for V:=0 to Bitmap.Height-1 do
  begin
    Wsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width*3-1 do
    begin
    Wsk^:=IntToByte(Wsk^+(Random(Amount)-(Amount shr 1)));
      inc(Wsk);
    end;
  end;
end;

Negative

procedure Negative(var Bitmap:TBitmap);
var
H,V:Integer;
WskByte:^Byte; //Wskaźnik do Bajta (nie trzeba do całego pixela bo i tak wszystko odwracamy)
begin
Bitmap.PixelFormat:=pf24bit;
for V:=0 to Bitmap.Height-1 do
  begin
    WskByte:=Bitmap.ScanLine[V]; // V jest to pozycja  danej linii bitmapy (od góry )
    for  H:=0 to (Bitmap.Width *3)-1 do
    begin
      WskByte^:= not WskByte^ ;// (odwracamy wartość na którą pokazuje wskaźnik)
      inc(WskByte);//Przesuwam wskaźnik
    end;
  end;
end;

Saturation

procedure Saturation(var  Bitmap: TBitmap; Amount: Integer);
var
Wsk:^TRGBTriple;
Gray,H,V: Integer;
begin
  for V:=0 to Bitmap.Height-1 do
  begin
    Wsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width-1 do
    begin

    Gray:=(Wsk.rgbtBlue+Wsk.rgbtGreen+Wsk.rgbtRed)div 3;
    Wsk.rgbtRed:=IntToByte(Gray+(((Wsk.rgbtRed-Gray)*Amount)div 255));
    Wsk.rgbtGreen:=IntToByte(Gray+(((Wsk.rgbtGreen-Gray)*Amount)div 255));
    Wsk.rgbtBlue:=IntToByte(Gray+(((Wsk.rgbtBlue-Gray)*Amount)div 255));
    inc(Wsk);
    end;
  end;
end;

Kontrast

procedure Contrast(var Bitmap:TBitmap; Amount: Integer);
var
ByteWsk:^Byte;
H,V:  Integer;
begin
  for V:=0 to Bitmap.Height-1 do
  begin
    ByteWsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width*3 -1  do
    begin
      if ByteWsk^>127 then
      ByteWsk^:=IntToByte(ByteWsk^+(Abs(127-ByteWsk^)*Amount)div 255)
      else ByteWsk^:=IntToByte(ByteWsk^-(Abs(127-ByteWsk^)*Amount)div 255);
      Inc(ByteWsk);
    end;
  end;
end;

ColorToTriple

Funkcja zamienia wartość TColor na TRGBTriple.

function ColorToTriple(Color:TColor):TRGBTriple;
type
Rec=Record
Case TColor of
1:( ColorValue:TColor );
2:(Bytes: array [0..3] of Byte);
end;
var
Col:Rec;
begin
Col.ColorValue:= Color;

Result.rgbtRed :=Col.Bytes[0];
Result.rgbtGreen :=Col.Bytes[1];
Result.rgbtBlue :=Col.Bytes[2];
end ;

ChangeRGBColor

function ChangeRGBColor(color:TRGBTriple;R,G,B:integer):TRGBTriple;
begin

if  B+Color.rgbtBlue >255 then Color.rgbtBlue :=255 else
if  B+Color.rgbtBlue <0 then  Color.rgbtBlue :=0 else
inc(Color.rgbtBlue,B) ;


if  G+Color.rgbtGreen >255 then Color.rgbtGreen :=255 else
if  G+Color.rgbtGreen <0 then  Color.rgbtGreen :=0 else
inc(Color.rgbtGreen,G) ;

if  R+Color.rgbtRed >255 then Color.rgbtRed :=255 else
if  R+Color.rgbtRed <0 then  Color.rgbtRed :=0 else
inc(Color.rgbtRed,R) ;
Result:=Color;

end;
« Newer Snippets
Older Snippets »
7 total  XML / RSS feed