moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 01:02:17 -05:00
Code Issues Releases Wiki Activity

Added SetTargetBitmap, and made CallThreadSafe work, hell yeah!

Browse Source 
OnDestroy event for bitmaps..
Added PosterizeBitmap
Added window.inc
Added FormTest.mufa

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@141 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-10-18 20:11:47 +00:00
parent 22ff72fb11
commit ffb90926b6
13 changed files with 1306 additions and 974 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

516
Projects/SAMufasaGUI/project1.lpi
View File

File diff suppressed because it is too large Load Diff

3
Projects/SAMufasaGUI/testunit.lfm
View File

@ -27,7 +27,6 @@ object Form1: TForm1
ParentColor = False
ParentFont = False
TabOrder = 0
BookMarkOptions.OnChange = nil
Gutter.Width = 57
Gutter.MouseActions = <
item
@ -839,7 +838,7 @@ object Form1: TForm1
Panels = <
item
Text = 'Untitled'
Width = 100
Width = 150
end
item
Width = 50

1430
Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

29
Projects/SAMufasaGUI/testunit.pas
View File

@ -23,6 +23,7 @@
unit TestUnit;
{$Undefine ProcessMessages} //Define this for processmessages in ThreadSafeCall
{$mode objfpc}{$H+}
interface
@ -87,6 +88,7 @@ type
procedure MenuItemRunClick(Sender: TObject);
procedure MenuItemSaveAsClick(Sender: TObject);
procedure MenuItemSaveClick(Sender: TObject);
procedure OnLinePSScript(Sender: TObject);
procedure OnSyneditChange(Sender: TObject);
procedure PickColorEvent(Sender: TObject);
procedure Redo(Sender: TObject);
@ -107,6 +109,7 @@ type
Window: TMWindow;
Picker: TMColorPicker;
Selector: TMWindowSelector;
procedure SafeCallThread;
function OpenScript : boolean;
function SaveCurrentScript : boolean;
function SaveCurrentScriptAs : boolean;
@ -117,7 +120,7 @@ const
WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename.
var
Form1: TForm1;
CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread
implementation
uses
@ -131,7 +134,8 @@ Var
MMLPSThread : TMMLPSThread;
begin
MMLPSThread := TMMLPSThread.Create(True);
CurrentSyncInfo.SyncMethod:= @Form1.SafeCallThread;
MMLPSThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text);
MMLPSThread.SetDebug(Form1.Memo1);
@ -216,6 +220,14 @@ begin
SaveCurrentScript;
end;
procedure TForm1.OnLinePSScript(Sender: TObject);
begin
//Writeln('We just completed a line!!');
{$IFDEF ProcessMessages}
Application.ProcessMessages; //Don't think that this is neccesary though
{$ENDIF}
end;
procedure TForm1.OnSyneditChange(Sender: TObject);
begin
if not ScriptChanged then
@ -290,6 +302,19 @@ begin
end;
end;
procedure TForm1.SafeCallThread;
begin
Writeln('Executing : ' + CurrentSyncInfo.MethodName);
mmlpsthread.CurrThread := TMMLPSTHREAD(CurrentSyncInfo.OldThread);
with CurrentSyncInfo.PSScript do
begin;
OnLine:=@OnLinePSScript;
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V,Exec.GetProc(CurrentSyncInfo.MethodName));
Online := nil;
end;
mmlpsthread.CurrThread := nil;
end;
function TForm1.OpenScript: boolean;
begin;
Result := False;

35
Tests/PS/FormTest.mufa Normal file
View File

@ -0,0 +1,35 @@
program new;
var
TempVar : Boolean;
procedure OnClick(Sender : TObject);
begin;
TempVar := True;
Writeln('YOU HAS CLICKED THE BUTTON');
end;
function x : Boolean;
var
MyForm : TForm;
AButton : TButton;
begin;
TempVar := False;
Result := false;
MyForm := CreateForm;
MyForm.Width := 250;
MyForm.Height := 250;
AButton := CreateButton(MyForm);
AButton.Parent := MyForm;
Abutton.SetBounds(100,100,100,50);
AButton.OnClick := @OnClick;
AButton.Caption := 'Test';
MyForm.ShowModal;
MyForm.Free;
Result := TempVar;
end;
var
v : TVariantArray;
begin
if ThreadSafeCall('x',v) then
Writeln('You clicked the button! WinnOr')
else
Writeln('You did not click the button, fail all the way');
end.

