Added a first CopyClientToBitmap.

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@3 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-09-01 01:42:05 +00:00
parent 53f343d58e
commit 3a3390f8a5
6 changed files with 466 additions and 229 deletions

View File

@ -1,174 +1,270 @@
unit Window;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, mufasatypes
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
type
TMWindow = class(TObject)
function ReturnData(xs, ys, width, height: Integer): PRGB32;
procedure FreeReturnData;
procedure GetDimensions(var W, H: Integer);
constructor Create(Client: TObject);
destructor Destroy; override;
protected
// Reference to client.
Client: TObject;
// Target Window Mode.
TargetMode: TTargetWindowMode;
{$IFDEF LINUX}
// X Display
XDisplay: PDisplay;
// Connection Number
XConnectionNumber: Integer;
// X Window
CurWindow: QWord;
// Desktop Window
DesktopWindow: QWord;
// X Screen
XScreen: PScreen;
// X Screen Number
XScreenNum: Integer;
// The X Image pointer.
XWindowImage: PXImage;
{$IFDEF M_MEMORY_DEBUG}
// XImageFreed should be True if there is currently no
// XImage loaded. If one is loaded, XImageFreed is true.
// If ReturnData is called while XImageFreed is false,
// we throw an exception.
// Same for FreeReturnData with XImageFreed true.
XImageFreed: Boolean;
{$ENDIF}
{$ELSE}
{$ENDIF}
end;
implementation
uses
Client;
constructor TMWindow.Create(Client: TObject);
begin
inherited Create;
Self.Client := Client;
{$IFDEF LINUX}
Self.TargetMode := w_XWindow;
Self.XDisplay := XOpenDisplay(nil);
if Self.XDisplay = nil then
begin
// throw Exception
end;
Self.XConnectionNumber:= ConnectionNumber(Self.XDisplay);
Self.XScreen := XDefaultScreenOfDisplay(Self.XDisplay);
Self.XScreenNum:= DefaultScreen(Self.XDisplay);
Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum);
Self.CurWindow:= Self.DesktopWindow;
{$ELSE}
// Set Target mode for windows.
{$ENDIF}
end;
destructor TMWindow.Destroy;
begin
{$IFDEF LINUX}
XCloseDisplay(Self.XDisplay);
{$ENDIF}
inherited;
end;
function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
begin
end;
procedure TMWindow.FreeReturnData;
begin
end;
// Too global.
{$IFDEF LINUX}
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
begin;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
end;
{$ENDIF}
procedure TMWindow.GetDimensions(var W, H: Integer);
{$IFDEF LINUX}
var
Attrib: TXWindowAttributes;
newx,newy : integer;
childwindow : x.TWindow;
Old_Handler: TXErrorHandler;
{$ENDIF}
begin
case TargetMode of
w_Window:
begin
end;
w_XWindow:
begin
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then
begin
XTranslateCoordinates(Self.XDisplay, Self.CurWindow, self.DesktopWindow, 0,0,@newx,@newy, @childwindow);
W := Attrib.Width;
H := Attrib.Height;
end else
begin
W := -1;
H := -1;
end;
XSetErrorHandler(Old_Handler);
{$ELSE}
WriteLn('You dummy! How are you going to use w_XWindow on non Linux systems?');
{$ENDIF}
End;
w_ArrayPtr:
begin
end;
end;
end;
end.
unit Window;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, mufasatypes, graphics
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
type
TMWindow = class(TObject)
function ReturnData(xs, ys, width, height: Integer): PRGB32;
procedure FreeReturnData;
procedure GetDimensions(var W, H: Integer);
function CopyClientToBitmap(xs, ys, xe, ye: integer): TBitmap;
constructor Create(Client: TObject);
destructor Destroy; override;
protected
// Reference to client.
Client: TObject;
// Target Window Mode.
TargetMode: TTargetWindowMode;
{$IFDEF LINUX}
// X Display
XDisplay: PDisplay;
// Connection Number
XConnectionNumber: Integer;
// X Window
CurWindow: QWord;
// Desktop Window
DesktopWindow: QWord;
// X Screen
XScreen: PScreen;
// X Screen Number
XScreenNum: Integer;
// The X Image pointer.
XWindowImage: PXImage;
{$IFDEF M_MEMORY_DEBUG}
// XImageFreed should be True if there is currently no
// XImage loaded. If one is loaded, XImageFreed is true.
// If ReturnData is called while XImageFreed is false,
// we throw an exception.
// Same for FreeReturnData with XImageFreed true.
XImageFreed: Boolean;
{$ENDIF}
{$ELSE}
{$ENDIF}
end;
implementation
uses
Client, // For the Client Class
windowutil, // For utilities such as XImageToRawImage
GraphType // For TRawImage
;
constructor TMWindow.Create(Client: TObject);
begin
inherited Create;
Self.Client := Client;
{$IFDEF LINUX}
Self.TargetMode := w_XWindow;
Self.XDisplay := XOpenDisplay(nil);
if Self.XDisplay = nil then
begin
// throw Exception
end;
Self.XConnectionNumber:= ConnectionNumber(Self.XDisplay);
Self.XScreen := XDefaultScreenOfDisplay(Self.XDisplay);
Self.XScreenNum:= DefaultScreen(Self.XDisplay);
// The Root Window is the Desktop. :-)
Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum);
Self.CurWindow:= Self.DesktopWindow;
{$ELSE}
// Set Target mode for windows.
{$ENDIF}
end;
destructor TMWindow.Destroy;
begin
{$IFDEF LINUX}
XCloseDisplay(Self.XDisplay);
{$ENDIF}
inherited;
end;
// Too global.
{$IFDEF LINUX}
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
begin;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
end;
{$ENDIF}
function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
{$IFDEF LINUX}
var
Old_Handler: TXErrorHandler;
{$ENDIF}
begin
case Self.TargetMode of
w_XWindow:
begin
{$IFDEF LINUX}
{ Should be this. }
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
Self.XWindowImage := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, width, height, AllPlanes, ZPixmap);
if QWord(Self.XWindowImage) = 0 then
begin
Writeln('ReturnData: XGetImage Error. Dumping data now:');
Writeln('xs, ys, width, height: ' + inttostr(xs) + ', ' + inttostr(ys) +
', ' + inttostr(width) + ', ' + inttostr(height));
Result := nil;
XSetErrorHandler(Old_Handler);
Exit;
end;
WriteLn(IntToStr(Self.XWindowImage^.width) + ', ' + IntToStr(Self.XWindowImage^.height));
Result := PRGB32(Self.XWindowImage^.data);
XSetErrorHandler(Old_Handler);
{$ELSE}
WriteLn('Windows doesn''t support XImage');
{$ENDIF}
End;
end;
end;
procedure TMWindow.FreeReturnData;
begin
if Self.TargetMode <> w_XWindow then
begin
// throw exception.
exit;
end;
{$IFDEF LINUX}
if(QWord(Self.XWindowImage) <> 0) then // 0, nil?
begin
XDestroyImage(Self.XWindowImage);
end;
{$ENDIF}
end;
function TMWindow.CopyClientToBitmap(xs, ys, xe, ye: integer): TBitmap;
{$IFDEF LINUX}
var
Old_Handler: TXErrorHandler;
w, h, ww, hh: Integer;
Img: PXImage;
Raw: TRawImage;
Bmp: TBitmap;
{$ENDIF}
begin
Self.GetDimensions(w, h);
writeln(inttostr(xs) + ', ' + inttostr(ys) + ' : ' + inttostr(xe) + ', ' +
inttostr(ye));
ww := xe-xs;
hh := ye-ys;
case Self.TargetMode Of
w_XWindow:
begin
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
begin
writeln('Faulty coordinates');
XSetErrorHandler(Old_Handler);
exit;
end;
Img := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, ww, hh, AllPlanes, ZPixmap);
XImageToRawImage(Img, Raw);
Bmp := TBitmap.Create;
Bmp.LoadFromRawImage(Raw, False);
Result := Bmp;
{
If you want to use some internal Bitmap system, BitBlt to it here.
Don't forget to free Bmp!
}
//lclintf.BitBlt(Bmps[bitmap].Canvas.Handle, 0, 0, ww + 1, hh + 1, Bmp.Canvas.Handle, xs, ys, SRCCOPY);
//Bmp.Free;
XDestroyImage(Img);
XSetErrorHandler(Old_Handler);
{$ELSE}
writeln('Windows and tXWindow');
{$ENDIF}
end;
end;
end;
procedure TMWindow.GetDimensions(var W, H: Integer);
{$IFDEF LINUX}
var
Attrib: TXWindowAttributes;
newx,newy : integer;
childwindow : x.TWindow;
Old_Handler: TXErrorHandler;
{$ENDIF}
begin
case TargetMode of
w_Window:
begin
end;
w_XWindow:
begin
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then
begin
XTranslateCoordinates(Self.XDisplay, Self.CurWindow, Self.DesktopWindow, 0,0, @newx, @newy, @childwindow);
W := Attrib.Width;
H := Attrib.Height;
end else
begin
W := -1;
H := -1;
end;
XSetErrorHandler(Old_Handler);
{$ELSE}
WriteLn('You dummy! How are you going to use w_XWindow on non Linux systems?');
{$ENDIF}
End;
w_ArrayPtr:
begin
end;
end;
end;
end.

