?
Solved

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

Posted on 2005-03-01
8
Medium Priority
?
572 Views
Last Modified: 2012-05-05
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
Comment
Question by:Ashok
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
8 Comments
 
LVL 10

Accepted Solution

by:
Jacco earned 500 total points
ID: 13432873
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
 
LVL 10

Expert Comment

by:Jacco
ID: 13432987
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
 
LVL 13

Author Comment

by:Ashok
ID: 13433083
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 13

Author Comment

by:Ashok
ID: 13433093
So where is CaptureWindow ?  Is it Windows API ?  I do not think so.

Thanks,
Ashok
0
 
LVL 13

Expert Comment

by:BlackTigerX
ID: 13433109
CaptureWindow is the first function he wrote for you... you need to put both functions in your code
0
 
LVL 13

Author Comment

by:Ashok
ID: 13434819
OK I got it.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 13434868
Thanks BlackTigerX :-) I was busy coding another solution (this machine has no Email so no ding-dong ;-)
0
 
LVL 13

Author Comment

by:Ashok
ID: 13435201
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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses
Course of the Month15 days, 8 hours left to enroll

741 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question