DIB render with Delphi

Started by
-1 comments, last by CrzyRed 19 years, 5 months ago
Hi ALL, I'm using Delphi 6.0 under Windows XP Home Edition and want to render a OpenGL scene to a DIB and then, save it to a file or send it to a printer. I've tried the code below, but get stuck at the line "if not SetPixelFormat(hMemDC, FormatIndex, @pfd) then" because the SetPixelFormat function fail. Can anyone help me or even show me a better way to do this? []'s Luiz

procedure TForm1.Blah;
var
  hMemRC, hOldRC: HGLRC;
  FormatIndex: Integer;
  pfd: TPixelFormatDescriptor;
  poBits: Pointer;
  rctAux: TRect;
  dbRatio: Double;
  ptPrn, ptDIB: TPoint;
  bmpAux: TBitmap;
  bmiAux: BITMAPINFO;
  hhDc, hDIB, hMemDC, hOldDc: HDC;
begin
  // 1. Determine the DIB size
  rctAux := pnlDraw.BoundsRect;

  with rctAux do
    dbRatio := (Bottom - Top) / (Right - Left);

  ptPrn := Point(GetDeviceCaps(Printer.Handle, HORZRES),
    GetDeviceCaps(Printer.Handle, VERTRES));

  if ptPrn.Y > (dbRatio * ptPrn.X) then
    ptDIB := Point(ptPrn.X, Trunc(dbRatio * ptPrn.X))
  else
    ptDIB := Point(Trunc(ptPrn.Y / dbRatio), ptPrn.Y);

  while (ptDIB.X * ptDIB.Y) > 20E6 do
    ptDIB := Point(ptDIB.X div 02, ptDIB.Y div 02);

  //ShowMessage(Format('%d x %d = %6.2f MB', [ptDib.X, ptDib.Y,
    //ptDIB.X * ptDIB.Y / (1024 * 1024)]));

  // 2. Create the DIB section
  with bmiAux.bmiHeader do
  begin
    biSize := SizeOf(BITMAPINFOHEADER);
    biWidth := ptDIB.X;
    biHeight := ptDIB.Y;
    biPlanes := 01;
    biBitCount := 24;
    biCompression := BI_RGB;
    biSizeImage := 03 * ptDIB.X * ptDIB.Y
  end;

  hhDC := GetDC(pnlDraw.Handle);

  hDIB := CreateDIBSection(hhDc, bmiAux, DIB_RGB_COLORS, poBits, 00, 00);

  ReleaseDC(pnlDraw.Handle, hhDc);

  // 3. Create memory DC and associate it with the DIB
  hMemDC := CreateCompatibleDC(00);

  if hMemDC = 00 then
  begin
    DeleteObject(hMemDC);

    hMemDC := 00;

    Exit
  end;

  SelectObject(hMemDC, hDIB);

  // 4. Setup memory DC's pixel
  FillChar(pfd, SizeOf(pfd), 00);

  with pfd do
  begin
    nSize := SizeOf(pfd);
    nVersion := 1;
    dwFlags := PFD_DRAW_TO_BITMAP or PFD_SUPPORT_OPENGL or
               PFD_STEREO_DONTCARE;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 32; // support 24-bit color
    cDepthBits := 16; // depth of z-axis
    iLayerType := PFD_MAIN_PLANE;
  end;

  FormatIndex := ChoosePixelFormat(hMemDC, @pfd);

  if not SetPixelFormat(hMemDC, FormatIndex, @pfd) then
  begin
    DeleteObject(hDIB);
    hDIB := 00;
    DeleteDC(hMemDC);
    hMemDC := 00;

    Exit
  end;

  // 5. Create memory RC
  hMemRC := wglCreateContext(hMemDC);

  if hMemRC = 00 then
  begin
    DeleteObject(hDIB);
    hDIB := 00;
    DeleteDC(hMemDC);
    hMemDC := 00;

    Exit
  end;

  // 6. Store old DC and RC
  hOldDc := wglGetCurrentDC;
  hOldRC := wglGetCurrentContext;

  // 7. Make the memory RC current
  wglMakeCurrent(hMemDC, hMemRC);

  // 8. Set OpenGL state for memory RC
  glClearColor(1.0, 1.0, 1.0, 0.0);

  glMatrixMode(GL_PROJECTION);

  glOrtho(-DB_LIM, DB_LIM, -DB_LIM, DB_LIM, -DB_LIM, DB_LIM);

  glEnable(GL_DEPTH_TEST);

  glMatrixMode(GL_MODELVIEW);

  glLoadIdentity;

  glViewport(00, 00, ptDIB.X, ptDIB.Y);

  // 9. Draw the scene
  mp_pglDraw;

  // 10. Release memory RC and restore the old DC and RC
  wglMakeCurrent(00, 00);
  wglDeleteContext(hMemRC);
  wglMakeCurrent(hOldDc, hOldRC);

  // 11. Copy and save the image
  bmpAux := TBitmap.Create;
  bmpAux.Width := ptDIB.X;
  bmpAux.Height := ptDIB.Y;

  StretchDIBits(bmpAux.Canvas.Handle, 00, 00, bmpAux.Width, bmpAux.Height,
    00, 00, bmiAux.bmiHeader.biWidth, bmiAux.bmiHeader.biHeight, poBits, bmiAux,
    DIB_RGB_COLORS, SRCCOPY);

  bmpAux.SaveToFile('A.bmp');

  // 12. Release memory
  DeleteObject(hDIB);
  hDIB := 00;
  DeleteDC(hMemDC);
  hMemDC := 00;
  hOldDc := 00
end;

This topic is closed to new replies.

Advertisement