Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 587
  • Last Modified:

Convert VB source code to Delphi (it is using Windows API)

For VB/Delphi expert....

         Public Function CaptureWindow(ByVal hWndSrc As Long, _
            ByVal Client As Boolean, ByVal LeftSrc As Long, _
            ByVal TopSrc As Long, ByVal WidthSrc As Long, _
            ByVal HeightSrc As Long) As Picture

            Dim hDCMemory As Long
            Dim hBmp As Long
            Dim hBmpPrev As Long
            Dim r As Long
            Dim hDCSrc As Long
            Dim hPal As Long
            Dim hPalPrev As Long
            Dim RasterCapsScrn As Long
            Dim HasPaletteScrn As Long
            Dim PaletteSizeScrn As Long
            Dim LogPal As LOGPALETTE

         ' Depending on the value of Client get the proper device context.
         If Client Then
            hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
         Else
            hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire
                                          ' window.
         End If

         ' Create a memory device context for the copy process.
         hDCMemory = CreateCompatibleDC(hDCSrc)
         ' Create a bitmap and place it in the memory DC.
         hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
         hBmpPrev = SelectObject(hDCMemory, hBmp)

         ' Get screen properties.
         RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
                                                            ' capabilities.
         HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette
                                                              ' support.
         PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
                                                              ' palette.

         ' If the screen has a palette make a copy and realize it.
         If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            ' Create a copy of the system palette.
            LogPal.palVersion = &H300
            LogPal.palNumEntries = 256
            r = GetSystemPaletteEntries(hDCSrc, 0, 256, _
                LogPal.palPalEntry(0))
            hPal = CreatePalette(LogPal)
            ' Select the new palette into the memory DC and realize it.
            hPalPrev = SelectPalette(hDCMemory, hPal, 0)
            r = RealizePalette(hDCMemory)
         End If

         ' Copy the on-screen image into the memory DC.
         r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
            LeftSrc, TopSrc, vbSrcCopy)

      ' Remove the new copy of the  on-screen image.
         hBmp = SelectObject(hDCMemory, hBmpPrev)

         ' If the screen has a palette get back the palette that was
         ' selected in previously.
         If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            hPal = SelectPalette(hDCMemory, hPalPrev, 0)
         End If

         ' Release the device context resources back to the system.
         r = DeleteDC(hDCMemory)
         r = ReleaseDC(hWndSrc, hDCSrc)

         ' Call CreateBitmapPicture to create a picture object from the
         ' bitmap and palette handles. Then return the resulting picture
         ' object.
         Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
      End Function

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureForm
      '    - Captures an entire form including title bar and border.
      '
      ' frmSrc
      '    - The Form object to capture.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the entire
      '      form.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureForm(frmSrc As Form) As Picture
         ' Call CaptureWindow to capture the entire form given its window
         ' handle and then return the resulting Picture object.
         Set CaptureForm = CaptureWindow(frmSrc.hWnd, False, 0, 0, _
            frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), _
            frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
      End Function
0
Ashok
Asked:
Ashok
  • 4
  • 3
1 Solution
 
JaccoCommented:
Hi Ashok,

Here is the first function:

function CaptureWindow(const hWndSrc: HWND; const Client: Boolean; const LeftSrc, TopSrc, WidthSrc, HeightSrc: Integer): TBitmap;
var
  hDCMemory: HDC;
  hBmp: HBITMAP;
  hBmpPrev: HBITMAP;
  hDCSrc: HWND;
  RasterCapsScrn, PaletteSizeScrn: Integer;
  HasPaletteScrn: Boolean;
  LogPal: TMaxLogPalette;
  r: Integer;
  hPal, hPalPrev: HPALETTE;
begin
  // Depending on the value of Client get the proper device context.
  if Client then
    hDCSrc := GetDC(hWndSrc)        // Get device context for client area.
  else
    hDCSrc := GetWindowDC(hWndSrc); // Get device context for entire window.
  // Create a memory device context for the copy process.
  hDCMemory := CreateCompatibleDC(hDCSrc);
  // Create a bitmap and place it in the memory DC.
  hBmp := CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc);
  hBmpPrev := SelectObject(hDCMemory, hBmp);
  // Get screen properties.
  RasterCapsScrn  := GetDeviceCaps(hDCSrc, RASTERCAPS); // Raster capabilities.
  HasPaletteScrn  := RasterCapsScrn and RC_PALETTE <> 0;     // Palette support.
  PaletteSizeScrn := GetDeviceCaps(hDCSrc, SIZEPALETTE); // Size of palette.
  // If the screen has a palette make a copy and realize it.
  if HasPaletteScrn and (PaletteSizeScrn = 256) then
  begin
    // Create a copy of the system palette.
    LogPal.palVersion := $300;
    LogPal.palNumEntries := 256;
    r := GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry[0]);
    hPal := CreatePalette(PLogPalette(@LogPal)^);
    // Select the new palette into the memory DC and realize it.
    hPalPrev := SelectPalette(hDCMemory, hPal, False);
    r := RealizePalette(hDCMemory);
  end;
  // Copy the on-screen image into the memory DC.
  BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, SRCCOPY);
  // Remove the new copy of the  on-screen image.
  hBmp := SelectObject(hDCMemory, hBmpPrev);
  // If the screen has a palette get back the palette that was selected in previously.
  if HasPaletteScrn and (PaletteSizeScrn = 256) then
    hPal := SelectPalette(hDCMemory, hPalPrev, False);
  // Release the device context resources back to the system.
  DeleteDC(hDCMemory);
  ReleaseDC(hWndSrc, hDCSrc);
  // Call CreateBitmapPicture to create a picture object from the
  // bitmap and palette handles. Then return the resulting picture
  // object.
  Result := TBitmap.Create;
  Result.Handle := hBmp;
  Result.Palette := hPal;
end;

In an application with a TButton and a TImage you can use it like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Graphic := CaptureWindow(Self.Handle, True, 0, 0, Width, Height);
end;

Regards Jacco
0
 
JaccoCommented:
Here is the second one:

function CaptureForm(frmSrc: TForm): TBitmap;
begin
  // Call CaptureWindow to capture the entire form given its window
  // handle and then return the resulting Picture object.
  Result := CaptureWindow(frmSrc.Handle, False, 0, 0, frmSrc.Width, frmSrc.Height);
end;

Don't forget to put Windows, Graphics and Forms in the uses clause of the unit.

The function creates a bitmap which you have to destroy yourself!

Regards Jacco
0
 
AshokAuthor Commented:
Jacco

I get Undeclared identifier: 'CaptureWindow'
I am using Delphi 7.

Following first few lines are from my unit in which I tried your function.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

As you said, I have Windows, Graphics & Forms.

Ashok
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
AshokAuthor Commented:
So where is CaptureWindow ?  Is it Windows API ?  I do not think so.

Thanks,
Ashok
0
 
BlackTigerXCommented:
CaptureWindow is the first function he wrote for you... you need to put both functions in your code
0
 
AshokAuthor Commented:
OK I got it.
0
 
JaccoCommented:
Thanks BlackTigerX :-) I was busy coding another solution (this machine has no Email so no ding-dong ;-)
0
 
AshokAuthor Commented:
I was hoping to use this code which I found from MSDN site to use
inf Delphi so that it could capture inactive (also minimized) window,
but it is not working as I expected.

When a window is minimized, it gives blank canvas.
When the window is active but Task Manager on top (using Stay on top), it gives
window image with Task Manager window.
I wanted only the actual window's image.

Can this be done any other way?

Thanks,
Ashok
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now