ActiveX.Image -> Buffer --> TBitmap

[cylor]

Guten Morgen! Nach einer kleinen Korrektur funktioniert es... fast. Vielen Dank!

Delphi-Quellcode:

var
  bmp: TBitmap;
  pBuffer: Pointer;

const
  ueye_ImgWidth   = 1024;
  ueye_ImgHeight  = 768;
  ueye_BufferSize = ueye_ImgWidth * ueye_ImgHeight * 1;

procedure TF_Cam.Timer1Timer(Sender: TObject);
begin
   GetMem(pBuffer, ueye_BufferSize);
   try
      uEyeCam1.CopyImage(Cardinal(pBuffer), ueye_BufferSize);
      bmp := TBitmap.Create;
      try
         bmp.Width := ueye_ImgWidth;
         bmp.Height := ueye_ImgHeight;
         bmp.PixelFormat := pf8Bit;

         Move(pBuffer^, bmp.Scanline[bmp.Height-1]^, ueye_BufferSize);

         BitBlt(F_Cam.Canvas.Handle, 0, 0, ueye_ImgWidth, ueye_ImgHeight, bmp.Canvas.Handle, 0, 0, SRCCOPY);
      finally
         bmp.Free;
      end;
   finally
      FreeMem(pBuffer);
   end;
end;

Nur leider stimmt die Palette nicht. Aus dem Grayscale wird ein lustige Ansammlung von Farben. ^^

[Klaus01]

Guten Morgen,

schau mal hier: BitMapToGraqyScale

Grüße
Klaus

[cylor]

Da beim JPEG Informationen verloren gehen hab ich das jetzt so gelöst:

Delphi-Quellcode:

type
  TLogPal = record
    lpal : TLogPalette;
    colorSpace : Array[0..255] of TPaletteEntry;
  end;

var
  bmp: TBitmap;
  pBuffer: Pointer;
  pal : TLogPal;  
  iCount : integer;  

const
  ueye_ImgWidth   = 1024;
  ueye_ImgHeight  = 768;
  ueye_BufferSize = ueye_ImgWidth * ueye_ImgHeight * 1;

procedure TF_Cam.Timer1Timer(Sender: TObject);
begin
   // Create a 256 gray-scale palette
   pal.lpal.palVersion:=$300;
   pal.lpal.palNumEntries := 256;
   for iCount := 0 to 255 do
      with pal.lpal.palPalEntry[iCount] do
      begin
         peRed := iCount;
         peGreen := iCount;
         peBlue := iCount;
      end;

   GetMem(pBuffer, ueye_BufferSize);
   try
      uEyeCam1.CopyImage(Cardinal(pBuffer), ueye_BufferSize);
      bmp := TBitmap.Create;
      try
         bmp.Width := ueye_ImgWidth;
         bmp.Height := ueye_ImgHeight;
         bmp.PixelFormat := pf8Bit;

         Move(pBuffer^, bmp.Scanline[bmp.Height-1]^, ueye_BufferSize);
         bmp.Palette := CreatePalette(pal.lpal);
         BitBlt(F_Cam.Canvas.Handle, 0, 0, ueye_ImgWidth, ueye_ImgHeight, bmp.Canvas.Handle, 0, 0, SRCCOPY);
      finally
         bmp.Free;
      end;
   finally
      FreeMem(pBuffer);
   end;
end;

Allerdings kommt dabei folgendes raus.