View File

@ -6,7 +6,7 @@
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="5"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -30,16 +30,14 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="9">
<Units Count="17">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<CursorPos X="45" Y="20"/>
<CursorPos X="69" Y="7"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
<UsageCount Value="28"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
@ -47,10 +45,10 @@
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<CursorPos X="64" Y="46"/>
<TopLine Value="18"/>
<EditorIndex Value="0"/>
<UsageCount Value="27"/>
<CursorPos X="73" Y="40"/>
<TopLine Value="25"/>
<EditorIndex Value="2"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@ -59,15 +57,15 @@
<UnitName Value="Client"/>
<CursorPos X="18" Y="34"/>
<TopLine Value="10"/>
<UsageCount Value="27"/>
<UsageCount Value="28"/>
</Unit2>
<Unit3>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<UnitName Value="CompTypes"/>
<CursorPos X="62" Y="426"/>
<TopLine Value="426"/>
<EditorIndex Value="2"/>
<UsageCount Value="14"/>
<CursorPos X="55" Y="12"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -76,7 +74,7 @@
<UnitName Value="MufasaTypes"/>
<CursorPos X="52" Y="20"/>
<TopLine Value="1"/>
<UsageCount Value="27"/>
<UsageCount Value="28"/>
</Unit4>
<Unit5>
<Filename Value="window.pas"/>
@ -84,7 +82,7 @@
<UnitName Value="Window"/>
<CursorPos X="4" Y="100"/>
<TopLine Value="85"/>
<UsageCount Value="27"/>
<UsageCount Value="28"/>
</Unit5>
<Unit6>
<Filename Value="../../Documents/fpc/rtl/inc/systemh.inc"/>
@ -98,75 +96,209 @@
<UnitName Value="Input"/>
<CursorPos X="5" Y="20"/>
<TopLine Value="15"/>
<UsageCount Value="26"/>
<UsageCount Value="27"/>
</Unit7>
<Unit8>
<Filename Value="../cogat/Units/CogatUnits/compinput.pas"/>
<UnitName Value="CompInput"/>
<CursorPos X="39" Y="486"/>
<TopLine Value="469"/>
<EditorIndex Value="3"/>
<UsageCount Value="12"/>
<EditorIndex Value="8"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="Units/MMLCore/client.pas"/>
<UnitName Value="Client"/>
<CursorPos X="19" Y="4"/>
<TopLine Value="12"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="Units/MMLCore/input.pas"/>
<UnitName Value="Input"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="Units/MMLCore/mufasatypes.pas"/>
<UnitName Value="MufasaTypes"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="Units/MMLCore/window.pas"/>
<UnitName Value="Window"/>
<CursorPos X="11" Y="214"/>
<TopLine Value="195"/>
<EditorIndex Value="5"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="Units/MMLCore/windowutil.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="windowutil"/>
<CursorPos X="55" Y="8"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="../../Documents/lazarus/lcl/graphics.pp"/>
<UnitName Value="Graphics"/>
<CursorPos X="15" Y="1287"/>
<TopLine Value="1272"/>
<EditorIndex Value="0"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="../cogat/Units/CogatUnits/compbitmaps.pas"/>
<UnitName Value="CompBitmaps"/>
<CursorPos X="1" Y="109"/>
<TopLine Value="92"/>
<EditorIndex Value="9"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="../../Documents/lazarus/lcl/include/rasterimage.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="691"/>
<UsageCount Value="10"/>
</Unit16>
</Units>
<JumpHistory Count="14" HistoryIndex="13">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="14" Column="31" TopLine="1"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="127" Column="1" TopLine="111"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="17" Column="38" TopLine="3"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="112" Column="1" TopLine="100"/>
</Position2>
<Position3>
<Filename Value="../cogat/Units/CogatUnits/compinput.pas"/>
<Caret Line="7" Column="22" TopLine="1"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="180" Column="59" TopLine="154"/>
</Position3>
<Position4>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="113" Column="45" TopLine="111"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="123" Column="1" TopLine="94"/>
</Position4>
<Position5>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="161" Column="27" TopLine="146"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="204" Column="16" TopLine="180"/>
</Position5>
<Position6>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="3" Column="87" TopLine="1"/>
<Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="1" Column="16" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="97" Column="32" TopLine="82"/>
<Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="8" Column="53" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="161" Column="31" TopLine="148"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="8" Column="42" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
<Caret Line="426" Column="59" TopLine="411"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="15" Column="13" TopLine="8"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="14" Column="55" TopLine="1"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="18" Column="13" TopLine="1"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="17" Column="46" TopLine="1"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="8" Column="42" TopLine="2"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="32" Column="43" TopLine="16"/>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="17" Column="71" TopLine="2"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="44" Column="4" TopLine="18"/>
<Filename Value="../cogat/Units/CogatUnits/compbitmaps.pas"/>
<Caret Line="8" Column="36" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="project1.lpr"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="../cogat/Units/CogatUnits/compbitmaps.pas"/>
<Caret Line="37" Column="29" TopLine="22"/>
</Position14>
<Position15>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="177" Column="17" TopLine="168"/>
</Position15>
<Position16>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="176" Column="25" TopLine="161"/>
</Position16>
<Position17>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="178" Column="8" TopLine="173"/>
</Position17>
<Position18>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="181" Column="7" TopLine="166"/>
</Position18>
<Position19>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="179" Column="16" TopLine="161"/>
</Position19>
<Position20>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="201" Column="46" TopLine="186"/>
</Position20>
<Position21>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="180" Column="19" TopLine="177"/>
</Position21>
<Position22>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="181" Column="17" TopLine="170"/>
</Position22>
<Position23>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="71" Column="43" TopLine="61"/>
</Position23>
<Position24>
<Filename Value="unit1.pas"/>
<Caret Line="38" Column="42" TopLine="18"/>
</Position24>
<Position25>
<Filename Value="unit1.pas"/>
<Caret Line="44" Column="12" TopLine="25"/>
</Position25>
<Position26>
<Filename Value="../../Documents/lazarus/lcl/graphics.pp"/>
<Caret Line="800" Column="25" TopLine="785"/>
</Position26>
<Position27>
<Filename Value="../../Documents/lazarus/lcl/graphics.pp"/>
<Caret Line="827" Column="71" TopLine="812"/>
</Position27>
<Position28>
<Filename Value="../../Documents/lazarus/lcl/graphics.pp"/>
<Caret Line="835" Column="17" TopLine="812"/>
</Position28>
<Position29>
<Filename Value="../../Documents/lazarus/lcl/graphics.pp"/>
<Caret Line="2447" Column="13" TopLine="2433"/>
</Position29>
<Position30>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="210" Column="21" TopLine="195"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

