Month: April 2007

This code does not look like it was mine originally, but I found it in a stray file on my hard drive.  I decided I didn’t want to lose it. 

 It takes a picture of any component you pass in and populates a TBitmap with an image using a custom palette built from device context of the component you are capturing.

[Delphi] 

{******************************************************************************
  ComponentToImg
 ******************************************************************************}
procedure TForm1.ComponentToImg(CHandle: HWND; x: Integer; y: Integer; Width: Integer; Height: Integer; bm: TBitMap);
var
  dc: HDC;
  lpPal : PLOGPALETTE;
begin // ComponentToImg
  // Test width and height
  if ((Width = 0) OR (Height = 0)) then exit;
  bm.Width := Width;
  bm.Height := Height;

  // Get the screen dc
  dc := GetDc(CHandle);
try
// If the device doesn’t have a handle, we can’t do anything with it.
  if (dc = 0) then exit;
  // Do we have a palette device?
  if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE)
  then begin
    // If so, allocate memory for a logical palette
    GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
     try
        // Zero it out to be neat
        FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
        // Fill in the palette version
        lpPal^.palVersion := $300;
        // Grab the system palette entries
        lpPal^.palNumEntries :=GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
        // Create the palette
        if (lpPal^.PalNumEntries <> 0) then bm.Palette := CreatePalette(lpPal^);
      finally
        FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
      end;
  end;
  // Copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);

  // Release the screen dc no matter what happened above.
finally
  ReleaseDc(0, dc);
end
end;  // ComponentToImg

procedure TForm1.Button1Click(Sender: TObject);
begin
  ComponentToImg(self.Handle, 0, 0, 800, 600, Image1.Picture.Bitmap);
end;
[/Delphi]