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:
parent
f4a443db05
commit
2759ad3a03
@ -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
|
||||
|
@ -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('');
|
||||
|
@ -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
|
||||
|
@ -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');
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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);');
|
||||
|
@ -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}
|
||||
|
@ -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;
|
||||
|
@ -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}
|
||||
|
Loading…
Reference in New Issue
Block a user