Форум: "KOL";
Текущий архив: 2007.09.16;
Скачать: [xml.tar.bz2];

Вниз

How to convert this screenshot function ?   Найти похожие ветки 

← →
gok5   (2007-01-28 22:00) [0]

Hello everyone. Im just starting with KOL and I know almost nothing. I have a screenshot function that I was using with VCL and now I need to convert it to KOL .

Here is the code :

function CaptureScreen( ARect: TRect ) : TBitmap;
var
DC: HDC;
MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
Result := TBitmap.Create;
// Capture the Desktop screen
with Result, ARect do
begin
Width := Right - Left;
Height := Bottom - Top;
DC := GetDC( 0 );

try
BitBlt( Canvas.Handle, 0, 0, Width, Height, DC, 160, 359, SRCCOPY );

  // Create temp. Icon
  MyCursor := TIcon.Create;
  try
    // Retrieve Cursor info
    CursorInfo := GetCursorInfo2;
    if CursorInfo.hCursor <> 0 then
    begin
      MyCursor.Handle := CursorInfo.hCursor;
      // Get Hotspot information
      GetIconInfo(CursorInfo.hCursor, IconInfo);
      // Draw the Cursor on our bitmap
      Canvas.Draw(CursorInfo.ptScreenPos.X - 360,
                          CursorInfo.ptScreenPos.Y - 440 , MyCursor);
    end;
  finally
    // Clean up
    MyCursor.ReleaseHandle;
    MyCursor.Free;
  end;
finally
  ReleaseDC(0, DC);
end;
 Result := Result;
end;
end;

To take the pictures I was using :

Form1.Image1.Picture.Assign(CaptureScreen(Rect(360,440,730,769)));

I"d really appreciate any help!

Best Regards!!!
gok5

---

← →
Jon ©   (2007-01-29 04:05) [1]

Here is a previously posted KOL version courtsey of Thaddy:


unit KOLScreenShot;

interface

uses Windows, KOL;

function FullScreenShot(PixelFormat: TPixelFormat): PBitmap; //PixelFormat: pf32bit, pf24bit...

implementation

function FullScreenShot(PixelFormat: TPixelFormat): PBitmap;
var
 DC : HDC;
begin
DC := GetDC (GetDesktopWindow);
try
 Result:=NewDIBBitmap(
 GetDeviceCaps (DC, HORZRES),
 GetDeviceCaps (DC, VERTRES),
 PixelFormat);
 BitBlt(Result.Canvas.Handle,
        0,
        0,
        Result.Width,
        Result.Height,
        DC,
        0,
        0,
        SRCCOPY);
finally
 ReleaseDC (GetDesktopWindow, DC);
end;
end;

end.


To Thaddy - I hope that you don"t mind :-)

---

← →
gok5   (2007-01-29 04:54) [2]

Thanks Jon for helping and the code seems to be fine. My question now is, how can I assign this screenshot ? What component can I use of kol, since there is no "Image" component as there is on VCL ?

Best Regards!
gok5

---

← →
vampir_infernal   (2007-01-29 06:29) [3]

What about "PBitmap"?

---

← →
Jon ©   (2007-01-29 12:06) [4]

If you mean how to draw it on a Form - try PaintBox.
It"s a static control, so see its OnPaint property.

---

← →
gok5   (2007-01-29 19:14) [5]

Thanks everybody!! I finally got it working, but there is one more problem. As you can see,  on the code that I posted there is a function that draws the "mouse cursor" on the screenshot, and it is not working anymore. This function I copied from this link: http://www.swissdelphicenter.ch/en/showcode.php?id=13

Firstly, I tried to use the code the way it is - replacing, of course, the screenshot for kol function which jon posted -  but I got an incompatible type error due to the fact that both Graphics ( required by the GetCursor function) and the Kol uses have the TPixelFormat class, so I made some changes on the Graphics( I deleted the TPixelFormat class) and then I didnt get the error anymore. However, the problem is not solved and Im still getting an error, saying that "Integer and TIcon are incompatible" and I dont know how to fix it. Can anyone help me on this ?