View File

@ -7,8 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, LResources, Client, MufasaTypes, Window, Input
{ you can add units after this };
Forms, Unit1, LResources, Client, MufasaTypes, Window, Input, windowutil;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}

View File

@ -3,6 +3,7 @@ object Form1: TForm1
Height = 516
Top = 200
Width = 779
ActiveControl = Button1
Caption = 'Form1'
ClientHeight = 516
ClientWidth = 779

View File

@ -1,7 +1,9 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'%'#1#6'Height'#3#4#2#3'Top'#3#200#0#5'Wid'
+'th'#3#11#3#7'Caption'#6#5'Form1'#12'ClientHeight'#3#4#2#11'ClientWidth'#3#11
+#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButton'#7'Button1'#4'Left'#2'E'#6'Height'
+#2#25#3'Top'#2' '#5'Width'#2'K'#7'Caption'#6#7'Button1'#7'OnClick'#7#12'Butt'
+'on1Click'#8'TabOrder'#2#0#0#0#0
+'th'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHe'
+'ight'#3#4#2#11'ClientWidth'#3#11#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButton'#7
+'Button1'#4'Left'#2'E'#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#7'Caption'#6
+#7'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0
]);

View File

@ -32,11 +32,18 @@ procedure TForm1.Button1Click(Sender: TObject);
Var
Client: TClient;
w,h:integer;
bmp: TBitmap;
begin
Client := TClient.Create;
Client.MWindow.GetDimensions(w, h);
writeln(inttostr(w) + ' , ' + inttostr(h));
bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h);
//writeln(inttostr(bmp.Width));
bmp.SaveToFile('/tmp/test.bmp');
bmp.Free;
Client.Destroy;
end;