DUzun's Web
Programare, proiecte personale, divertisment

{****************************************************

 * Author  : Dumitru Uzun (DUzun)

 * Web     : http://duzun.teologie.net

 * Created : 29.01.2009

 *

 *  Modul pentru prelucratea Bitmap-urilor la nivel de pixel.

 *

 *

 * Istorie:

 * - 06.06.2009

 *   Am adaugat MulColor, pentru obtinerea intensitatii dorite a culorii

 *

 ****************************************************}

​

{-----------------------------------------------------------------}

Unit UGraph;

​

interface

uses Graphics, ExtCtrls;

​

{-----------------------------------------------------------------}

type

   TDrowMode = (dNIL ,dXOR, dOR, dAND, dINTENS);

   TRGBPack  = packed array[0..3] of Byte; // PixelFormat = 24

   PRGBPack = ^TRGBPack;

​

{-----------------------------------------------------------------}

function  GetBMP(var Dst: TBitmap; Src: TGraphic; PixelFmt: TPixelFormat = pf24bit): boolean;

function  PixelCount(Bmp: TBitmap): byte;

function  RGB(r, g, b: Byte): TColor;

Procedure RGBSplit(Color: TColor; var r, g, b: Byte);

function  MulColor(Color: TColor; Num: Real): TColor;

​

Function ReadRGB (P: Pointer; bits: byte=8): TRGBPack;

Function WriteRGB(C: TRGBPack; P: Pointer; bits: byte=8): Integer; Overload;

Function WriteRGB(C: TColor; P: Pointer; bits: byte=8): Integer;   Overload;

​

{-----------------------------------------------------------------}

implementation

{-----------------------------------------------------------------}

Function ReadRGB(P: Pointer; bits: byte=8): TRGBPack;

var i: Integer;

    m: Integer;

begin

  m := 1 shl bits - 1;

  i := PInteger(P)^;

  Result[0] := i and m;

  Result[1] := i shr bits and m;

  Result[2] := i shr (bits shl 1) and m;

end;

{-----------------------------------------------------------------}

Function WriteRGB(C: TColor; P: Pointer; bits: byte=8): Integer;   Overload;

begin Result := WriteRGB(TRGBPack(C), P, bits); end;

{-----------------------------------------------------------------}

Function WriteRGB(C: TRGBPack; P: Pointer; bits: byte=8): Integer; Overload;

begin

  Result := C[0] or (C[1] shl bits) or (C[2] shl (bits shl 1));

  inc(bits, (bits shl 1)); {bits := 3*bits}

  if bits > 24 then PLongInt(P)^ := Result else

  if bits > 16 then begin

      PWord(P)^ := Result;

      PRGBPack(P)^[2] := TRGBPack(Result)[2];

  end else

  if bits >  8 then PWord(P)^ := Result else

                    PByte(P)^ := Result;

end; 

{-----------------------------------------------------------------}

function RGB;

begin

   TRGBPack(Result)[0] := r;

   TRGBPack(Result)[1] := g;

   TRGBPack(Result)[2] := b;

//    Result := (r or (g shl 8) or (b shl 16));

end;

{-----------------------------------------------------------------}

Procedure RGBSplit(Color: TColor; var r, g, b: Byte);

begin

    r := TRGBPack(Color)[0];

    g := TRGBPack(Color)[1];

    b := TRGBPack(Color)[2];

end;

{-----------------------------------------------------------------}

function MulColor(Color: TColor; Num: Real): TColor;

var r,g,b: byte;

begin

  TRGBPack(Result)[0] := Trunc(TRGBPack(Color)[0]*Num);

  TRGBPack(Result)[1] := Trunc(TRGBPack(Color)[1]*Num);

  TRGBPack(Result)[2] := Trunc(TRGBPack(Color)[2]*Num);

end;

{-----------------------------------------------------------------}

function  PixelCount(Bmp: TBitmap): byte;

begin

  Result := 0;

  if Bmp <> nil then

  case Bmp.PixelFormat of

    pf1bit : Result := 1; 

    pf4bit : Result := 4;

    pf8bit : Result := 8;

    pf15bit: Result := 15;

    pf16bit: Result := 16;

    pf24bit: Result := 24;  

    pf32bit: Result := 32;

  end;  

end;

{-----------------------------------------------------------------}

function GetBMP;

begin

  Result := false;

  if Dst = nil then Dst := TBitmap.Create;

  try

    Dst.Assign(Src);

    Result := true;

  finally

    Dst.PixelFormat := PixelFmt;

  end;

end;

{-----------------------------------------------------------------}

begin

​

end.

​

​