mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-21 16:55:01 -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
|
||||
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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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
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
|
||||
SaveBitmap(DesaturateBitmap(Bmpz),savedir + 'desaturate.bmp');
|
||||
SaveBitmap(RotateBitmap(Bmpz,0.30*pi),savedir + 'rotated.bmp');
|
||||
SaveBitmap(PosterizeBitmap(Bmpz,75),savedir + 'posterized.bmp');
|
||||
end.
|
||||
|
@ -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;
|
||||
|
@ -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
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(@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;');
|
||||
|
@ -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}
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
@ -77,9 +80,10 @@ type
|
||||
destructor Destroy; override;
|
||||
|
||||
private
|
||||
FreezeState: Boolean;
|
||||
FrozenData : PRGB32;
|
||||
FrozenSize : TPoint;
|
||||
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);
|
||||
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.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user