Best Regards!
gok5

---

← →
gok5   (2007-01-29 19:17) [6]

Sorry for the wrong link, the right one is :

http://www.swissdelphicenter.ch/en/showcode.php?id=1396

gok5

---

← →
Jon ©   (2007-01-29 19:37) [7]

As you noticed, the posted code did not include additional code to superimpose a mouse icon on top of the screenshot. I just posted a pure and simple screenshot routine.

Also, your code differs somewhat from the linked code which seems to work better.

Your best bet is to try replacing Delphi"s objects, with KOL"s corresponding pointers to objects - such as PBitmap for TBitmap, PIcon for TIcon, etc.

I"m not sure if it"s that striaghtforward (I"m away from my development machine), but it should point you in the right direction.

---

← →
Thaddy   (2007-01-31 12:39) [8]


function CaptureScreen: PBitmap;
var
DC: HDC;
ABitmap: PBitmap;
MyCursor: PIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
// Capture the Desktop screen
DC := GetDC(GetDesktopWindow);
ABitmap := NewBitmap(GetDeviceCaps(DC, HORZRES),GetDeviceCaps(DC, VERTRES));
try
  // BitBlt on our bitmap
  BitBlt(ABitmap.Canvas.Handle,
    0,
    0,
    ABitmap.Width,
    ABitmap.Height,
    DC,
    0,
    0,
    SRCCOPY);
  // Create temp. Icon
  MyCursor := NewIcon;
  try
    // Retrieve Cursor info
    CursorInfo := GetCursorInfo2;
    if CursorInfo.hCursor <> 0 then
    begin
      MyCursor.Handle := CursorInfo.hCursor;
      // Get Hotspot information
      GetIconInfo(CursorInfo.hCursor, IconInfo);
      // Draw the Cursor on our bitmap
      MyCursor.Draw(Abitmap.canvas.Handle,CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
                          CursorInfo.ptScreenPos.Y - IconInfo.yHotspot);
    end;
  finally
    MyCursor.Free;
  end;
finally
  ReleaseDC(GetDesktopWindow, DC);
end;
Result := ABitmap;
end;

procedure TForm1.Button1Click(Sender: PObj);
begin
 Image1.Assign(CaptureScreen);
 Image1.Draw(Form.canvas.handle,0,0);
end;


---

← →
gok5   (2007-02-05 04:10) [9]

Hello thaddy, thank you for posting this code. I didnt test it yet because im not on my machine. Im not understanding this last line of the code - the "Image1.Assign"... Isnt this (Image1) a VCL component? Or is that also included on the kol library ?

---

← →
Miklya   (2007-02-05 04:38) [10]

To gok5
I think Image1 is a PBitmap

---

← →
thaddy   (2007-02-05 15:32) [11]

Yup, it"s a PBitmap. I wouldn"t post the whole lot. btw: watch out for the inherent memoryleak in this function: don"t forget to free the function result after using this.

---

← →
heilong   (2007-02-05 18:39) [12]

function GetCursorInfo2 is not defined

---

← →
heilong   (2007-02-05 18:40) [13]


function GetCursorInfo2: TCursorInfo;
var
 hWindow: HWND;
 pt: TPoint;
 pIconInfo: TIconInfo;
 dwThreadID, dwCurrentThreadID: DWORD;
begin
 Result.hCursor := 0;
 ZeroMemory(@Result, SizeOf(Result));
 // Find out which window owns the cursor
if GetCursorPos(pt) then
 begin
   Result.ptScreenPos := pt;
   hWindow := WindowFromPoint(pt);
   if IsWindow(hWindow) then
   begin
     // Get the thread ID for the cursor owner.
    dwThreadID := GetWindowThreadProcessId(hWindow, nil);

     // Get the thread ID for the current thread
    dwCurrentThreadID := GetCurrentThreadId;

     // If the cursor owner is not us then we must attach to
    // the other thread in so that we can use GetCursor() to
    // return the correct hCursor
    if (dwCurrentThreadID <> dwThreadID) then
     begin
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
       begin
         // Get the handle to the cursor
        Result.hCursor := GetCursor;
         AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
       end;
     end
     else
     begin
       Result.hCursor := GetCursor;
     end;
   end;
 end;
end;


---

← →
thaddy   (2007-02-05 21:38) [14]

:)

