GetDeviceContext (Delphi)

Description

The GetFormImage allows you to easily obtain a bitmap of a form. The following method can be added to a custom TWinControl descendant to save itself as a bitmap. Check the produced BMP file to confirm. Click the button and then double-click the newly created foo.bmp file to view.

Code

type
  TMyControl = class(TColorListBox)
    procedure SaveAsBmp(fileName: TFileName);
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MyControl1: TMyControl;
implementation
 
{$R *.dfm}
 
type
  LogPal = record
  lpal : TLogPalette;
  dummy:Array[0..255] of TPaletteEntry;
  end;  
 
procedure TMyControl.SaveAsBmp(fileName: TFileName);
var
  Source: TComponent;
  SysPal : LogPal;
  tempCanvas: TCanvas;
  sourceRect, destRect: TRect;
  image2save: TImage;
  notUsed: HWND;
begin
  tempCanvas := TCanvas.Create;
  try
    tempCanvas.Handle := GetDeviceContext(notUsed);
    image2save:=TImage.create(self);
    try
      with image2save do
      begin
        Height := Self.Height;
        Width :=  Self.Width;
        destRect := Rect(0,0,Width,Height);
        sourceRect := destRect;
        Canvas.CopyRect(destRect,tempCanvas,sourceRect);
        SysPal.lPal.palVersion:=$300;
        SysPal.lPal.palNumEntries:=256;
        GetSystemPaletteEntries(
          tempCanvas.Handle,0,256,SysPal.lpal.palPalEntry);
        Picture.Bitmap.Palette:= CreatePalette(Syspal.lpal);
      end;
      image2save.Picture.SaveToFile(fileName);
    finally
     image2save.Free;
    end;
  finally
    tempCanvas.Free;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  MyControl1.SaveAsBmp('foo.bmp');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyControl1:= TMyControl.Create(Form1);
  MyControl1.Parent:= Form1;
  MyControl1.visible := true;
end;

Uses

• Vcl.Graphics.TCanvas.Create ( fr | de | ja )
• Vcl.Controls.TWinControl.GetDeviceContext ( fr | de | ja )
• Vcl.Controls.TControl.GetDeviceContext ( fr | de | ja )
• Vcl.Graphics.TCanvas.Handle ( fr | de | ja )
• Vcl.Graphics.TGraphic.Palette ( fr | de | ja )