Прочитать три байта

type
 FArrLw=Array[0..2047] of LongWord;
 PArrLw=^FArrLw;
var
 Bm:TBitMap;
 ArrRCM:Array[0..1] of LongWord;
procedure DoReplace(Bm:TBitmap);
  var
   cyc1,cyc2:LongInt;
   psl:PArrLw;
 begin
  if Bm.PixelFormat<>pf32bit then
   Exit;
  for cyc2:=0 to Bm.Height-1 do
   begin
    psl:=Bm.ScanLine[cyc2];
    for cyc1:=0 to Bm.Width-1 do
     psl[cyc1]:=ArrRCM[psl[cyc1] mod 2];
   end;;
 end;
procedure TForm1.FormCreate(Sender:TObject);
 begin
  Bm:=TBitmap.Create;
  Bm.PixelFormat:=pf32bit;
  begin //Для примера
   Bm.SetSize(100,100);
   ArrRCM[0]:=Random($FFFFFF);
   ArrRCM[1]:=Random($FFFFFF);
   BitBlt(Bm.Canvas.Handle,0,0,100,100,GetDC(0),0,0,SRCCOPY);
  end;
  DoReplace(Bm);
  Form1.Image1.Picture.Assign(Bm);
 end;

 FArrLw=Array[0..2047] of 0..$FFFFFF;
 ArrRCM:Array[0..1] of 0..$FFFFFF;

psl[cyc1]:=ArrRCol[psl[cyc1] and $FFFFFF]; //ArrRCol:Array[0..$FFFFFF] of LongWord;

procedure DoConvert(Bm:TBitmap);
  var cyc1,cyc2,lw,pp:LongWord;
 begin
  lw:=0;
  for cyc2:=0 to Bm.Height-1 do
   begin
    pp:=LongWord(Bm.ScanLine[cyc2]);
    for cyc1:=0 to Bm.Width-1 do
     begin
      CopyMemory(@lw,Pointer(pp+cyc1*3),3);
      CopyMemory(Pointer(pp+cyc1*3),@ArrRCol[lw],3);
     end;
   end;
 end;

 procedure CopyMemory(Destination:Pointer;Source:Pointer;Length:NativeUInt);
  begin
   move(Source^,Destination^,Length);
  end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Jpeg;
 
type
  TMyRGB = packed record // Это не сработало
    case integer of
    0: (B, G, R: byte);
    1: (dw: dword);
  end;
 
  TForm1 = class(TForm)
    btn24bit: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    btn32bit: TButton;
    btnStop: TButton;
    PaintBox1: TPaintBox;
    procedure btn24bitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btn32bitClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    ArrRCol: array of TColor;
    ArrRCol24: array of TRGBTriple;
    bmPic24, bmPic32, bmView: TBitmap;
    fps: integer;
    UsrStop: boolean;
  public
    { Public declarations }
  end;
 
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..0] of TRGBTriple;
  PDWORDArray = ^TDWORDArray;
  TDWORDArray = array[0..0] of DWORD;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure LoadPicture(bmap: TBitmap; FileName: string);
var
  pic: TPicture;
begin
  pic := TPicture.Create;
  try
    pic.LoadFromFile(FileName);
    bmap.Width  := pic.Width ;
    bmap.Height := pic.Height;
    bmap.Canvas.Draw(0, 0, pic.Graphic);
  finally
    pic.Free;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  SetLength(ArrRCol24, 256*256*256);
  for i := 0 to High(ArrRCol24) do begin
    ArrRCol24[i].rgbtBlue  := (High(ArrRCol24) - i       ) and $FF;
    ArrRCol24[i].rgbtGreen := (High(ArrRCol24) - i shr  8) and $FF;
    ArrRCol24[i].rgbtRed   := (High(ArrRCol24) - i shr 16) and $FF;
//    ArrRCol24[i].dw := High(ArrRCol24) - i;
  end;
 
  SetLength(ArrRCol, 256*256*256);
  for i := 0 to High(ArrRCol) do
    ArrRCol[i] := High(ArrRCol) - i;
 
  bmPic24 := TBitmap.Create;
  bmPic24.Width  := 2048;
  bmPic24.Height := 2048;
  bmPic24.PixelFormat := pf24bit;
  LoadPicture(bmPic24, ExtractFilePath(ParamStr(0)) + '1.jpg');
 
  bmPic32 := TBitmap.Create;
  bmPic32.Width  := 2048;
  bmPic32.Height := 2048;
  bmPic32.PixelFormat := pf32bit;
  LoadPicture(bmPic32, ExtractFilePath(ParamStr(0)) + '1.jpg');
 
  bmView := bmPic32;
  fps := 0;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(bmPic24);
  FreeAndNil(bmPic32);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := IntToStr(fps) + ' fps';
  fps := 0;
  PaintBox1.Canvas.Draw(0, 0, bmView);
end;
 
procedure TForm1.btn24bitClick(Sender: TObject);
var
  pLine: PRGBArray;
  x, y, w: integer;
  bst, bbpl, bh: integer;
begin
  //
  UsrStop := false;
  bmView := bmPic24;
  bst := integer(bmPic24.ScanLine[bmPic24.Height-1]);
  bbpl := (bmPic24.Width*3 + 3) and -4;
  bh := bmPic24.Height - 1;
  w := bmPic24.Width - 1;
  repeat
    for y := 0 to bmPic24.Height-1 do begin
      pLine := pointer(bst + (bh - y)*bbpl); // Так быстрее
//      pLine := bmPic24.ScanLine[y]; // Так медленнее
      for x := 0 to w do
        pLine^[x] := ArrRCol24[((pLine^[x].rgbtBlue) +
                                (pLine^[x].rgbtGreen shl 8) +
                                (pLine^[x].rgbtRed shl 16))];
    end;
    Inc(fps);
    Application.ProcessMessages;
  until UsrStop;
end;
 
procedure TForm1.btn32bitClick(Sender: TObject);
var
  pLine: PDWORDArray;
  x, y: integer;
  bst, bbpl, bh: integer;
begin
  //
  UsrStop := false;
  bmView := bmPic32;
  bst := integer(bmPic32.ScanLine[bmPic32.Height-1]);
  bbpl := (bmPic32.Width*4 + 3) and -4; // Выравнивание на 4 в большую сторону
  bh := bmPic32.Height - 1;
  repeat
    for y := 0 to bmPic32.Height-1 do begin
      pLine := pointer(bst + (bh - y)*bbpl); // Так быстрее
//      pLine := bmPic32.ScanLine[y]; // Тут заметно медленнее
      for x := 0 to bmPic32.Width-1 do
        pLine^[x] := ArrRCol[pLine^[x] and $00FFFFFF];
    end;
    Inc(fps);
    Application.ProcessMessages;
  until UsrStop;
end;
 
procedure TForm1.btnStopClick(Sender: TObject);
begin
  UsrStop := true;
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  UsrStop := true;
end;
 
end.

SetLength(ArrRCol,256*256*256);
for i:=0 to high(ArrRCol) do
 ArrRCol[i]:=high(ArrRCol)-i;

pLine^[x] := ArrRCol[pLine^[x] and $00FFFFFF];

pLine^[x] := (256*256*256-1) - pLine^[x];