---

← →
gok5   (2007-02-07 01:53) [15]

Hello thaddy, Im finally on my computer and I tested the code, but unfortunately it didnt work... No problems about compiling. I just added a var called "Image1" on the button1 procedure, the rest i copied from your code.

The problem is when I click on the button and get a message error, like the debugging messages, or the "runtime" error ( http://img292.imageshack.us/img292/7207/imagenp1.jpg ).

I noticed the error occurs when the "Image1.Assign" line is executed.

I hope you can help me on that, because it is almost there....

Best Regards!
gok5

---

← →
thaddy   (2007-02-08 18:02) [16]

Lazy.

unit unit1;
//********************************************************************
//  Created by KOL project Expert Version 2.00 on:8-2-2007 15:58:25
//********************************************************************

interface
uses
 Windows, Messages, Kol;

type

PForm1=^TForm1;
TForm1=object(Tobj)
 Form:pControl;
 Btn:PControl;
public
 procedure btnclick(sender:PObj);
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );

var
 Form1:pForm1;

implementation

function GetCursorInfo2: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
// Find out which window owns the cursor
if GetCursorPos(pt) then
begin
  Result.ptScreenPos := pt;
  hWindow := WindowFromPoint(pt);
  if IsWindow(hWindow) then
  begin
    // Get the thread ID for the cursor owner.
   dwThreadID := GetWindowThreadProcessId(hWindow, nil);

    // Get the thread ID for the current thread
   dwCurrentThreadID := GetCurrentThreadId;

    // If the cursor owner is not us then we must attach to
   // the other thread in so that we can use GetCursor() to
   // return the correct hCursor
   if (dwCurrentThreadID <> dwThreadID) then
    begin
      if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
      begin
        // Get the handle to the cursor
       Result.hCursor := GetCursor;
        AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
      end;
    end
    else
    begin
      Result.hCursor := GetCursor;
    end;
  end;
end;
end;

function CaptureScreen: PBitmap;
var
DC: HDC;
ABitmap: PBitmap;
MyCursor: PIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
// Capture the Desktop screen
DC := GetDC(GetDesktopWindow);
ABitmap := NewBitmap(GetDeviceCaps(DC, HORZRES),GetDeviceCaps(DC, VERTRES));
try
 // BitBlt on our bitmap
 BitBlt(ABitmap.Canvas.Handle,
   0,
   0,
   ABitmap.Width,
   ABitmap.Height,
   DC,
   0,
   0,
   SRCCOPY);
 // Create temp. Icon
 MyCursor := NewIcon;
 try
   // Retrieve Cursor info
   CursorInfo := GetCursorInfo2;
   if CursorInfo.hCursor <> 0 then
   begin
     MyCursor.Handle := CursorInfo.hCursor;
     // Get Hotspot information
     GetIconInfo(CursorInfo.hCursor, IconInfo);
     // Draw the Cursor on our bitmap
     MyCursor.Draw(Abitmap.canvas.Handle,CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
                         CursorInfo.ptScreenPos.Y - IconInfo.yHotspot);
   end;
 finally
   MyCursor.Free;
 end;
finally
 ReleaseDC(GetDesktopWindow, DC);
end;
Result := ABitmap;
end;

procedure TForm1.BtnClick(Sender: PObj);
begin
with CaptureScreen^ do
try
  Draw(Form.canvas.handle,0,0);
finally
  Free;
end;
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
 New(Result,Create);
 with Result^ do
 begin
   Form:= NewForm(AParent,"KOLForm").SetSize(600,400).centeronparent.Tabulate;
   Applet:=Form;
   Btn := NewButton(form,"Capture");
   btn.OnClick := btnClick;
   Form.Add2AutoFree(Result);
 end;
end;

end.


---

Страницы: 1 вся ветка

Форум: "KOL";
Текущий архив: 2007.09.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.051 c