mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-25 02:32:19 -05:00
Added SetTargetBitmap, and made CallThreadSafe work, hell yeah!
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:
parent
22ff72fb11
commit
ffb90926b6
File diff suppressed because it is too large
Load Diff
@ -27,7 +27,6 @@ object Form1: TForm1
|
|||||||
ParentColor = False
|
ParentColor = False
|
||||||
ParentFont = False
|
ParentFont = False
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
BookMarkOptions.OnChange = nil
|
|
||||||
Gutter.Width = 57
|
Gutter.Width = 57
|
||||||
Gutter.MouseActions = <
|
Gutter.MouseActions = <
|
||||||
item
|
item
|
||||||
@ -839,7 +838,7 @@ object Form1: TForm1
|
|||||||
Panels = <
|
Panels = <
|
||||||
item
|
item
|
||||||
Text = 'Untitled'
|
Text = 'Untitled'
|
||||||
Width = 100
|
Width = 150
|
||||||
end
|
end
|
||||||
item
|
item
|
||||||
Width = 50
|
Width = 50
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -23,6 +23,7 @@
|
|||||||
|
|
||||||
unit TestUnit;
|
unit TestUnit;
|
||||||
|
|
||||||
|
{$Undefine ProcessMessages} //Define this for processmessages in ThreadSafeCall
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
@ -87,6 +88,7 @@ type
|
|||||||
procedure MenuItemRunClick(Sender: TObject);
|
procedure MenuItemRunClick(Sender: TObject);
|
||||||
procedure MenuItemSaveAsClick(Sender: TObject);
|
procedure MenuItemSaveAsClick(Sender: TObject);
|
||||||
procedure MenuItemSaveClick(Sender: TObject);
|
procedure MenuItemSaveClick(Sender: TObject);
|
||||||
|
procedure OnLinePSScript(Sender: TObject);
|
||||||
procedure OnSyneditChange(Sender: TObject);
|
procedure OnSyneditChange(Sender: TObject);
|
||||||
procedure PickColorEvent(Sender: TObject);
|
procedure PickColorEvent(Sender: TObject);
|
||||||
procedure Redo(Sender: TObject);
|
procedure Redo(Sender: TObject);
|
||||||
@ -107,6 +109,7 @@ type
|
|||||||
Window: TMWindow;
|
Window: TMWindow;
|
||||||
Picker: TMColorPicker;
|
Picker: TMColorPicker;
|
||||||
Selector: TMWindowSelector;
|
Selector: TMWindowSelector;
|
||||||
|
procedure SafeCallThread;
|
||||||
function OpenScript : boolean;
|
function OpenScript : boolean;
|
||||||
function SaveCurrentScript : boolean;
|
function SaveCurrentScript : boolean;
|
||||||
function SaveCurrentScriptAs : boolean;
|
function SaveCurrentScriptAs : boolean;
|
||||||
@ -117,7 +120,7 @@ const
|
|||||||
WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename.
|
WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename.
|
||||||
var
|
var
|
||||||
Form1: TForm1;
|
Form1: TForm1;
|
||||||
|
CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
@ -131,7 +134,8 @@ Var
|
|||||||
MMLPSThread : TMMLPSThread;
|
MMLPSThread : TMMLPSThread;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
MMLPSThread := TMMLPSThread.Create(True);
|
CurrentSyncInfo.SyncMethod:= @Form1.SafeCallThread;
|
||||||
|
MMLPSThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
|
||||||
MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text);
|
MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text);
|
||||||
MMLPSThread.SetDebug(Form1.Memo1);
|
MMLPSThread.SetDebug(Form1.Memo1);
|
||||||
|
|
||||||
@ -216,6 +220,14 @@ begin
|
|||||||
SaveCurrentScript;
|
SaveCurrentScript;
|
||||||
end;
|
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);
|
procedure TForm1.OnSyneditChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
if not ScriptChanged then
|
if not ScriptChanged then
|
||||||
@ -290,6 +302,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
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;
|
function TForm1.OpenScript: boolean;
|
||||||
begin;
|
begin;
|
||||||
Result := False;
|
Result := False;
|
||||||
|
35
Tests/PS/FormTest.mufa
Normal file
35
Tests/PS/FormTest.mufa
Normal 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.
|
@ -155,4 +155,5 @@ begin
|
|||||||
Invertbitmap(bmpz);//Invert back
|
Invertbitmap(bmpz);//Invert back
|
||||||
SaveBitmap(DesaturateBitmap(Bmpz),savedir + 'desaturate.bmp');
|
SaveBitmap(DesaturateBitmap(Bmpz),savedir + 'desaturate.bmp');
|
||||||
SaveBitmap(RotateBitmap(Bmpz,0.30*pi),savedir + 'rotated.bmp');
|
SaveBitmap(RotateBitmap(Bmpz,0.30*pi),savedir + 'rotated.bmp');
|
||||||
|
SaveBitmap(PosterizeBitmap(Bmpz,75),savedir + 'posterized.bmp');
|
||||||
end.
|
end.
|
||||||
|
@ -132,13 +132,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
|
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
|
||||||
var
|
|
||||||
mBMP: TMufasaBitmap;
|
|
||||||
begin
|
begin
|
||||||
mBMP := CurrThread.Client.MBitmaps.GetBMP(bmp);
|
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
|
||||||
if mBMP = nil then
|
|
||||||
exit;
|
|
||||||
mBMP.CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
|
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
|
||||||
@ -227,3 +222,12 @@ begin;
|
|||||||
Bmp[Bitmap].Contrast(Bmp[result],co);
|
Bmp[Bitmap].Contrast(Bmp[result],co);
|
||||||
end;
|
end;
|
||||||
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;
|
||||||
|
@ -21,11 +21,6 @@
|
|||||||
Other.inc for the Mufasa Macro Library
|
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);
|
procedure Wait(t: Integer);
|
||||||
begin
|
begin
|
||||||
Sleep(t);
|
Sleep(t);
|
||||||
@ -46,17 +41,16 @@ begin;
|
|||||||
end;
|
end;
|
||||||
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;
|
function Distance(x1, y1, x2, y2: Integer): Integer;
|
||||||
begin;
|
begin;
|
||||||
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
|
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
|
||||||
end;
|
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
48
Units/MMLAddon/PSInc/Wrappers/window.inc
Normal 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;
|
@ -58,10 +58,23 @@ Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
|
|||||||
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
|
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
|
||||||
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
|
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
|
||||||
|
|
||||||
|
{window}
|
||||||
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
||||||
Sender.AddFunction(@Unfreeze, 'function unfreeze: 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(@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(@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;');
|
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(@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(@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(@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(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||||
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var 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(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
|
||||||
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
||||||
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
|
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(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
|
||||||
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
|
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
|
||||||
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
|
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
|
||||||
|
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
|
||||||
|
@ -28,11 +28,20 @@ unit mmlpsthread;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor;
|
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
{ TMMLPSThread }
|
{ TMMLPSThread }
|
||||||
|
TSyncInfo = record
|
||||||
|
V : MufasaTypes.TVariantArray;
|
||||||
|
MethodName : string;
|
||||||
|
Res : Variant;
|
||||||
|
SyncMethod : procedure of object;
|
||||||
|
OldThread : TThread;
|
||||||
|
PSScript : TPSScript;
|
||||||
|
end;
|
||||||
|
PSyncInfo = ^TSyncInfo;
|
||||||
|
|
||||||
TMMLPSThread = class(TThread)
|
TMMLPSThread = class(TThread)
|
||||||
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
|
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
|
||||||
@ -53,15 +62,17 @@ type
|
|||||||
public
|
public
|
||||||
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
|
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
|
||||||
Client : TClient;
|
Client : TClient;
|
||||||
|
SyncInfo : PSyncInfo; //We need this for callthreadsafe
|
||||||
procedure SetPSScript(Script : string);
|
procedure SetPSScript(Script : string);
|
||||||
procedure SetDebug( Strings : TMemo );
|
procedure SetDebug( Strings : TMemo );
|
||||||
constructor Create(CreateSuspended: Boolean);
|
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
end;
|
end;
|
||||||
|
threadvar
|
||||||
|
CurrThread : TMMLPSThread;
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
MufasaTypes, dtmutil,
|
dtmutil,
|
||||||
{$ifdef mswindows}windows,{$endif}
|
{$ifdef mswindows}windows,{$endif}
|
||||||
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
|
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
|
||||||
uPSC_extctrls, //Compile-libs
|
uPSC_extctrls, //Compile-libs
|
||||||
@ -71,12 +82,10 @@ uses
|
|||||||
Graphics, //For Graphics types
|
Graphics, //For Graphics types
|
||||||
math, //Maths!
|
math, //Maths!
|
||||||
bitmaps,
|
bitmaps,
|
||||||
|
forms,//Forms
|
||||||
lclintf; // for GetTickCount and others.
|
lclintf; // for GetTickCount and others.
|
||||||
|
|
||||||
|
|
||||||
threadvar
|
|
||||||
CurrThread : TMMLPSThread;
|
|
||||||
|
|
||||||
{Some General PS Functions here}
|
{Some General PS Functions here}
|
||||||
procedure psWriteln(str : string);
|
procedure psWriteln(str : string);
|
||||||
{$IFDEF WINDOWS}
|
{$IFDEF WINDOWS}
|
||||||
@ -97,12 +106,18 @@ end;
|
|||||||
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
|
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
|
||||||
|
|
||||||
begin;
|
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
|
Try
|
||||||
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
|
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
|
||||||
Except
|
Except
|
||||||
Writeln('We has some errors :-(');
|
Writeln('We has some errors :-(');
|
||||||
end;
|
end;}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -124,8 +139,9 @@ end;
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
constructor TMMLPSThread.Create(CreateSuspended : boolean);
|
constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo);
|
||||||
begin
|
begin
|
||||||
|
SyncInfo:= TheSyncInfo;
|
||||||
SetLength(PluginsToLoad,0);
|
SetLength(PluginsToLoad,0);
|
||||||
Client := TClient.Create;
|
Client := TClient.Create;
|
||||||
PSScript := TPSScript.Create(nil);
|
PSScript := TPSScript.Create(nil);
|
||||||
@ -162,6 +178,7 @@ end;
|
|||||||
// include PS wrappers
|
// include PS wrappers
|
||||||
{$I PSInc/Wrappers/other.inc}
|
{$I PSInc/Wrappers/other.inc}
|
||||||
{$I PSInc/Wrappers/bitmap.inc}
|
{$I PSInc/Wrappers/bitmap.inc}
|
||||||
|
{$I PSInc/Wrappers/window.inc}
|
||||||
{$I PSInc/Wrappers/colour.inc}
|
{$I PSInc/Wrappers/colour.inc}
|
||||||
{$I PSInc/Wrappers/math.inc}
|
{$I PSInc/Wrappers/math.inc}
|
||||||
{$I PSInc/Wrappers/mouse.inc}
|
{$I PSInc/Wrappers/mouse.inc}
|
||||||
|
@ -27,18 +27,18 @@ unit bitmaps;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes,window,graphics;
|
Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes,graphics;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
{ TMufasaBitmap }
|
{ TMufasaBitmap }
|
||||||
|
|
||||||
TMufasaBitmap = class(TObject)
|
TMufasaBitmap = class(TObject)
|
||||||
private
|
private
|
||||||
w,h : integer;
|
w,h : integer;
|
||||||
TransparentColor : TRGB32;
|
TransparentColor : TRGB32;
|
||||||
TransparentSet : boolean;
|
TransparentSet : boolean;
|
||||||
public
|
public
|
||||||
|
OnDestroy : procedure(Bitmap : TMufasaBitmap) of object;
|
||||||
FData : PRGB32;
|
FData : PRGB32;
|
||||||
Index : integer;
|
Index : integer;
|
||||||
BmpName : string; //Optional?
|
BmpName : string; //Optional?
|
||||||
@ -58,7 +58,7 @@ type
|
|||||||
procedure FastDrawClear(Color : TColor);
|
procedure FastDrawClear(Color : TColor);
|
||||||
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
|
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
|
||||||
procedure FastReplaceColor(OldColor, NewColor: TColor);
|
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 RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
|
||||||
procedure Desaturate;overload;
|
procedure Desaturate;overload;
|
||||||
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
|
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
|
||||||
@ -69,6 +69,8 @@ type
|
|||||||
procedure Contrast(co: Extended);overload;
|
procedure Contrast(co: Extended);overload;
|
||||||
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
|
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
|
||||||
procedure Invert;
|
procedure Invert;
|
||||||
|
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
|
||||||
|
procedure Posterize(Po : integer);overload;
|
||||||
constructor Create;
|
constructor Create;
|
||||||
destructor Destroy;override;
|
destructor Destroy;override;
|
||||||
end;
|
end;
|
||||||
@ -100,7 +102,7 @@ implementation
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Windowutil,paszlib,DCPbase64,mmath,math,
|
Windowutil,paszlib,DCPbase64,mmath,math,
|
||||||
colour_conv;
|
colour_conv,window;
|
||||||
|
|
||||||
function Min(a,b:integer) : integer;
|
function Min(a,b:integer) : integer;
|
||||||
begin
|
begin
|
||||||
@ -467,7 +469,7 @@ begin
|
|||||||
FData[i] := NewCol;
|
FData[i] := NewCol;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TMWindow; xs, ys, xe, ye: Integer);
|
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TObject; xs, ys, xe, ye: Integer);
|
||||||
var
|
var
|
||||||
wi,hi,y : integer;
|
wi,hi,y : integer;
|
||||||
PtrRet : TRetData;
|
PtrRet : TRetData;
|
||||||
@ -477,10 +479,10 @@ begin
|
|||||||
Self.ValidatePoint(xe,ye);
|
Self.ValidatePoint(xe,ye);
|
||||||
wi := xe-xs + 1;
|
wi := xe-xs + 1;
|
||||||
hi := ye-ys + 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
|
for y := 0 to (hi-1) do
|
||||||
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
|
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
|
||||||
MWindow.FreeReturnData;
|
TMWindow(MWindow).FreeReturnData;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -715,6 +717,45 @@ begin
|
|||||||
end;
|
end;
|
||||||
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);
|
constructor TMBitmaps.Create(Owner: TObject);
|
||||||
begin
|
begin
|
||||||
inherited Create;
|
inherited Create;
|
||||||
@ -823,6 +864,8 @@ end;
|
|||||||
|
|
||||||
destructor TMufasaBitmap.Destroy;
|
destructor TMufasaBitmap.Destroy;
|
||||||
begin
|
begin
|
||||||
|
if Assigned(OnDestroy) then
|
||||||
|
OnDestroy(Self);
|
||||||
if Assigned(FData) then
|
if Assigned(FData) then
|
||||||
Freemem(FData);
|
Freemem(FData);
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
|
@ -34,6 +34,7 @@ uses
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
graphics,
|
graphics,
|
||||||
LCLType,
|
LCLType,
|
||||||
|
bitmaps,
|
||||||
LCLIntf // for ReleaseDC and such
|
LCLIntf // for ReleaseDC and such
|
||||||
|
|
||||||
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
|
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
|
||||||
@ -58,10 +59,12 @@ type
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
||||||
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
||||||
|
function SetTarget(Bitmap : TMufasaBitmap) : integer;overload;
|
||||||
|
|
||||||
procedure SetWindow(Window: TMWindow);
|
procedure SetWindow(Window: TMWindow);
|
||||||
procedure SetDesktop;
|
procedure SetDesktop;
|
||||||
|
|
||||||
|
procedure OnTargetBitmapDestroy( Bitmap : TMufasaBitmap);
|
||||||
{
|
{
|
||||||
Freeze Client Feature.
|
Freeze Client Feature.
|
||||||
This will force the MWindow unit to Store the current Client's
|
This will force the MWindow unit to Store the current Client's
|
||||||
@ -80,6 +83,7 @@ type
|
|||||||
FreezeState: Boolean;
|
FreezeState: Boolean;
|
||||||
FrozenData : PRGB32;
|
FrozenData : PRGB32;
|
||||||
FrozenSize : TPoint;
|
FrozenSize : TPoint;
|
||||||
|
TargetBitmap : TMufasaBitmap;
|
||||||
public
|
public
|
||||||
// Target Window Mode.
|
// Target Window Mode.
|
||||||
TargetMode: TTargetWindowMode;
|
TargetMode: TTargetWindowMode;
|
||||||
@ -209,7 +213,9 @@ end;
|
|||||||
procedure TMWindow.SetWindow(Window: TMWindow);
|
procedure TMWindow.SetWindow(Window: TMWindow);
|
||||||
begin
|
begin
|
||||||
case Window.TargetMode of
|
case Window.TargetMode of
|
||||||
w_BMP, w_Window, w_HDC:
|
w_BMP :
|
||||||
|
Self.SetTarget(Window.TargetBitmap);
|
||||||
|
w_Window, w_HDC:
|
||||||
{$IFDEF WINDOWS}
|
{$IFDEF WINDOWS}
|
||||||
Self.SetTarget(Window.TargetHandle, Window.TargetMode);
|
Self.SetTarget(Window.TargetHandle, Window.TargetMode);
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
@ -239,6 +245,11 @@ begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
end;
|
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;
|
function TMWindow.GetColor(x, y: integer): TColor;
|
||||||
begin
|
begin
|
||||||
{$IFDEF WINDOWS}
|
{$IFDEF WINDOWS}
|
||||||
@ -273,6 +284,17 @@ begin
|
|||||||
Result.IncPtrWith:= Self.FrozenSize.x - width;
|
Result.IncPtrWith:= Self.FrozenSize.x - width;
|
||||||
end else
|
end else
|
||||||
case Self.TargetMode of
|
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:
|
w_Window:
|
||||||
begin
|
begin
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
@ -461,6 +483,16 @@ begin
|
|||||||
Bmp.LoadFromRawImage(Raw,true);
|
Bmp.LoadFromRawImage(Raw,true);
|
||||||
Result := bmp;
|
Result := bmp;
|
||||||
end;
|
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;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -475,10 +507,12 @@ begin
|
|||||||
SetForegroundWindow(Self.TargetHandle);
|
SetForegroundWindow(Self.TargetHandle);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINUX}
|
{$IFDEF LINUX}
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
if TargetMode = w_XWindow then
|
if TargetMode = w_XWindow then
|
||||||
|
begin;
|
||||||
|
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
||||||
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
|
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
|
||||||
XSetErrorHandler(Old_Handler);
|
XSetErrorHandler(Old_Handler);
|
||||||
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -517,6 +551,11 @@ begin
|
|||||||
h := FrozenSize.y;
|
h := FrozenSize.y;
|
||||||
end else
|
end else
|
||||||
case TargetMode of
|
case TargetMode of
|
||||||
|
w_BMP :
|
||||||
|
begin
|
||||||
|
w := TargetBitmap.Width;
|
||||||
|
h := TargetBitmap.Height;
|
||||||
|
end;
|
||||||
w_Window:
|
w_Window:
|
||||||
begin
|
begin
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
@ -618,5 +657,14 @@ begin
|
|||||||
|
|
||||||
end;
|
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.
|
end.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user