1
Tests/PS/Several bitmap operations.mufa
View File

@ -155,4 +155,5 @@ begin
Invertbitmap(bmpz);//Invert back
SaveBitmap(DesaturateBitmap(Bmpz),savedir + 'desaturate.bmp');
SaveBitmap(RotateBitmap(Bmpz,0.30*pi),savedir + 'rotated.bmp');
SaveBitmap(PosterizeBitmap(Bmpz,75),savedir + 'posterized.bmp');
end.

16
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -132,13 +132,8 @@ begin
end;
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
var
mBMP: TMufasaBitmap;
begin
mBMP := CurrThread.Client.MBitmaps.GetBMP(bmp);
if mBMP = nil then
exit;
mBMP.CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
end;
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
@ -227,3 +222,12 @@ begin;
Bmp[Bitmap].Contrast(Bmp[result],co);
end;
end;
function PosterizeBitmap(Bitmap : integer; po : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin
result := CreateBMP(0,0);
Bmp[bitmap].Posterize(Bmp[result],po);
end;
end;

24
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -21,11 +21,6 @@
Other.inc for the Mufasa Macro Library
}
procedure GetClientDimensions(var w, h: integer);
begin
CurrThread.Client.MWindow.GetDimensions(w, h);
end;
procedure Wait(t: Integer);
begin
Sleep(t);
@ -46,17 +41,16 @@ begin;
end;
end;
function CreateForm : TForm;
begin;
result := TForm.Create(nil);
end;
function CreateButton(Owner : TComponent) : TButton;
begin;
Result := TButton.Create(Owner);
end;
function Distance(x1, y1, x2, y2: Integer): Integer;
begin;
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
end;
function Freeze: boolean;
begin
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
result := CurrThread.Client.MWindow.Unfreeze;
end;

48
Units/MMLAddon/PSInc/Wrappers/window.inc Normal file
View File

@ -0,0 +1,48 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
window.inc for the Mufasa Macro Library
}
procedure SetDesktopAsClient;
begin;
CurrThread.Client.MWindow.SetDesktop;
end;
procedure SetTargetBitmap(bitmap: Integer);
begin;
With CurrThread.Client do
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
end;
procedure GetClientDimensions(var w, h: integer);
begin
CurrThread.Client.MWindow.GetDimensions(w, h);
end;
function Freeze: boolean;
begin
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
result := CurrThread.Client.MWindow.Unfreeze;
end;

24
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -58,10 +58,23 @@ Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
{window}
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
Sender.AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
{other}
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
Sender.AddFunction(@CreateForm,'function CreateForm : TForm;');
Sender.AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
{Color + Color Finders}
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
@ -71,15 +84,14 @@ Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs,
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
Sender.AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
{Mouse etc.}
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
{Bitmaps}
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
@ -114,4 +126,4 @@ Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');

37
Units/MMLAddon/mmlpsthread.pas
View File

@ -28,11 +28,20 @@ unit mmlpsthread;
interface
uses
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor;
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes;
type
{ TMMLPSThread }
TSyncInfo = record
V : MufasaTypes.TVariantArray;
MethodName : string;
Res : Variant;
SyncMethod : procedure of object;
OldThread : TThread;
PSScript : TPSScript;
end;
PSyncInfo = ^TSyncInfo;
TMMLPSThread = class(TThread)
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
@ -53,15 +62,17 @@ type
public
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
Client : TClient;
SyncInfo : PSyncInfo; //We need this for callthreadsafe
procedure SetPSScript(Script : string);
procedure SetDebug( Strings : TMemo );
constructor Create(CreateSuspended: Boolean);
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo);
destructor Destroy; override;
end;
threadvar
CurrThread : TMMLPSThread;
implementation
uses
MufasaTypes, dtmutil,
dtmutil,
{$ifdef mswindows}windows,{$endif}
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
uPSC_extctrls, //Compile-libs
@ -71,12 +82,10 @@ uses
Graphics, //For Graphics types
math, //Maths!
bitmaps,
forms,//Forms
lclintf; // for GetTickCount and others.
threadvar
CurrThread : TMMLPSThread;
{Some General PS Functions here}
procedure psWriteln(str : string);
{$IFDEF WINDOWS}
@ -97,12 +106,18 @@ end;
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
begin;
Writeln('We have a length of: ' + inttostr(length(v)));
CurrThread.SyncInfo^.MethodName:= ProcName;
CurrThread.SyncInfo^.V:= V;
CurrThread.SyncInfo^.PSScript := CurrThread.PSScript;
CurrThread.SyncInfo^.OldThread := CurrThread;
CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
Result := CurrThread.SyncInfo^.Res;
{ Writeln('We have a length of: ' + inttostr(length(v)));
Try
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
Except
Writeln('We has some errors :-(');
end;
end;}
end;
@ -124,8 +139,9 @@ end;
}
constructor TMMLPSThread.Create(CreateSuspended : boolean);
constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo);
begin
SyncInfo:= TheSyncInfo;
SetLength(PluginsToLoad,0);
Client := TClient.Create;
PSScript := TPSScript.Create(nil);
@ -162,6 +178,7 @@ end;
// include PS wrappers
{$I PSInc/Wrappers/other.inc}
{$I PSInc/Wrappers/bitmap.inc}
{$I PSInc/Wrappers/window.inc}
{$I PSInc/Wrappers/colour.inc}
{$I PSInc/Wrappers/math.inc}
{$I PSInc/Wrappers/mouse.inc}

57
Units/MMLCore/bitmaps.pas
View File

@ -27,18 +27,18 @@ unit bitmaps;
interface
uses
Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes,window,graphics;
Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes,graphics;
type
{ TMufasaBitmap }
TMufasaBitmap = class(TObject)
private
w,h : integer;
TransparentColor : TRGB32;
TransparentSet : boolean;
public
OnDestroy : procedure(Bitmap : TMufasaBitmap) of object;
FData : PRGB32;
Index : integer;
BmpName : string; //Optional?
@ -58,7 +58,7 @@ type
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);
procedure CopyClientToBitmap(MWindow : TMWindow; xs, ys, xe, ye: Integer);
procedure CopyClientToBitmap(MWindow : TObject; xs, ys, xe, ye: Integer);
procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
procedure Desaturate;overload;
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
@ -69,6 +69,8 @@ type
procedure Contrast(co: Extended);overload;
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
procedure Invert;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload;
constructor Create;
destructor Destroy;override;
end;
@ -100,7 +102,7 @@ implementation
uses
Windowutil,paszlib,DCPbase64,mmath,math,
colour_conv;
colour_conv,window;
function Min(a,b:integer) : integer;
begin
@ -467,7 +469,7 @@ begin
FData[i] := NewCol;
end;
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TMWindow; xs, ys, xe, ye: Integer);
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TObject; xs, ys, xe, ye: Integer);
var
wi,hi,y : integer;
PtrRet : TRetData;
@ -477,10 +479,10 @@ begin
Self.ValidatePoint(xe,ye);
wi := xe-xs + 1;
hi := ye-ys + 1;
PtrRet := MWindow.ReturnData(xs,ys,wi,hi);
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi,hi);
for y := 0 to (hi-1) do
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
MWindow.FreeReturnData;
TMWindow(MWindow).FreeReturnData;
end;
@ -715,6 +717,45 @@ begin
end;
end;
procedure TMufasaBitmap.Posterize(TargetBitmap: TMufasaBitmap; Po: integer);
var
I : integer;
PtrOld,PtrNew : PRGB32;
begin
if not InRange(Po,1,255) then
Raise exception.CreateFmt('Posterize Po(%d) out of range[1,255]',[Po]);
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
for i := (h*w-1) downto 0 do
begin;
PtrNew^.r := Round(PtrOld^.r / po) * Po;
PtrNew^.g := Round(PtrOld^.g / po) * Po;
PtrNew^.b := Round(PtrOld^.b / po) * Po;
inc(ptrOld);
inc(PtrNew);
end;
end;
procedure TMufasaBitmap.Posterize(Po: integer);
var
I : integer;
Ptr: PRGB32;
begin
if not InRange(Po,1,255) then
Raise exception.CreateFmt('Posterize Po(%d) out of range[1,255]',[Po]);
Ptr := Self.FData;
for i := (h*w-1) downto 0 do
begin;
ptr^.r := Round(ptr^.r / po) * Po;
ptr^.g := Round(ptr^.g / po) * Po;
ptr^.b := Round(ptr^.b / po) * Po;
inc(ptr);
end;
end;
constructor TMBitmaps.Create(Owner: TObject);
begin
inherited Create;
@ -823,6 +864,8 @@ end;
destructor TMufasaBitmap.Destroy;
begin
if Assigned(OnDestroy) then
OnDestroy(Self);
if Assigned(FData) then
Freemem(FData);
inherited Destroy;

52
Units/MMLCore/window.pas
View File

@ -34,6 +34,7 @@ uses
{$ENDIF}
graphics,
LCLType,
bitmaps,
LCLIntf // for ReleaseDC and such
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
@ -58,10 +59,12 @@ type
{$ENDIF}
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
function SetTarget(Bitmap : TMufasaBitmap) : integer;overload;
procedure SetWindow(Window: TMWindow);
procedure SetDesktop;
procedure OnTargetBitmapDestroy( Bitmap : TMufasaBitmap);
{
Freeze Client Feature.
This will force the MWindow unit to Store the current Client's
@ -80,6 +83,7 @@ type
FreezeState: Boolean;
FrozenData : PRGB32;
FrozenSize : TPoint;
TargetBitmap : TMufasaBitmap;
public
// Target Window Mode.
TargetMode: TTargetWindowMode;
@ -209,7 +213,9 @@ end;
procedure TMWindow.SetWindow(Window: TMWindow);
begin
case Window.TargetMode of
w_BMP, w_Window, w_HDC:
w_BMP :
Self.SetTarget(Window.TargetBitmap);
w_Window, w_HDC:
{$IFDEF WINDOWS}
Self.SetTarget(Window.TargetHandle, Window.TargetMode);
{$ELSE}
@ -239,6 +245,11 @@ begin
{$ENDIF}
end;
procedure TMWindow.OnTargetBitmapDestroy(Bitmap: TMufasaBitmap);
begin
raise Exception.CreateFmt('Our targetbitmap has been destroyed, what now?',[]);
end;
function TMWindow.GetColor(x, y: integer): TColor;
begin
{$IFDEF WINDOWS}
@ -273,6 +284,17 @@ begin
Result.IncPtrWith:= Self.FrozenSize.x - width;
end else
case Self.TargetMode of
w_BMP :
begin;
// Copy the pointer as we will perform operations on it.
TmpData := TargetBitmap.FData;
// Increase the pointer to the specified start of the data.
Inc(TmpData, ys * width + xs);
Result.Ptr := TmpData;
Result.IncPtrWith:= TargetBitmap.Width - width;
end;
w_Window:
begin
{$IFDEF MSWINDOWS}
@ -461,6 +483,16 @@ begin
Bmp.LoadFromRawImage(Raw,true);
Result := bmp;
end;
w_BMP:
begin
TempData:= GetMem((ww + 1) * (hh + 1) * sizeof(trgb32));
for y := ys to ye do
Move(TargetBitmap.FData[y*w],TempData[(y-ys) * (ww+1)],(ww+1) * SizeOf(TRGB32));
ArrDataToRawImage(TempData,Classes.Point(ww+1,hh+1),Raw);
Bmp := TBitmap.Create;
Bmp.LoadFromRawImage(Raw,true);
Result := bmp;
end;
end;
end;
@ -475,10 +507,12 @@ begin
SetForegroundWindow(Self.TargetHandle);
{$ENDIF}
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if TargetMode = w_XWindow then
begin;
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
XSetErrorHandler(Old_Handler);
end;
{$ENDIF}
end;
@ -517,6 +551,11 @@ begin
h := FrozenSize.y;
end else
case TargetMode of
w_BMP :
begin
w := TargetBitmap.Width;
h := TargetBitmap.Height;
end;
w_Window:
begin
{$IFDEF MSWINDOWS}
@ -618,5 +657,14 @@ begin
end;
function TMWindow.SetTarget(Bitmap: TMufasaBitmap): integer;
begin
if Self.Frozen then
raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
TargetBitmap := Bitmap;
self.TargetMode:= w_BMP;
Bitmap.OnDestroy:= @OnTargetBitmapDestroy;
end;
end.