1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-16 22:35:05 -05:00

Made some changes; Fixed some bitmap issues; Added some functions to extensions; fixed bug in PS

This commit is contained in:
Raymond 2010-04-11 21:42:42 +02:00
parent f4a443db05
commit 2759ad3a03
11 changed files with 66 additions and 29 deletions

View File

@ -19,6 +19,7 @@ begin;
'0'..'9': result := result + str[i];
end;
end;
procedure Attach;
var
Fonts : string;
@ -26,6 +27,11 @@ var
newvers :integer;
Vers : integer;
begin;
case MessageDlg('Test me!', 'Do you want to test me?',mtConfirmation, [mbNo,mbYes,mbCancel],0) of
mrYes : Writeln('hell yeah!');
mrNo : Writeln('Hell no!');
mrCancel : Writeln('CANCEL THIS SHIT!');
end;
Vers := StrToIntDef(Settings.GetKeyValueDef('FontVersion','-1'),-1);
newvers := strtointdef(GetNumbers(getpage('http://simba.villavu.com/bin/Fonts/Version')),-1);
if newVers > vers then

View File

@ -61,9 +61,6 @@ procedure TAboutForm.FormCreate(Sender: TObject);
begin
Self.Caption := format('About Simba r%d', [TestUnit.SimbaVersion]);
Self.LabelRevision.Caption := format('Revision %d', [TestUnit.SimbaVersion]);
AboutMemo.Lines.Add('---Simba---');
AboutMemo.Lines.Add('');
AboutMemo.Lines.Add('');
AboutMemo.Lines.Add('Simba is released under the GPL license.');
AboutMemo.Lines.Add(format('You are currently using version: %d',[Testunit.SimbaVersion]));
AboutMemo.Lines.Add('');

View File

@ -452,6 +452,8 @@ var
i : integer;
tmpNode : TTreeNode;
begin;
if procs = nil then
exit;
for i := 0 to Procs.Count - 1 do
if (Procs[i] is TciProcedureDeclaration) then
with Procs[i] as TciProcedureDeclaration do

View File

@ -49,7 +49,7 @@ uses
uPSC_extctrls,uPSC_menus, //Compile libs
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_extctrls,uPSR_menus, //Runtime-libs
testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
testunit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln
;
function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
@ -123,12 +123,21 @@ begin
Sender.Comp.AddConstantN('PluginPath','string').SetString(Form1.PluginPath);
Sender.Comp.AddConstantN('FontPath','string').SetString(form1.FontPath);
Sender.Comp.AddConstantN('ExtPath','string').SetString(form1.ExtPath);
Sender.Comp.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
+'on, mtCustom )');
Sender.Comp.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
+'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
Sender.Comp.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)');
Sender.AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
Sender.AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
Sender.AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;');
Sender.AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;');
Sender.AddFunction(@DirectoryExists,'Function DirectoryExists (Const Directory : String) : Boolean;');
Sender.AddFunction(@FileExists,'Function FileExists (Const FileName : String) : Boolean;');
Sender.AddFunction(@GetFiles, 'function GetFiles(Path, Ext: string): TStringArray;');
Sender.AddFunction(@GetDirectories,'function GetDirectories(Path: string): TstringArray;');
Sender.AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;');
Sender.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
Sender.AddRegisteredVariable('Simba','TForm');
Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu');

View File

@ -1866,7 +1866,7 @@ end;
procedure TForm1.MenuItemHandbookClick(Sender: TObject);
begin
OpenURL('http://vila.villavu.com/mufasa/mufasa_ps_handbook/');
OpenURL('http://wizzup.org/simba/doc/ps_handbook/');
end;
procedure TForm1.MenuItemColourHistoryClick(Sender: TObject);
@ -2713,9 +2713,11 @@ end;
procedure TForm1.SafeCallThread;
var
thread: TMThread;
LocalCopy : TSyncInfo;
begin
mDebugLn('Executing : ' + CurrentSyncInfo.MethodName);
thread:= TMThread(CurrentSyncInfo.OldThread);
LocalCopy := CurrentSyncInfo;
mDebugLn('Executing : ' + LocalCopy.MethodName);
thread:= TMThread(LocalCopy.OldThread);
mmlpsthread.CurrThread:= thread;
try
if thread is TPSThread then
@ -2723,7 +2725,7 @@ begin
with TPSThread(thread).PSScript do
begin
OnLine:=@OnLinePSScript;
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V^,Exec.GetProc(CurrentSyncInfo.MethodName));
LocalCopy.Res^:= Exec.RunProcPVar(LocalCopy.V^,Exec.GetProc(LocalCopy.MethodName));
Online := nil;
end;
end else

View File

@ -92,3 +92,8 @@ begin
mDebugLn('Exception in GetPage in Extensions: ' + e.message);
end;
end;
function ext_MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
result := MessageDlg(acaption,amsg,dlgtype,buttons,helpctx);
end;

View File

