Fixed EPIC stuff.
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@16 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond
parent
793e168a20
commit
babee3c3d2
|
|
@ -1,26 +1,30 @@
|
|||
unit MufasaTypes;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TRGB32 = packed record
|
||||
B, G, R, A: Byte;
|
||||
end;
|
||||
PRGB32 = ^TRGB32;
|
||||
|
||||
TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow);
|
||||
TClickType = (mouse_Left, mouse_Right, mouse_Middle);
|
||||
TMousePress = (mouse_Down, mouse_Up);
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
unit MufasaTypes;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TRGB32 = packed record
|
||||
B, G, R, A: Byte;
|
||||
end;
|
||||
PRGB32 = ^TRGB32;
|
||||
TRetData = record
|
||||
Ptr : PRGB32;
|
||||
IncPtrWith : integer;
|
||||
end;
|
||||
|
||||
TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow);
|
||||
TClickType = (mouse_Left, mouse_Right, mouse_Middle);
|
||||
TMousePress = (mouse_Down, mouse_Up);
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,425 +1,434 @@
|
|||
unit Window;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, mufasatypes,
|
||||
{$IFDEF MSWINDOWS}
|
||||
,windows // For windows API
|
||||
{$ENDIF}
|
||||
graphics,
|
||||
LCLType,
|
||||
LCLIntf // for ReleaseDC and such
|
||||
|
||||
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
|
||||
|
||||
type
|
||||
|
||||
{ TMWindow }
|
||||
|
||||
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;
|
||||
procedure ActivateClient;
|
||||
{$IFDEF LINUX}
|
||||
function SetTarget(XWindow: x.TWindow): integer; overload;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
function UpdateDrawBitmap:boolean;
|
||||
{$ENDIF}
|
||||
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
||||
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
||||
|
||||
constructor Create(Client: TObject);
|
||||
destructor Destroy; override;
|
||||
public
|
||||
// Reference to client.
|
||||
Client: TObject;
|
||||
|
||||
// Target Window Mode.
|
||||
TargetMode: TTargetWindowMode;
|
||||
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
//Target handle; HWND
|
||||
TargetHandle : Hwnd;
|
||||
DrawBmpDataPtr : PRGB32;
|
||||
|
||||
//Works on linux as well, test it out
|
||||
TargetDC : HDC;
|
||||
DrawBitmap : TBitmap;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
// X Display
|
||||
XDisplay: PDisplay;
|
||||
|
||||
// Connection Number
|
||||
XConnectionNumber: Integer;
|
||||
|
||||
// X Window
|
||||
CurWindow: x.TWindow;
|
||||
|
||||
// Desktop Window
|
||||
DesktopWindow: x.TWindow;
|
||||
|
||||
// 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}
|
||||
|
||||
ArrayPtr: PRGB32;
|
||||
ArraySize: TPoint;
|
||||
|
||||
|
||||
|
||||
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;
|
||||
|
||||
Self.ArrayPtr := nil;
|
||||
Self.ArraySize := Point(-1, -1);
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
Self.DrawBitmap := TBitmap.Create;
|
||||
Self.TargetMode:= w_Window;
|
||||
Self.TargetHandle:= windows.GetDesktopWindow;
|
||||
Self.TargetDC:= GetWindowDC(Self.TargetHandle);
|
||||
Self.UpdateDrawBitmap;
|
||||
{$ENDIF}
|
||||
|
||||
{$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;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
destructor TMWindow.Destroy;
|
||||
begin
|
||||
|
||||
{$IFDEF LINUX}
|
||||
XCloseDisplay(Self.XDisplay);
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
if TargetMode = w_Window then
|
||||
ReleaseDC(TargetHandle,TargetDC);
|
||||
DrawBitmap.Free;
|
||||
{$ENDIF}
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
|
||||
{$IFDEF LINUX}
|
||||
var
|
||||
Old_Handler: TXErrorHandler;
|
||||
{$ENDIF}
|
||||
TmpData: PRGB32;
|
||||
|
||||
begin
|
||||
case Self.TargetMode of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY);
|
||||
Result := Self.DrawBmpDataPtr;
|
||||
{$ENDIF}
|
||||
end;
|
||||
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;
|
||||
w_ArrayPtr:
|
||||
begin
|
||||
TmpData := Self.ArrayPtr;
|
||||
Inc(TmpData, ys * Height + xs);
|
||||
Result := TmpData;
|
||||
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;
|
||||
var
|
||||
w,h : Integer;
|
||||
ww, hh: Integer;
|
||||
{$IFDEF LINUX}
|
||||
Old_Handler: TXErrorHandler;
|
||||
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;
|
||||
if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
|
||||
begin
|
||||
writeln('Faulty coordinates');
|
||||
exit;
|
||||
end;
|
||||
|
||||
case Self.TargetMode Of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
Result := TBitmap.Create;
|
||||
Result.SetSize(ww+1,hh+1);
|
||||
BitBlt(result.canvas.handle,0,0,ww+1,hh+1,
|
||||
self.TargetDC,xs,ys, SRCCOPY);
|
||||
{$ENDIF}
|
||||
end;
|
||||
w_XWindow:
|
||||
begin
|
||||
{$IFDEF LINUX}
|
||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
||||
|
||||
Img := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, ww, hh, AllPlanes, ZPixmap);
|
||||
|
||||
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;
|
||||
w_ArrayPtr:
|
||||
begin
|
||||
|
||||
ArrDataToRawImage(Self.ArrayPtr, Self.ArraySize, Raw);
|
||||
|
||||
Bmp := TBitmap.Create;
|
||||
Bmp.LoadFromRawImage(Raw, False);
|
||||
Result := Bmp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMWindow.ActivateClient;
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
SetForegroundWindow(Self.TargetHandle);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
{$IFDEF MSWINDOWS} //Probably need one for Linux as well
|
||||
function TMWindow.UpdateDrawBitmap :boolean;
|
||||
var
|
||||
w,h : integer;
|
||||
BmpInfo : Windows.TBitmap;
|
||||
begin
|
||||
GetDimensions(w,h);
|
||||
DrawBitmap.SetSize(w,h);
|
||||
GetObject(DrawBitmap.Handle, SizeOf(BmpInfo), @BmpInfo);
|
||||
DrawBmpDataPtr := BmpInfo.bmBits;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TMWindow.GetDimensions(var W, H: Integer);
|
||||
{$IFDEF LINUX}
|
||||
var
|
||||
Attrib: TXWindowAttributes;
|
||||
newx,newy : integer;
|
||||
childwindow : x.TWindow;
|
||||
Old_Handler: TXErrorHandler;
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
var
|
||||
Rect : TRect;
|
||||
{$ENDIF}
|
||||
begin
|
||||
case TargetMode of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
GetWindowRect(Self.TargetHandle, Rect);
|
||||
w:= Rect.Right - Rect.left + 1;
|
||||
h:= Rect.Bottom - Rect.Top + 1;
|
||||
{$ENDIF}
|
||||
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
|
||||
W := Self.ArraySize.X;
|
||||
H := Self.ArraySize.Y;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
function TMWindow.SetTarget(XWindow: x.TWindow): integer; overload;
|
||||
var
|
||||
Old_Handler: TXErrorHandler;
|
||||
begin
|
||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
||||
Self.CurWindow := XWindow;
|
||||
Self.TargetMode:= w_XWindow;
|
||||
XSetErrorHandler(Old_Handler);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TMWindow.SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
||||
begin
|
||||
if NewType in [ w_XWindow, w_ArrayPtr ] then
|
||||
begin
|
||||
// throw exception
|
||||
Exit;
|
||||
end;
|
||||
case NewType of
|
||||
w_Window :
|
||||
begin;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
ReleaseDC(Self.TargetHandle,Self.TargetDC);
|
||||
Self.TargetHandle := Window;
|
||||
Self.TargetDC := GetWindowDC(Window);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
{$IFDEF MSWINDOWS}
|
||||
UpdateDrawBitmap;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{
|
||||
This functionality is very BETA.
|
||||
We have no way to send events to a window, so we should probably use the
|
||||
desktop window?
|
||||
|
||||
eg: In mouse/keys: if Self.TargetMode not in [w_Window, w_XWindow], send it
|
||||
to the desktop.
|
||||
}
|
||||
function TMWindow.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
||||
begin
|
||||
Self.ArrayPtr := ArrPtr;
|
||||
Self.ArraySize := Size;
|
||||
Self.TargetMode:= w_ArrayPtr;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
Self.CurWindow := Self.DesktopWindow;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
Self.TargetHandle:= windows.GetDesktopWindow;
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit Window;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, mufasatypes,
|
||||
{$IFDEF MSWINDOWS}
|
||||
windows, // For windows API
|
||||
{$ENDIF}
|
||||
graphics,
|
||||
LCLType,
|
||||
LCLIntf // for ReleaseDC and such
|
||||
|
||||
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
|
||||
|
||||
type
|
||||
|
||||
{ TMWindow }
|
||||
|
||||
TMWindow = class(TObject)
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||
procedure FreeReturnData;
|
||||
procedure GetDimensions(var W, H: Integer);
|
||||
function CopyClientToBitmap(xs, ys, xe, ye: integer): TBitmap;
|
||||
procedure ActivateClient;
|
||||
{$IFDEF LINUX}
|
||||
function SetTarget(XWindow: x.TWindow): integer; overload;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
function UpdateDrawBitmap:boolean;
|
||||
{$ENDIF}
|
||||
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
||||
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
||||
|
||||
constructor Create(Client: TObject);
|
||||
destructor Destroy; override;
|
||||
public
|
||||
// Reference to client.
|
||||
Client: TObject;
|
||||
|
||||
// Target Window Mode.
|
||||
TargetMode: TTargetWindowMode;
|
||||
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
//Target handle; HWND
|
||||
TargetHandle : Hwnd;
|
||||
DrawBmpDataPtr : PRGB32;
|
||||
|
||||
//Works on linux as well, test it out
|
||||
TargetDC : HDC;
|
||||
DrawBitmap : TBitmap;
|
||||
DrawBmpW,DrawBmpH : integer;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
// X Display
|
||||
XDisplay: PDisplay;
|
||||
|
||||
// Connection Number
|
||||
XConnectionNumber: Integer;
|
||||
|
||||
// X Window
|
||||
CurWindow: x.TWindow;
|
||||
|
||||
// Desktop Window
|
||||
DesktopWindow: x.TWindow;
|
||||
|
||||
// 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}
|
||||
|
||||
ArrayPtr: PRGB32;
|
||||
ArraySize: TPoint;
|
||||
|
||||
|
||||
|
||||
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;
|
||||
|
||||
Self.ArrayPtr := nil;
|
||||
Self.ArraySize := Classes.Point(-1, -1);
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
Self.DrawBitmap := TBitmap.Create;
|
||||
Self.DrawBitmap.PixelFormat:= pf32bit;
|
||||
Self.TargetMode:= w_Window;
|
||||
Self.TargetHandle:= windows.GetDesktopWindow;
|
||||
Self.TargetDC:= GetWindowDC(Self.TargetHandle);
|
||||
Self.UpdateDrawBitmap;
|
||||
{$ENDIF}
|
||||
|
||||
{$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;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
destructor TMWindow.Destroy;
|
||||
begin
|
||||
|
||||
{$IFDEF LINUX}
|
||||
XCloseDisplay(Self.XDisplay);
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
if TargetMode = w_Window then
|
||||
ReleaseDC(TargetHandle,TargetDC);
|
||||
DrawBitmap.Free;
|
||||
{$ENDIF}
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||
var
|
||||
{$IFDEF LINUX}
|
||||
Old_Handler: TXErrorHandler;
|
||||
{$ENDIF}
|
||||
TmpData: PRGB32;
|
||||
|
||||
begin
|
||||
case Self.TargetMode of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY);
|
||||
Result.Ptr:= Self.DrawBmpDataPtr;
|
||||
Result.IncPtrWith:= DrawBmpW - Width;
|
||||
{$ENDIF}
|
||||
end;
|
||||
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.Ptr := PRGB32(Self.XWindowImage^.data);
|
||||
Result.IncPtrWith := 0;
|
||||
|
||||
XSetErrorHandler(Old_Handler);
|
||||
{$ELSE}
|
||||
WriteLn('Windows doesn''t support XImage');
|
||||
{$ENDIF}
|
||||
end;
|
||||
w_ArrayPtr:
|
||||
begin
|
||||
TmpData := Self.ArrayPtr;
|
||||
Inc(TmpData, ys * Height + xs);
|
||||
Result.Ptr := TmpData;
|
||||
Result.IncPtrWith:= Self.ArraySize.x - width;
|
||||
|
||||
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;
|
||||
var
|
||||
w,h : Integer;
|
||||
ww, hh: Integer;
|
||||
Raw: TRawImage;
|
||||
Bmp: TBitmap;
|
||||
{$IFDEF LINUX}
|
||||
Old_Handler: TXErrorHandler;
|
||||
Img: PXImage;
|
||||
{$ENDIF}
|
||||
|
||||
begin
|
||||
Self.GetDimensions(w, h);
|
||||
writeln(inttostr(xs) + ', ' + inttostr(ys) + ' : ' + inttostr(xe) + ', ' +
|
||||
inttostr(ye));
|
||||
ww := xe-xs;
|
||||
hh := ye-ys;
|
||||
if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
|
||||
begin
|
||||
writeln('Faulty coordinates');
|
||||
exit;
|
||||
end;
|
||||
|
||||
case Self.TargetMode Of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
Result := TBitmap.Create;
|
||||
Result.SetSize(ww+1,hh+1);
|
||||
BitBlt(result.canvas.handle,0,0,ww+1,hh+1,
|
||||
self.TargetDC,xs,ys, SRCCOPY);
|
||||
{$ENDIF}
|
||||
end;
|
||||
w_XWindow:
|
||||
begin
|
||||
{$IFDEF LINUX}
|
||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
||||
|
||||
Img := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, ww, hh, AllPlanes, ZPixmap);
|
||||
|
||||
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;
|
||||
w_ArrayPtr:
|
||||
begin
|
||||
|
||||
ArrDataToRawImage(Self.ArrayPtr, Self.ArraySize, Raw);
|
||||
|
||||
Bmp := TBitmap.Create;
|
||||
Bmp.LoadFromRawImage(Raw, False);
|
||||
Result := Bmp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMWindow.ActivateClient;
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
SetForegroundWindow(Self.TargetHandle);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
{$IFDEF MSWINDOWS} //Probably need one for Linux as well
|
||||
function TMWindow.UpdateDrawBitmap :boolean;
|
||||
var
|
||||
w,h : integer;
|
||||
BmpInfo : Windows.TBitmap;
|
||||
begin
|
||||
GetDimensions(w,h);
|
||||
DrawBitmap.SetSize(w,h);
|
||||
// DrawBitmap.PixelFormat:=
|
||||
DrawBmpW := w;
|
||||
DrawBmpH := h;
|
||||
GetObject(DrawBitmap.Handle, SizeOf(BmpInfo), @BmpInfo);
|
||||
DrawBmpDataPtr := BmpInfo.bmBits;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TMWindow.GetDimensions(var W, H: Integer);
|
||||
{$IFDEF LINUX}
|
||||
var
|
||||
Attrib: TXWindowAttributes;
|
||||
newx,newy : integer;
|
||||
childwindow : x.TWindow;
|
||||
Old_Handler: TXErrorHandler;
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
var
|
||||
Rect : TRect;
|
||||
{$ENDIF}
|
||||
begin
|
||||
case TargetMode of
|
||||
w_Window:
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
GetWindowRect(Self.TargetHandle, Rect);
|
||||
w:= Rect.Right - Rect.left + 1;
|
||||
h:= Rect.Bottom - Rect.Top + 1;
|
||||
{$ENDIF}
|
||||
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
|
||||
W := Self.ArraySize.X;
|
||||
H := Self.ArraySize.Y;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
function TMWindow.SetTarget(XWindow: x.TWindow): integer; overload;
|
||||
var
|
||||
Old_Handler: TXErrorHandler;
|
||||
begin
|
||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
||||
Self.CurWindow := XWindow;
|
||||
Self.TargetMode:= w_XWindow;
|
||||
XSetErrorHandler(Old_Handler);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TMWindow.SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
||||
begin
|
||||
if NewType in [ w_XWindow, w_ArrayPtr ] then
|
||||
begin
|
||||
// throw exception
|
||||
Exit;
|
||||
end;
|
||||
case NewType of
|
||||
w_Window :
|
||||
begin;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
ReleaseDC(Self.TargetHandle,Self.TargetDC);
|
||||
Self.TargetHandle := Window;
|
||||
Self.TargetDC := GetWindowDC(Window);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
{$IFDEF MSWINDOWS}
|
||||
UpdateDrawBitmap;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{
|
||||
This functionality is very BETA.
|
||||
We have no way to send events to a window, so we should probably use the
|
||||
desktop window?
|
||||
|
||||
eg: In mouse/keys: if Self.TargetMode not in [w_Window, w_XWindow], send it
|
||||
to the desktop.
|
||||
}
|
||||
function TMWindow.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
||||
begin
|
||||
Self.ArrayPtr := ArrPtr;
|
||||
Self.ArraySize := Size;
|
||||
Self.TargetMode:= w_ArrayPtr;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
Self.CurWindow := Self.DesktopWindow;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
Self.TargetHandle:= windows.GetDesktopWindow;
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,129 +1,129 @@
|
|||
unit windowutil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
ctypes, // for cint, etc
|
||||
{$IFDEF LINUX}
|
||||
x, xlib, // For X* stuff.
|
||||
GraphType, // For TRawImage
|
||||
{$ENDIF}
|
||||
|
||||
mufasatypes;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
|
||||
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
|
||||
{$ENDIF}
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{$IFDEF LINUX}
|
||||
|
||||
// Too global.
|
||||
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;
|
||||
|
||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
||||
Begin
|
||||
RawImage.Init; { Calls raw.Description.Init as well }
|
||||
|
||||
RawImage.Description.PaletteColorCount:=0;
|
||||
RawImage.Description.MaskBitsPerPixel:=0;
|
||||
RawImage.Description.Width := XImg^.width;
|
||||
RawImage.Description.Height:= XImg^.height;
|
||||
|
||||
RawImage.Description.Format := ricfRGBA;
|
||||
|
||||
if XImg^.byte_order = LSBFirst then
|
||||
RawImage.Description.ByteOrder := riboLSBFirst
|
||||
else
|
||||
RawImage.Description.ByteOrder:= riboMSBFirst;
|
||||
|
||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||
|
||||
RawImage.Description.Depth:=XImg^.depth;
|
||||
|
||||
RawImage.Description.BitsPerPixel:=XImg^.bits_per_pixel;
|
||||
|
||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||
|
||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||
|
||||
RawImage.Description.RedPrec := 8;
|
||||
RawImage.Description.GreenPrec:= 8;
|
||||
RawImage.Description.BluePrec:= 8;
|
||||
RawImage.Description.AlphaPrec:=0;
|
||||
|
||||
|
||||
// Can be adjusted to the XImage RedMask, etc.
|
||||
// For now I just assume the tester uses BGR.
|
||||
RawImage.Description.RedShift:=16;
|
||||
RawImage.Description.GreenShift:=8;
|
||||
RawImage.Description.BlueShift:=0;
|
||||
|
||||
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||
* (RawImage.Description.bitsperpixel shr 3);
|
||||
//RawImage.DataSize := RawImage.Description.Height * RawImage.Description.BitsPerLine;
|
||||
RawImage.Data := PByte(XImg^.data);
|
||||
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
|
||||
Begin
|
||||
RawImage.Init; { Calls raw.Description.Init as well }
|
||||
|
||||
RawImage.Description.PaletteColorCount:=0;
|
||||
RawImage.Description.MaskBitsPerPixel:=0;
|
||||
RawImage.Description.Width := Size.X;
|
||||
RawImage.Description.Height:= Size.Y;
|
||||
|
||||
RawImage.Description.Format := ricfRGBA;
|
||||
|
||||
RawImage.Description.ByteOrder := riboLSBFirst;
|
||||
|
||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||
|
||||
RawImage.Description.Depth:=24;
|
||||
|
||||
RawImage.Description.BitsPerPixel:=32;
|
||||
|
||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||
|
||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||
|
||||
RawImage.Description.RedPrec := 8;
|
||||
RawImage.Description.GreenPrec:= 8;
|
||||
RawImage.Description.BluePrec:= 8;
|
||||
RawImage.Description.AlphaPrec:=0;
|
||||
|
||||
|
||||
RawImage.Description.RedShift:=16;
|
||||
RawImage.Description.GreenShift:=8;
|
||||
RawImage.Description.BlueShift:=0;
|
||||
|
||||
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||
* (RawImage.Description.bitsperpixel shr 3);
|
||||
|
||||
RawImage.Data := PByte(Ptr);
|
||||
|
||||
End;
|
||||
|
||||
end.
|
||||
|
||||
unit windowutil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
ctypes, // for cint, etc
|
||||
GraphType, // For TRawImage
|
||||
{$IFDEF LINUX}
|
||||
x, xlib, // For X* stuff.
|
||||
{$ENDIF}
|
||||
|
||||
mufasatypes;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
||||
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
|
||||
{$ENDIF}
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{$IFDEF LINUX}
|
||||
|
||||
// Too global.
|
||||
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;
|
||||
|
||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
||||
Begin
|
||||
RawImage.Init; { Calls raw.Description.Init as well }
|
||||
|
||||
RawImage.Description.PaletteColorCount:=0;
|
||||
RawImage.Description.MaskBitsPerPixel:=0;
|
||||
RawImage.Description.Width := XImg^.width;
|
||||
RawImage.Description.Height:= XImg^.height;
|
||||
|
||||
RawImage.Description.Format := ricfRGBA;
|
||||
|
||||
if XImg^.byte_order = LSBFirst then
|
||||
RawImage.Description.ByteOrder := riboLSBFirst
|
||||
else
|
||||
RawImage.Description.ByteOrder:= riboMSBFirst;
|
||||
|
||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||
|
||||
RawImage.Description.Depth:=XImg^.depth;
|
||||
|
||||
RawImage.Description.BitsPerPixel:=XImg^.bits_per_pixel;
|
||||
|
||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||
|
||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||
|
||||
RawImage.Description.RedPrec := 8;
|
||||
RawImage.Description.GreenPrec:= 8;
|
||||
RawImage.Description.BluePrec:= 8;
|
||||
RawImage.Description.AlphaPrec:=0;
|
||||
|
||||
|
||||
// Can be adjusted to the XImage RedMask, etc.
|
||||
// For now I just assume the tester uses BGR.
|
||||
RawImage.Description.RedShift:=16;
|
||||
RawImage.Description.GreenShift:=8;
|
||||
RawImage.Description.BlueShift:=0;
|
||||
|
||||
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||
* (RawImage.Description.bitsperpixel shr 3);
|
||||
//RawImage.DataSize := RawImage.Description.Height * RawImage.Description.BitsPerLine;
|
||||
RawImage.Data := PByte(XImg^.data);
|
||||
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
|
||||
Begin
|
||||
RawImage.Init; { Calls raw.Description.Init as well }
|
||||
|
||||
RawImage.Description.PaletteColorCount:=0;
|
||||
RawImage.Description.MaskBitsPerPixel:=0;
|
||||
RawImage.Description.Width := Size.X;
|
||||
RawImage.Description.Height:= Size.Y;
|
||||
|
||||
RawImage.Description.Format := ricfRGBA;
|
||||
|
||||
RawImage.Description.ByteOrder := riboLSBFirst;
|
||||
|
||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||
|
||||
RawImage.Description.Depth:=24;
|
||||
|
||||
RawImage.Description.BitsPerPixel:=32;
|
||||
|
||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||
|
||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||
|
||||
RawImage.Description.RedPrec := 8;
|
||||
RawImage.Description.GreenPrec:= 8;
|
||||
RawImage.Description.BluePrec:= 8;
|
||||
RawImage.Description.AlphaPrec:=0;
|
||||
|
||||
|
||||
RawImage.Description.RedShift:=16;
|
||||
RawImage.Description.GreenShift:=8;
|
||||
RawImage.Description.BlueShift:=0;
|
||||
|
||||
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||
* (RawImage.Description.bitsperpixel shr 3);
|
||||
|
||||
RawImage.Data := PByte(Ptr);
|
||||
|
||||
End;
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
41
testunit.lfm
41
testunit.lfm
|
|
@ -1,20 +1,21 @@
|
|||
object Form1: TForm1
|
||||
Left = 339
|
||||
Height = 527
|
||||
Top = 262
|
||||
Width = 779
|
||||
ActiveControl = Button1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 527
|
||||
ClientWidth = 779
|
||||
LCLVersion = '0.9.29'
|
||||
object Button1: TButton
|
||||
Left = 69
|
||||
Height = 25
|
||||
Top = 32
|
||||
Width = 75
|
||||
Caption = 'Button1'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object Form1: TForm1
|
||||
Left = 462
|
||||
Height = 527
|
||||
Top = 227
|
||||
Width = 779
|
||||
ActiveControl = Button1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 527
|
||||
ClientWidth = 779
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object Button1: TButton
|
||||
Left = 69
|
||||
Height = 25
|
||||
Top = 32
|
||||
Width = 75
|
||||
Caption = 'Button1'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
|
|
|
|||
17
testunit.lrs
17
testunit.lrs
|
|
@ -1,9 +1,10 @@
|
|||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'S'#1#6'Height'#3#15#2#3'Top'#3#6#1#5'Widt'
|
||||
+'h'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHei'
|
||||
+'ght'#3#15#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
|
||||
]);
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#206#1#6'Height'#3#15#2#3'Top'#3#227#0#5'W'
|
||||
+'idth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client'
|
||||
+'Height'#3#15#2#11'ClientWidth'#3#11#3#8'Position'#7#14'poScreenCenter'#10'L'
|
||||
+'CLVersion'#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'Button1Clic'
|
||||
+'k'#8'TabOrder'#2#0#0#0#0
|
||||
]);
|
||||
|
|
|
|||
282
testunit.pas
282
testunit.pas
|
|
@ -1,133 +1,149 @@
|
|||
unit TestUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, Client, MufasaTypes;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TMyThread = class(TThread)
|
||||
private
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
Constructor Create(CreateSuspended : boolean);
|
||||
end;
|
||||
|
||||
constructor TMyThread.Create(CreateSuspended : boolean);
|
||||
begin
|
||||
FreeOnTerminate := True;
|
||||
inherited Create(CreateSuspended);
|
||||
end;
|
||||
|
||||
procedure TMyThread.Execute;
|
||||
Var
|
||||
Client: TClient;
|
||||
w,h, x, y, xx, yy, i:integer;
|
||||
bmp: TBitmap;
|
||||
ptr: PRGB32;
|
||||
arr: Array Of Integer;
|
||||
|
||||
begin
|
||||
while (not Terminated) do
|
||||
begin
|
||||
|
||||
Writeln('Creating the client');
|
||||
Client := TClient.Create;
|
||||
Writeln('Getting the dimensions');
|
||||
Client.MWindow.GetDimensions(w, h);
|
||||
writeln(inttostr(w) + ' , ' + inttostr(h));
|
||||
Writeln('Setting target');
|
||||
//Client.MWindow.SetTarget(132840,w_window);
|
||||
|
||||
SetLength(Arr, 9);
|
||||
for i := 0 to high(arr) do
|
||||
arr[i] := $FFFFFF;
|
||||
|
||||
Client.MWIndow.SetTarget(PRGB32(@Arr[0]), Point(3, 3));
|
||||
|
||||
Client.MWindow.ActivateClient;
|
||||
Client.MWindow.GetDimensions(w, h);
|
||||
Writeln('Copying BMP');
|
||||
bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h);
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
bmp.SaveToFile('c:\test.bmp');
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
bmp.SaveToFile('/tmp/test.bmp');
|
||||
{$ENDIF}
|
||||
bmp.Free;
|
||||
|
||||
//Sleep(1000);
|
||||
Client.MInput.GetMousePos(x, y);
|
||||
writeln(inttostr(x) + ' , ' + inttostr(y));
|
||||
|
||||
Client.MInput.SetMousePos(50, 50);
|
||||
Client.MInput.GetMousePos(x, y);
|
||||
writeln(inttostr(x) + ' , ' + inttostr(y));
|
||||
|
||||
Client.MInput.ClickMouse(60, 60, mouse_Right);
|
||||
|
||||
ptr := Client.MWindow.ReturnData(0, 0, w, h);
|
||||
for yy := 0 to h - 1 do
|
||||
for xx := 0 to w - 1 do
|
||||
begin
|
||||
{ Do comparison here }
|
||||
inc(ptr);
|
||||
end;
|
||||
|
||||
Client.MWindow.FreeReturnData;
|
||||
|
||||
Client.MInput.IsMouseButtonDown(mouse_Left);
|
||||
Sleep(1000);
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Left) then
|
||||
writeln('Left mouse is down!');
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Right) then
|
||||
writeln('Right mouse is down!');
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Middle) then
|
||||
writeln('Middle mouse is down!');
|
||||
Client.Destroy;
|
||||
writeln('Test completed successfully');
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
Var
|
||||
MyThread: TMyThread;
|
||||
|
||||
begin
|
||||
MyThread := TMyThread.Create(True);
|
||||
MyThread.Resume;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I testunit.lrs}
|
||||
|
||||
end.
|
||||
|
||||
unit TestUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, Client, MufasaTypes;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TMyThread = class(TThread)
|
||||
private
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
Constructor Create(CreateSuspended : boolean);
|
||||
end;
|
||||
|
||||
constructor TMyThread.Create(CreateSuspended : boolean);
|
||||
begin
|
||||
FreeOnTerminate := True;
|
||||
inherited Create(CreateSuspended);
|
||||
end;
|
||||
|
||||
procedure TMyThread.Execute;
|
||||
Var
|
||||
Client: TClient;
|
||||
w,h, x, y, xx, yy, i:integer;
|
||||
bmp: TBitmap;
|
||||
ReturnData : TRetData;
|
||||
arr: Array Of Integer;
|
||||
LoopY,LoopX : integer;
|
||||
|
||||
begin
|
||||
while (not Terminated) do
|
||||
begin
|
||||
|
||||
Writeln('Creating the client');
|
||||
Client := TClient.Create;
|
||||
Writeln('Getting the dimensions');
|
||||
Client.MWindow.GetDimensions(w, h);
|
||||
writeln(inttostr(w) + ' , ' + inttostr(h));
|
||||
Writeln('Setting target');
|
||||
// Client.MWindow.SetTarget(67232,w_window);
|
||||
|
||||
{ SetLength(Arr, 9);
|
||||
for i := 0 to high(arr) do
|
||||
arr[i] := $FFFFFF;
|
||||
|
||||
Client.MWIndow.SetTarget(PRGB32(@Arr[0]), Point(3, 3)); }
|
||||
|
||||
// Client.MWindow.ActivateClient;
|
||||
Client.MWindow.GetDimensions(w, h);
|
||||
Writeln('Copying BMP');
|
||||
bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h);
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
bmp.SaveToFile('c:\test1.bmp');
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
bmp.SaveToFile('/tmp/test1.bmp');
|
||||
{$ENDIF}
|
||||
// bmp.Free;
|
||||
|
||||
//Sleep(1000);
|
||||
Client.MInput.GetMousePos(x, y);
|
||||
writeln(inttostr(x) + ' , ' + inttostr(y));
|
||||
|
||||
Client.MInput.SetMousePos(50, 50);
|
||||
Client.MInput.GetMousePos(x, y);
|
||||
writeln(inttostr(x) + ' , ' + inttostr(y));
|
||||
|
||||
Client.MInput.ClickMouse(60, 60, mouse_Right);
|
||||
LoopX:= w div 2;
|
||||
LoopY:= h div 2;
|
||||
bmp.SetSize(Loopx + 1, Loopy + 1);
|
||||
ReturnData := Client.MWindow.ReturnData(0, 0, Loopx + 1, Loopy + 1);
|
||||
SetLength(Arr,(Loopy + 1) * (Loopx + 1));
|
||||
for yy := 0 to Loopy do
|
||||
begin;
|
||||
for xx := 0 to Loopx do
|
||||
begin
|
||||
{ Do comparison here }
|
||||
Arr[yy * (loopx + 1) + xx] :=RGBToColor(ReturnData.Ptr^.B,ReturnData.Ptr^.G,ReturnData.Ptr^.R);
|
||||
Bmp.Canvas.Pixels[xx,yy] := clwhite xor RGBToColor(ReturnData.Ptr^.R,ReturnData.Ptr^.G,ReturnData.Ptr^.B);
|
||||
inc(ReturnData.Ptr);
|
||||
end;
|
||||
Inc(ReturnData.Ptr,ReturnData.IncPtrWith);
|
||||
end;
|
||||
{$IFDEF WINDOWS}
|
||||
bmp.SaveToFile('c:\test2.bmp');
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
bmp.SaveToFile('/tmp/test2.bmp');
|
||||
{$ENDIF}
|
||||
Bmp.free;
|
||||
// Client.MWIndow.SetTarget(PRGB32(@Arr[0]), Point(Loopx + 1, Loopy + 1));
|
||||
Client.MWindow.FreeReturnData;
|
||||
|
||||
Client.MInput.IsMouseButtonDown(mouse_Left);
|
||||
Sleep(1000);
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Left) then
|
||||
writeln('Left mouse is down!');
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Right) then
|
||||
writeln('Right mouse is down!');
|
||||
if Client.MInput.IsMouseButtonDown(mouse_Middle) then
|
||||
writeln('Middle mouse is down!');
|
||||
Client.Destroy;
|
||||
writeln('Test completed successfully');
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
Var
|
||||
MyThread: TMyThread;
|
||||
|
||||
begin
|
||||
MyThread := TMyThread.Create(True);
|
||||
MyThread.Resume;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I testunit.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue