diff --git a/Extensions/dtm_editor.sex b/Extensions/dtm_editor.sex index e9093ce..54df28d 100644 --- a/Extensions/dtm_editor.sex +++ b/Extensions/dtm_editor.sex @@ -1,5 +1,6 @@ program DTMEditor_Extension; +{$i mml.simba} const Version = '0.5'; ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..) @@ -28,7 +29,6 @@ var Zoom: Single; p: TSDTMPointDefArray; curP: Integer; - MarkCol: Integer; PaintDTM, BufferChanged: Boolean; @@ -243,7 +243,7 @@ begin begin for i := 1 to High(p) do Points := CombineTPA(Points, GetLine(Point(Max(Min(p[0].x, bmpBuffer.Width - 1), 0), Max(Min(p[0].y, bmpBuffer.Height - 1), 0)), Point(Max(Min(p[i].x, bmpBuffer.Width - 1), 0), Max(Min(p[i].y, bmpBuffer.Height - 1), 0)))); - //bmpBuffer.DrawTPA(Points, MarkCol); + bmpBuffer.DrawTPA(Points, MarkCol); DrawDots(True); BufferChanged := True; @@ -405,11 +405,8 @@ procedure LoadClientBitmap; var w, h: Integer; begin - bmp.CopyClientToBitmap(False, 0, 0, 0, 0, 1620, 1280); - //GetClientDimensions(w, h); - //bmp.SetSize(w, h); - //CopyClientToBitmap(bmp.Index, 0, 0, w - 1, h - 1); - + GetClientDimensions(w, h); + bmp.CopyClientToBitmap(client.IOManager,true,0,0,0,0,w-1,h-1); ResetBuffer; UpdateBitmap(True, False); end; @@ -560,7 +557,7 @@ end; procedure mnuClientDesktop(Sender: TObject); begin - //SetDesktopAsClient; + SetDesktopAsClient; LoadClientBitmap; end; @@ -604,7 +601,7 @@ begin BufferChanged := True; PaintDTM := False; - {h := GetImageTarget; + h := GetImageTarget; if (bmpOverlay = nil) then bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1); SetTargetBitmap(bmpBuffer.Index); @@ -626,11 +623,11 @@ begin if (Length(p) > 0) then begin - {dtm := AddSDTM(toSDTM); + dtm := Client.MDTMs.AddSDTM(toSDTM); h := GetImageTarget; if (bmpOverlay = nil) then bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1); - SetTargetBitmap(bmpBuffer.Index); + SetTargetBitmap(bmpBuffer); if FindDTMs(dtm, p1, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1) then begin @@ -645,7 +642,7 @@ begin end; SetImageTarget(h); - FreeDTM(dtm);} + FreeDTM(dtm); end; UpdateBitmap(True, False); end; @@ -671,7 +668,7 @@ var mdtm: TMDTM; sdtm: TSDTM; begin - {if InputQuery('DTM From String', 'Enter DTM string:', s) and (s <> '') then + if InputQuery('DTM From String', 'Enter DTM string:', s) and (s <> '') then begin mnuNew(nil); @@ -689,7 +686,7 @@ begin mdtm.Free; UpdateBitmap(True, False); - end;} + end; end; procedure mnuPrintDTM(Sender: TObject); @@ -698,13 +695,11 @@ var begin if (Length(p) > 0) then begin - {mdtm := SDTMToMDTM(toSDTM); - AddDTM(mdtm); - + mdtm := SDTMToMDTM(toSDTM); WriteLn(''); WriteLn(mdtm.ToString); WriteLn(''); - mdtm.Free;} + mdtm.Free; end; end; diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index 880b5cb..7d4ec55 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -30,6 +30,7 @@ type procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure RegisterMyMethods(x: TPSScript); procedure OnPSExecute(Sender: TPSScript); + function OnNeedFile(Sender: TObject;const OrginFileName: string; var FilePath, Output: string): Boolean; procedure SetEnabled(bool : boolean);override; public constructor Create(FileStr: String; StartDisabled : boolean = false); @@ -165,35 +166,13 @@ end; {$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc} procedure TSimbaPSExtension.RegisterMyMethods(x: TPSScript); - procedure SetCurrSection(s: string); begin end; - -var - AppPath, ScriptPath: string; - i: Integer; begin - AppPath := MainDir + DirectorySeparator; - ScriptPath := ExtractFileDir(Filename); - with SimbaForm, x do begin - with Comp do - begin - {$I ../../Units/MMLAddon/PSInc/pscompile.inc} - AddTypes('TStringArray','Array of String'); - AddConstantN('ExtPath','string').SetString(ExtPath); - AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )'); - AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); - AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); - - for i := 0 to high(VirtualKeys) do - AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key); - end; - {$i ../../Units/MMLAddon/PSInc/psexportedmethods.inc} - AddFunction(@ext_SDTMToMDTM,'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;'); AddFunction(@ext_GetPage,'function GetPage(const url : string) : string'); AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;'); @@ -248,6 +227,9 @@ begin end; procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); +var + AppPath, ScriptPath: string; + i: Integer; begin SIRegister_Std(x); SIRegister_Controls(x); @@ -259,6 +241,20 @@ begin SIRegister_Menus(x); SIRegister_ComCtrls(x); SIRegister_Dialogs(x); + + AppPath := MainDir + DirectorySeparator; + ScriptPath := ExtractFileDir(Filename); + with SimbaForm,x do + begin + {$I ../../Units/MMLAddon/PSInc/pscompile.inc} + AddTypes('TStringArray','Array of String'); + AddConstantN('ExtPath','string').SetString(ExtPath); + AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )'); + AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); + AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); + for i := 0 to high(VirtualKeys) do + AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key); + end; SIRegister_MML(x); RegisterDll_Compiletime(x); @@ -303,10 +299,10 @@ begin RIRegister_Dialogs(x); RegisterDLLRuntime(se); RIRegister_MML(x); - with x.FindClass('TMufasaBitmap') do +{ with x.FindClass('TMufasaBitmap') do begin RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap'); - end; + end;} se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil); se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil); @@ -322,6 +318,34 @@ begin inherited; end; +function TSimbaPSExtension.OnNeedFile(Sender: TObject; + const OrginFileName: string; var FilePath, Output: string): Boolean; +var + path: string; + f: TFileStream; +begin + with SimbaForm do + path := FindFile(FilePath,[includepath, ExtractFileDir(Filename),ExtractFileDir(OrginFileName)]); + if path = '' then + begin + psWriteln(Path + ' doesn''t exist'); + Result := false; + Exit; + end; + FilePath := path;//Yeah! + + try + f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead); + SetLength(Output, f.Size); + f.Read(Output[1], Length(Output)); + result:= true; + f.free; + except + Result := false; + psWriteln('TSimbaPSExtension.OnNeedFile'); + end; +end; + procedure TSimbaPSExtension.StartExtension; begin if assigned(PSInstance) then @@ -339,6 +363,8 @@ begin PSInstance.OnExecImport:=@RegisterPSRComponents; PSInstance.OnCompile:=@RegisterMyMethods; PSInstance.OnExecute:=@OnPSExecute; + PSInstance.OnNeedFile:=@OnNeedFile; + PSInstance.UsePreProcessor:= True; formWritelnEx(Format('Loading extension %s', [FileName])); try diff --git a/Units/MMLAddon/PSInc/Wrappers/internets.inc b/Units/MMLAddon/PSInc/Wrappers/internets.inc index 7de6157..913382f 100644 --- a/Units/MMLAddon/PSInc/Wrappers/internets.inc +++ b/Units/MMLAddon/PSInc/Wrappers/internets.inc @@ -54,5 +54,5 @@ end; procedure ps_SetProxy(Client : Integer; pHost, pPort : String); extdecl; begin -CurrThread.MInternet.GetHTTPClient(client).SetProxy(pHost, pPort); + CurrThread.MInternet.GetHTTPClient(client).SetProxy(pHost, pPort); end; diff --git a/Units/MMLAddon/PSInc/uPSC_mml.pas b/Units/MMLAddon/PSInc/uPSC_mml.pas index 18aa321..1836812 100644 --- a/Units/MMLAddon/PSInc/uPSC_mml.pas +++ b/Units/MMLAddon/PSInc/uPSC_mml.pas @@ -270,7 +270,9 @@ procedure SIRegister_TWindow(CL: TPSPascalCompiler); begin with CL.AddClassN(CL.FindClass('TWindow_Abstract'),'TWindow') do begin + {$ifdef mswindows} RegisterMethod('Constructor Create( target : Hwnd)'); + {$endif} RegisterMethod('Function GetNativeWindow : TNativeWindow'); end; end; @@ -284,8 +286,8 @@ begin RegisterMethod('Function ReceivedError : Boolean'); RegisterMethod('Procedure ResetError'); RegisterMethod('Procedure SetDesktop'); - RegisterMethod('Function SetTargetArr( ArrPtr : Integer; Size : TPoint) : integer;'); - RegisterMethod('Function SetTargetBmp( bmp : TMufasaBitmap) : integer;'); + RegisterMethod('Function SetTargetArray( ArrPtr : Integer; Size : TPoint) : integer;'); + RegisterMethod('Function SetTargetBitmap( bmp : TMufasaBitmap) : integer;'); RegisterMethod('Function TargetValid : Boolean'); RegisterMethod('Procedure BitmapDestroyed( Bitmap : TMufasaBitmap)'); RegisterMethod('Function GetColor( x, y : integer) : TColor'); diff --git a/Units/MMLAddon/PSInc/uPSR_mml.pas b/Units/MMLAddon/PSInc/uPSR_mml.pas index 61fbbf6..2f724d0 100644 --- a/Units/MMLAddon/PSInc/uPSR_mml.pas +++ b/Units/MMLAddon/PSInc/uPSR_mml.pas @@ -94,7 +94,9 @@ Function TIOManager_AbstractGetKeyMouseTarget_P(Self: TIOManager_Abstract) : TTa Function TIOManager_AbstractGetImageTarget_P(Self: TIOManager_Abstract) : TTarget;Begin Result := Self.GetImageTarget; END; Function TIOManager_AbstractSetTargetBmp_P(Self: TIOManager_Abstract; bmp : TMufasaBitmap) : integer;Begin Result := Self.SetTarget(bmp); END; Function TIOManager_AbstractSetTargetArr_P(Self: TIOManager_Abstract; ArrPtr : Integer; Size : TPoint) : integer;Begin Result := Self.SetTarget(PRGB32(ArrPtr), Size); END; +{$ifdef MSWindows} function TWindowCreate(handle : hwnd) : TWindow; begin result := TWindow.Create(handle); end; +{$endif} function TIOManagerCreate(plugin_dir : string) : TIOManager; begin result := TIOManager.Create(plugin_dir); end; function TIOManager_AbstractCreate(plugin_dir : string) : TIOManager_Abstract; begin result := TIOManager_Abstract.Create(plugin_dir); end; Function TIOManagerSetTarget_P(Self: TIOManager; target : TNativeWindow) : integer;Begin Result := Self.SetTarget(target); END; @@ -357,7 +359,9 @@ procedure RIRegister_TWindow(CL: TPSRuntimeClassImporter); begin with CL.Add(TWindow) do begin + {$ifdef MSWindows} RegisterConstructor(@TWindowCreate, 'Create'); + {$endif} RegisterMethod(@TWindow.GetNativeWindow, 'GetNativeWindow'); end; end; @@ -371,8 +375,8 @@ begin RegisterMethod(@TIOManager_Abstract.ReceivedError, 'ReceivedError'); RegisterMethod(@TIOManager_Abstract.ResetError, 'ResetError'); // RegisterVirtualAbstractMethod(TIOManager_Abstract, @TIOManager_Abstract.SetDesktop, 'SetDesktop'); - RegisterMethod(@TIOManager_AbstractSetTargetArr_P, 'SetTargetArr'); - RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBmp'); + RegisterMethod(@TIOManager_AbstractSetTargetArr_P, 'SetTargetArray'); + RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBitmap'); RegisterMethod(@TIOManager_Abstract.TargetValid, 'TargetValid'); RegisterMethod(@TIOManager_Abstract.BitmapDestroyed, 'BitmapDestroyed'); RegisterMethod(@TIOManager_Abstract.GetColor, 'GetColor');