@ -76,6 +76,11 @@ begin
CurrThread.DebugClear();
end;
procedure ps_SetSupressExceptions(Supress : boolean);extdecl;
begin
CurrThread.Client.MFinder.WarnOnly:= Supress;
end;
procedure ps_SaveScreenshot(FileName: string); extdecl;
var
w,h : integer;

View File

@ -24,6 +24,7 @@
AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special, keep this for CPascal
{ DTM }
SetCurrSection('DTM');
AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);');
@ -109,6 +110,7 @@ AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName:
{other}
SetCurrSection('Other');
AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);');
AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
AddFunction(@ps_Wait, 'procedure wait(t: integer);');
AddFunction(@ps_Wait, 'procedure Sleep(t: integer);');

View File

@ -41,7 +41,7 @@ type
TSyncInfo = record
V : MufasaTypes.PVariantArray;
MethodName : string;
Res : Variant;
Res : ^Variant;
SyncMethod : procedure of object;
OldThread : TThread;
end;
@ -465,11 +465,18 @@ end;
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl;
begin
if GetCurrentThreadId = MainThreadID then
begin
with TPSThread(currthread).PSScript do
Result := Exec.RunProcPVar(V,Exec.GetProc(Procname));
end else
begin
CurrThread.SyncInfo^.MethodName:= ProcName;
CurrThread.SyncInfo^.V:= @V;
CurrThread.SyncInfo^.OldThread := CurrThread;
CurrThread.SyncInfo^.Res := @Result;
CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
Result := CurrThread.SyncInfo^.Res;
end;
end;
{$I PSInc/Wrappers/other.inc}

View File

@ -35,8 +35,8 @@ type
TMufasaBitmap = class(TObject)
private
w,h : integer;
TransparentColor : TRGB32;
TransparentSet : boolean;
FTransparentColor : TRGB32;
FTransparentSet : boolean;
FIndex : integer;
FName : string;
public
@ -61,9 +61,6 @@ type
function CreateTPA(SearchCol : TColor) : TPointArray;
function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(TPA : TPointArray) : TIntegerArray;
Procedure SetTransparentColor(Col : TColor);
Function GetTransparentColor : TColor;
property TransparentColorSet : boolean read TransparentSet;
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);
@ -88,6 +85,9 @@ type
procedure LoadFromTBitmap(bmp: TBitmap);
procedure LoadFromRawImage(RawImage: TRawImage);
function CreateTMask : TMask;
procedure SetTransparentColor(Col : TColor);
function GetTransparentColor : TColor;
property TransparentColorSet : boolean read FTransparentSet;
constructor Create;
destructor Destroy;override;
end;
@ -210,6 +210,7 @@ function TMBitmaps.AddBMP(_bmp: TMufasaBitmap): Integer;
begin
Result := GetNewIndex;
BmpArray[Result] := _bmp;
BmpArray[result].Index:= Result;
end;
function TMBitmaps.CopyBMP(Bitmap: integer): Integer;
@ -446,6 +447,7 @@ begin;
Result.R := Color and $ff;
Result.G := Color shr 8 and $ff;
Result.B := Color shr 16 and $ff;
Result.A := 0;
end;
function TMufasaBitmap.Copy: TMufasaBitmap;
@ -698,14 +700,14 @@ end;
procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
begin
TransparentColor:= RGBToBGR(Col);
TransparentSet:= True;
self.FTransparentSet:= True;
self.FTransparentColor:= RGBToBGR(Col);
end;
function TMufasaBitmap.GetTransparentColor: TColor;
begin
if TransparentSet then
Result := BGRToRGB(TransparentColor)
if FTransparentSet then
Result := BGRToRGB(FTransparentColor)
else
raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
end;
@ -731,16 +733,16 @@ var
MinW,MinH,TargetW,TargetH : Integer;
loopx,loopy : integer;
begin
ValidatePoint(x,y);
TargetBitmap.ValidatePoint(x,y);
TargetW := TargetBitmap.Width;
TargetH := TargetBitmap.height;
MinW := Min(w-1,TargetW-x-1);
MinH := Min(h-1,TargetH-y-1);
if TransparentSet then
if FTransparentSet then
begin;
for loopy := 0 to MinH do
for loopx := 0 to MinW do
if LongWord(FData[loopy * w + loopx]) <> LongWord(TransparentColor) then
if LongWord(FData[loopy * w + loopx]) <> LongWord(FTransparentColor) then
TargetBitmap.FData[(loopy + y) * TargetW + loopx + x] := FData[Loopy * w + loopx];
end
@ -1227,7 +1229,7 @@ constructor TMufasaBitmap.Create;
begin
inherited Create;
Name:= '';
TransparentSet:= False;
FTransparentSet:= False;
setSize(0,0);
{FData:= nil;
w := 0;

View File

@ -573,7 +573,7 @@ begin
btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
btClass :
{$IFDEF FPC_OLD_FIX}
{$IFDEF FPC}
tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
{$ELSE}