moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 01:02:17 -05:00
Code Issues Releases Wiki Activity

Small updates + added core for updater

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@353 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-12-31 18:17:49 +00:00
parent 77c45df43c
commit 568484d2e0
14 changed files with 4132 additions and 3837 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

267
Projects/MufasaTests/project1.lpi
View File

@ -11,7 +11,7 @@
<TargetFileExt Value=""/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="6"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -30,15 +30,15 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="26">
<Units Count="34">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<CursorPos X="28" Y="103"/>
<TopLine Value="84"/>
<CursorPos X="25" Y="83"/>
<TopLine Value="60"/>
<EditorIndex Value="0"/>
<UsageCount Value="105"/>
<UsageCount Value="116"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -51,10 +51,10 @@
<Unit2>
<Filename Value="../../Units/MMLCore/client.pas"/>
<UnitName Value="Client"/>
<CursorPos X="28" Y="50"/>
<TopLine Value="30"/>
<EditorIndex Value="9"/>
<UsageCount Value="45"/>
<CursorPos X="20" Y="33"/>
<TopLine Value="1"/>
<EditorIndex Value="13"/>
<UsageCount Value="49"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -69,8 +69,8 @@
<UnitName Value="Window"/>
<CursorPos X="55" Y="251"/>
<TopLine Value="236"/>
<EditorIndex Value="12"/>
<UsageCount Value="44"/>
<EditorIndex Value="17"/>
<UsageCount Value="48"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
@ -78,8 +78,8 @@
<UnitName Value="colour_conv"/>
<CursorPos X="18" Y="346"/>
<TopLine Value="307"/>
<EditorIndex Value="4"/>
<UsageCount Value="25"/>
<EditorIndex Value="9"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
@ -87,8 +87,8 @@
<UnitName Value="finder"/>
<CursorPos X="1" Y="1728"/>
<TopLine Value="1701"/>
<EditorIndex Value="3"/>
<UsageCount Value="48"/>
<EditorIndex Value="8"/>
<UsageCount Value="52"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
@ -96,8 +96,8 @@
<UnitName Value="Input"/>
<CursorPos X="72" Y="47"/>
<TopLine Value="36"/>
<EditorIndex Value="8"/>
<UsageCount Value="44"/>
<EditorIndex Value="12"/>
<UsageCount Value="48"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
@ -105,8 +105,8 @@
<UnitName Value="MufasaTypes"/>
<CursorPos X="98" Y="92"/>
<TopLine Value="76"/>
<EditorIndex Value="13"/>
<UsageCount Value="46"/>
<EditorIndex Value="18"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
@ -114,8 +114,8 @@
<UnitName Value="ocr"/>
<CursorPos X="1" Y="133"/>
<TopLine Value="108"/>
<EditorIndex Value="10"/>
<UsageCount Value="45"/>
<EditorIndex Value="15"/>
<UsageCount Value="49"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
@ -127,9 +127,11 @@
<Unit11>
<Filename Value="../../Units/MMLCore/files.pas"/>
<UnitName Value="files"/>
<CursorPos X="5" Y="42"/>
<TopLine Value="27"/>
<UsageCount Value="5"/>
<CursorPos X="22" Y="36"/>
<TopLine Value="18"/>
<EditorIndex Value="14"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="../../../../Documents/lazarus/lcl/graphics.pp"/>
@ -141,10 +143,10 @@
<Unit13>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<UnitName Value="bitmaps"/>
<CursorPos X="1" Y="905"/>
<TopLine Value="885"/>
<CursorPos X="56" Y="477"/>
<TopLine Value="435"/>
<EditorIndex Value="1"/>
<UsageCount Value="43"/>
<UsageCount Value="47"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@ -176,19 +178,19 @@
</Unit17>
<Unit18>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/ocr.inc"/>
<CursorPos X="20" Y="5"/>
<CursorPos X="20" Y="4"/>
<TopLine Value="1"/>
<EditorIndex Value="11"/>
<UsageCount Value="41"/>
<EditorIndex Value="16"/>
<UsageCount Value="45"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="../../Units/MMLCore/dtm.pas"/>
<UnitName Value="dtm"/>
<CursorPos X="92" Y="287"/>
<TopLine Value="99"/>
<EditorIndex Value="6"/>
<UsageCount Value="41"/>
<CursorPos X="89" Y="33"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="45"/>
<Loaded Value="True"/>
</Unit19>
<Unit20>
@ -196,17 +198,17 @@
<UnitName Value="dtmutil"/>
<CursorPos X="43" Y="218"/>
<TopLine Value="49"/>
<EditorIndex Value="5"/>
<UsageCount Value="37"/>
<EditorIndex Value="10"/>
<UsageCount Value="41"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="../../../../Documents/fpc/packages/fcl-base/src/custapp.pp"/>
<UnitName Value="CustApp"/>
<CursorPos X="43" Y="287"/>
<CursorPos X="59" Y="274"/>
<TopLine Value="274"/>
<EditorIndex Value="2"/>
<UsageCount Value="17"/>
<EditorIndex Value="7"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit21>
<Unit22>
@ -214,8 +216,8 @@
<UnitName Value="ocrutil"/>
<CursorPos X="22" Y="470"/>
<TopLine Value="445"/>
<EditorIndex Value="7"/>
<UsageCount Value="25"/>
<EditorIndex Value="11"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
@ -237,127 +239,190 @@
<TopLine Value="78"/>
<UsageCount Value="7"/>
</Unit25>
<Unit26>
<Filename Value="../../../../Documents/lazarus/lcl/graphtype.pp"/>
<UnitName Value="GraphType"/>
<CursorPos X="72" Y="96"/>
<TopLine Value="72"/>
<UsageCount Value="12"/>
</Unit26>
<Unit27>
<Filename Value="../../Units/Synapse/httpsend.pas"/>
<UnitName Value="httpsend"/>
<CursorPos X="1" Y="758"/>
<TopLine Value="731"/>
<EditorIndex Value="3"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="../../Units/MMLAddon/internets.pas"/>
<UnitName Value="internets"/>
<CursorPos X="9" Y="21"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit28>
<Unit29>
<Filename Value="../../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/>
<CursorPos X="14" Y="712"/>
<TopLine Value="696"/>
<UsageCount Value="10"/>
</Unit29>
<Unit30>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<UnitName Value="updater"/>
<CursorPos X="43" Y="169"/>
<TopLine Value="146"/>
<EditorIndex Value="6"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit30>
<Unit31>
<Filename Value="../../Units/Synapse/blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="3" Y="133"/>
<TopLine Value="137"/>
<EditorIndex Value="5"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit31>
<Unit32>
<Filename Value="../../Units/Synapse/ssfpc.pas"/>
<UnitName Value="ssfpc"/>
<CursorPos X="3" Y="94"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit32>
<Unit33>
<Filename Value="../../Units/Synapse/sslinux.pas"/>
<UnitName Value="sslinux"/>
<CursorPos X="1" Y="62"/>
<TopLine Value="32"/>
<UsageCount Value="10"/>
</Unit33>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="project1.lpr"/>
<Caret Line="100" Column="21" TopLine="90"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="85" Column="54" TopLine="74"/>
</Position1>
<Position2>
<Filename Value="project1.lpr"/>
<Caret Line="85" Column="33" TopLine="54"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="83" Column="24" TopLine="65"/>
</Position2>
<Position3>
<Filename Value="project1.lpr"/>
<Caret Line="118" Column="50" TopLine="89"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="90" Column="34" TopLine="67"/>
</Position3>
<Position4>
<Filename Value="project1.lpr"/>
<Caret Line="119" Column="28" TopLine="98"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="93" Column="93" TopLine="68"/>
</Position4>
<Position5>
<Filename Value="project1.lpr"/>
<Caret Line="107" Column="62" TopLine="72"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="101" Column="13" TopLine="78"/>
</Position5>
<Position6>
<Filename Value="project1.lpr"/>
<Caret Line="143" Column="40" TopLine="120"/>
<Filename Value="../../Units/Synapse/blcksock.pas"/>
<Caret Line="803" Column="33" TopLine="781"/>
</Position6>
<Position7>
<Filename Value="project1.lpr"/>
<Caret Line="144" Column="18" TopLine="109"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="106" Column="35" TopLine="78"/>
</Position7>
<Position8>
<Filename Value="project1.lpr"/>
<Caret Line="142" Column="35" TopLine="121"/>
<Filename Value="../../Units/Synapse/blcksock.pas"/>
<Caret Line="176" Column="63" TopLine="162"/>
</Position8>
<Position9>
<Filename Value="project1.lpr"/>
<Caret Line="141" Column="75" TopLine="121"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="8" Column="39" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="project1.lpr"/>
<Caret Line="155" Column="39" TopLine="121"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="109" Column="11" TopLine="98"/>
</Position10>
<Position11>
<Filename Value="project1.lpr"/>
<Caret Line="158" Column="9" TopLine="134"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="111" Column="15" TopLine="84"/>
</Position11>
<Position12>
<Filename Value="project1.lpr"/>
<Caret Line="155" Column="42" TopLine="135"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="75" Column="23" TopLine="62"/>
</Position12>
<Position13>
<Filename Value="project1.lpr"/>
<Caret Line="160" Column="32" TopLine="141"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="115" Column="13" TopLine="84"/>
</Position13>
<Position14>
<Filename Value="project1.lpr"/>
<Caret Line="156" Column="101" TopLine="129"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="70" Column="60" TopLine="45"/>
</Position14>
<Position15>
<Filename Value="project1.lpr"/>
<Caret Line="168" Column="36" TopLine="140"/>
<Filename Value="../../Units/Synapse/httpsend.pas"/>
<Caret Line="228" Column="23" TopLine="204"/>
</Position15>
<Position16>
<Filename Value="project1.lpr"/>
<Caret Line="96" Column="54" TopLine="75"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="110" Column="15" TopLine="95"/>
</Position16>
<Position17>
<Filename Value="project1.lpr"/>
<Caret Line="159" Column="38" TopLine="139"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="117" Column="44" TopLine="92"/>
</Position17>
<Position18>
<Filename Value="project1.lpr"/>
<Caret Line="199" Column="27" TopLine="170"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="30" Column="30" TopLine="11"/>
</Position18>
<Position19>
<Filename Value="project1.lpr"/>
<Caret Line="165" Column="13" TopLine="145"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="126" Column="11" TopLine="95"/>
</Position19>
<Position20>
<Filename Value="project1.lpr"/>
<Caret Line="201" Column="33" TopLine="173"/>
<Caret Line="12" Column="7" TopLine="5"/>
</Position20>
<Position21>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="59" Column="5" TopLine="37"/>
<Filename Value="../../Units/MMLCore/client.pas"/>
<Caret Line="33" Column="20" TopLine="1"/>
</Position21>
<Position22>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="61" Column="18" TopLine="50"/>
<Filename Value="../../Units/MMLCore/files.pas"/>
<Caret Line="123" Column="19" TopLine="111"/>
</Position22>
<Position23>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="74" Column="85" TopLine="48"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="140" Column="18" TopLine="117"/>
</Position23>
<Position24>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="68" Column="10" TopLine="48"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="35" Column="59" TopLine="17"/>
</Position24>
<Position25>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="62" Column="16" TopLine="48"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="131" Column="13" TopLine="113"/>
</Position25>
<Position26>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="95" Column="39" TopLine="70"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="130" Column="19" TopLine="113"/>
</Position26>
<Position27>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="68" Column="3" TopLine="34"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="131" Column="13" TopLine="112"/>
</Position27>
<Position28>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="268" Column="10" TopLine="251"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="120" Column="54" TopLine="102"/>
</Position28>
<Position29>
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="129" Column="11" TopLine="89"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="40" Column="33" TopLine="12"/>
</Position29>
<Position30>
<Filename Value="project1.lpr"/>
<Caret Line="168" Column="64" TopLine="151"/>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<Caret Line="38" Column="41" TopLine="20"/>
</Position30>
</JumpHistory>
</ProjectOptions>
@ -365,7 +430,7 @@
<Version Value="8"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/>
<OtherUnitFiles Value="$(ProjPath)/../../Units/MMLCore/;$(ProjPath)/../../Units/Misc/;$(ProjPath)/../../Units/MMLAddon/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/;$(ProjPath)/../../Units/Linux/;$(LazarusDir)/components/mouseandkeyinput/"/>
<OtherUnitFiles Value="$(ProjPath)/../../Units/MMLCore/;$(ProjPath)/../../Units/Misc/;$(ProjPath)/../../Units/MMLAddon/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/;$(ProjPath)/../../Units/Linux/;$(ProjPath)/../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/>
</SearchPaths>
<CodeGeneration>
<Optimizations>

169
Projects/MufasaTests/project1.lpr
View File

@ -10,7 +10,8 @@ uses
Forms,Interfaces,
LCLIntf,
Client,
bitmaps,{x ,}mufasatypes,dtm,dtmutil, ocrutil ,graphics ,colour_conv,math
bitmaps,{x ,}mufasatypes,dtm,dtmutil, ocrutil ,graphics ,colour_conv,math,
updater
{ you can add units after this };
@ -55,7 +56,7 @@ end;
procedure MufasaTests.DoRun;
const
{const
ocr_Limit_High = 191;
ocr_Limit_Low = 65;
@ -66,18 +67,20 @@ const
ocr_Blue = 16776960;
ocr_ItemC = 16744447;
ocr_Purple = 8388736;
ocr_Purple = 8388736; }
var
ErrorMsg: String;
Time: DWord;
{ Time: DWord;
C: TClient;
I, w, h,x,y: Integer;
dtm: pdtm;
p:tpointarray;
bmp, bmprs: TMufasaBitmap;
tbmp: TBitmap;
r,g,b:integer;
t:Dword;
t:Dword; }
up: TMMLFileDownloader;
begin
// quick check parameters
@ -95,6 +98,14 @@ begin
Exit;
end;
up := TMMLFileDownloader.Create;
up.FileURL:='http://www.villavu.com/pics/desktop.png';
up.ReplacementFile:='test.png';
up.DownloadAndSave;
up.Replace;
up.Free;
{ clOlive = false point }
{ clSilver = false shadow }
@ -102,140 +113,36 @@ begin
{ add your program here }
{ tbmp:=TBitmap.Create;
tbmp.LoadFromFile('/home/merlijn/Programs/mufasa/pics/16.bmp');
bmprs := TMufasaBitmap.Create;
bmprs.LoadFromFile('/home/merlijn/Programs/mufasa/pics/16.bmp');
C := TClient.Create;
C.MWindow.SetTarget(bmprs);
C.MWindow.GetDimensions(w, h);
bmprs.SetSize(10,10);
writeln(inttostr(clpurple));
bmp := TMufasaBitmap.Create;
bmp.CopyClientToBitmap(C.MWindow, True, 0, 0, 450, 50);
t:=gettickcount;
for y := 0 to bmp.Height - 1 do
for x := 0 to bmp.Width - 1 do
bmprs.LoadFromRawImage(tbmp.RawImage);
tbmp.Free;
tbmp := bmprs.ToTBitmap;
}
{ for y := 0 to tbmp.Height -1 do
for x := 0 to tbmp.width -1 do
begin
colortorgb(bmp.fastgetpixel(x,y),r,g,b);
// the abs(g-b) < 15 seems to help heaps when taking out crap points
if (r > ocr_Limit_High) and (g > ocr_Limit_High) and (b > ocr_Limit_High){ and (abs(g-b) < 15)} then
begin
bmp.fastsetpixel(x,y,ocr_White);
continue;
end;
if (r < ocr_Limit_Low) and (g > ocr_Limit_High) and (b > ocr_Limit_High) then
begin
bmp.fastsetpixel(x,y,ocr_Blue);
continue;
end;
if (r < ocr_Limit_Low) and (g > ocr_Limit_High) and (b < ocr_Limit_Low) then
begin
bmp.fastsetpixel(x,y,ocr_Green);
continue;
end;
// false results with fire
if(r > ocr_Limit_High) and (g > 100) and (g < ocr_Limit_High) and (b > 40) and (b < 90) then
begin
bmp.fastsetpixel(x,y,ocr_ItemC);
continue;
end;
if(r > ocr_Limit_High) and (g > ocr_Limit_High) and (b < ocr_Limit_Low) then
begin
bmp.fastsetpixel(x,y,ocr_Yellow);
continue;
end;
// better use g < 40 than ocr_Limit_Low imo
if (r > ocr_Limit_High) and (g < ocr_Limit_Low) and (b < ocr_Limit_Low) then
begin
bmp.fastsetpixel(x,y,ocr_Red);
continue;
end;
if (r < ocr_Limit_Low) and (g < ocr_Limit_Low) and (b < ocr_Limit_Low) then
begin
bmp.FastSetPixel(x,y, ocr_Purple);
continue;
end;
bmp.fastsetpixel(x,y,0);
end;
// increase height by 1, so our algo works better. (shadow)
bmp.SetSize(Bmp.Width, Bmp.Height+1);
for x := 0 to bmp.width -1 do
bmp.fastsetpixel(x,bmp.height-1,0);
for y := 0 to bmp.Height - 2 do
for x := 0 to bmp.Width - 2 do
begin
if bmp.fastgetpixel(x,y) = clPurple then
continue;
if bmp.fastgetpixel(x,y) = clBlack then
continue;
if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y+1)) and (bmp.fastgetpixel(x+1,y+1) <> clpurple) then
bmp.fastsetpixel(x,y,{clAqua}0);
end;
{ Optional - remove false shadow }
for y := bmp.Height - 1 downto 1 do
for x := bmp.Width - 1 downto 1 do
begin
if bmp.fastgetpixel(x,y) <> clPurple then
continue;
if bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x-1,y-1) then
begin
bmp.fastsetpixel(x,y,clSilver);
continue;
end;
if bmp.fastgetpixel(x-1,y-1) = 0 then
bmp.fastsetpixel(x,y,clLime);
end;
{ remove bad points }
for y := bmp.Height - 2 downto 1 do
for x := bmp.Width - 2 downto 1 do
begin
if bmp.fastgetpixel(x,y) = clPurple then
continue;
if bmp.fastgetpixel(x,y) = clBlack then
continue;
if (bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x+1,y+1) ) then
continue;
if bmp.fastgetpixel(x+1,y+1) <> clPurple then
begin
bmp.fastsetpixel(x,y,clOlive);
continue;
end;
end;
{ Dangerous removes all pixels that had no pixels on x-1 or x+1}
{ for y := 0 to bmp.Height - 2 do
for x := 1 to bmp.Width - 2 do
begin
if bmp.fastgetpixel(x,y) = clBlack then continue;
if bmp.fastgetpixel(x,y) = clPurple then continue;
if bmp.fastgetpixel(x,y) = clOlive then continue;
if bmp.fastgetpixel(x,y) = clSilver then continue;
if bmp.fastgetpixel(x,y) = clLime then continue;
if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y) ) and
(bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x-1,y) ) then
bmp.fastsetpixel(x,y,clFuchsia);
end; }
writeln(inttostr(gettickcount-t));
writeln(format('(%d, %d) = %d , %d', [x,y,tbmp.Canvas.pixels[x,y],bmprs.FastGetPixel(x,y)]));
colortorgb(tbmp.Canvas.pixels[x,y],r,g,b);
writeln(format('%d,%d,%d', [r,g,b]));
colortorgb(bmprs.FastGetPixel(x,y),r,g,b);
writeln(format('%d,%d,%d', [r,g,b]));
end; }
//bmprs.LoadFromFile('/home/merlijn/Programs/mufasa/pics/16.bmp');
{C := TClient.Create;
C.MWindow.SetTarget(bmprs); }
bmp.SaveToFile('/tmp/output.bmp');
{ bmp.SaveToFile('/tmp/output.bmp');
tbmp.SaveToFile('/tmp/output2.bmp');
//bmp.OnDestroy:=nil;
bmp.Free;
C.Free;
tbmp.Free; }
// C.Free;
// stop program loop
Terminate;

7
Projects/SAMufasaGUI/colourhistory.pas
View File

@ -74,8 +74,7 @@ type
procedure DeleteSelected(Sender: TObject);
procedure AddColObj(c: TColourPickerObject; autoName: Boolean);
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure CHSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OkButtonClick(Sender: TObject);
@ -90,6 +89,9 @@ type
procedure SetNodeBitmap(N: TTreeNode);
procedure SaveToXML(s: String);
procedure XML2Tree(XMLDoc: TXMLDocument);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
IndexSelected: Integer;
{ public declarations }
@ -179,7 +181,6 @@ end;
procedure TColourHistoryForm.DeleteSelected(Sender: TObject);
var
i:integer;
e: TTreeNodesEnumerator;
begin

246
Projects/SAMufasaGUI/debugimage.pas
View File

@ -1,122 +1,124 @@
{
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.
Image debug window for Mufasa Macro Library
}
unit debugimage;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, bitmaps;
type
{ TDebugImgForm }
TDebugImgForm = class(TForm)
DrawImage: TImage;
procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ private declarations }
public
DispSize : TPoint;
ToDrawBmp: TMufasaBitmap;//The bitmap we should draw!
GetDbgBmp : TMufasaBitmap;
procedure BlackDebugImage;
procedure DrawBitmap;
procedure GetDebugImage;
procedure ShowDebugImgForm; //Uses the global var for w/h
{ public declarations }
end;
var
DebugImgForm: TDebugImgForm;
implementation
uses
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject);
begin
BlackDebugImage;
end;
procedure TDebugImgForm.FormHide(Sender: TObject);
begin
Form1.MenuItemDebugImage.Checked := False;
end;
procedure TDebugImgForm.FormResize(Sender: TObject);
begin
DrawImage.Picture.Graphic.Width := DrawImage.Width;
DrawImage.Picture.Graphic.Height := DrawImage.Height;
BlackDebugImage;
end;
procedure TDebugImgForm.BlackDebugImage;
begin
DrawImage.Canvas.Brush.Color:= clBlack;
DrawImage.Canvas.Pen.Color:= clBlack;
DrawImage.Canvas.Rectangle(0,0,DrawImage.Width,DrawImage.Height);
end;
procedure TDebugImgForm.DrawBitmap;
var
rawImage : TRawImage;
Bitmap : Graphics.TBitmap;
begin
if ToDrawBmp = nil then
raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil');
ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage);
Bitmap := Graphics.TBitmap.Create;
Bitmap.LoadFromRawImage(Rawimage,false);
DrawImage.Canvas.Draw(0,0,Bitmap);
Bitmap.Free;
end;
procedure TDebugImgForm.GetDebugImage;
begin;
GetDbgBmp.LoadFromRawImage(DrawImage.Picture.Bitmap.RawImage);
end;
procedure TDebugImgForm.ShowDebugImgForm;
begin
Show;
if (DispSize.x <> Width) or (DispSize.y <> height) then
begin;
Width := DispSize.x;
Height := DispSize.y;
end;
end;
initialization
{$I debugimage.lrs}
end.
{
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.
Image debug window for Mufasa Macro Library
}
unit debugimage;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, bitmaps;
type
{ TDebugImgForm }
TDebugImgForm = class(TForm)
DrawImage: TImage;
procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ private declarations }
public
DispSize : TPoint;
ToDrawBmp: TMufasaBitmap;//The bitmap we should draw!
GetDbgBmp : TMufasaBitmap;
procedure BlackDebugImage;
procedure DrawBitmap;
procedure GetDebugImage;
procedure ShowDebugImgForm; //Uses the global var for w/h
{ public declarations }
end;
var
DebugImgForm: TDebugImgForm;
implementation
uses
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject);
begin
BlackDebugImage;
end;
procedure TDebugImgForm.FormHide(Sender: TObject);
begin
Form1.MenuItemDebugImage.Checked := False;
end;
procedure TDebugImgForm.FormResize(Sender: TObject);
begin
DrawImage.Picture.Graphic.Width := DrawImage.Width;
DrawImage.Picture.Graphic.Height := DrawImage.Height;
BlackDebugImage;
end;
procedure TDebugImgForm.BlackDebugImage;
begin
DrawImage.Canvas.Brush.Color:= clBlack;
DrawImage.Canvas.Pen.Color:= clBlack;
DrawImage.Canvas.Rectangle(0,0,DrawImage.Width,DrawImage.Height);
DrawImage.Repaint;
end;
procedure TDebugImgForm.DrawBitmap;
var
rawImage : TRawImage;
Bitmap : Graphics.TBitmap;
begin
if ToDrawBmp = nil then
raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil');
ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage);
Bitmap := Graphics.TBitmap.Create;
Bitmap.LoadFromRawImage(Rawimage,false);
DrawImage.Canvas.Draw(0,0,Bitmap);
DrawImage.Repaint;
Bitmap.Free;
end;
procedure TDebugImgForm.GetDebugImage;
begin;
GetDbgBmp.LoadFromRawImage(DrawImage.Picture.Bitmap.RawImage);
end;
procedure TDebugImgForm.ShowDebugImgForm;
begin
Show;
if (DispSize.x <> Width) or (DispSize.y <> height) then
begin;
Width := DispSize.x;
Height := DispSize.y;
end;
end;
initialization
{$I debugimage.lrs}
end.

771
Projects/SAMufasaGUI/project1.lpi
View File

File diff suppressed because it is too large Load Diff

2
Projects/SAMufasaGUI/project1.lpr
View File

@ -31,7 +31,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LResources, testunit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer;
framefunctionlist, simpleanalyzer, updater;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}

48
Projects/SAMufasaGUI/testunit.lfm
View File

@ -1,11 +1,11 @@
object Form1: TForm1
Left = 273
Left = 395
Height = 557
Top = 233
Top = 267
Width = 734
ActiveControl = ScriptPanel
Caption = 'THA FUKING MUFASA'
ClientHeight = 537
ClientHeight = 532
ClientWidth = 734
KeyPreview = True
Menu = MainMenu1
@ -166,8 +166,8 @@ object Form1: TForm1
end
object StatusBar: TStatusBar
Left = 0
Height = 23
Top = 514
Height = 21
Top = 511
Width = 734
Panels = <
item
@ -185,7 +185,7 @@ object Form1: TForm1
object PanelMemo: TPanel
Left = 0
Height = 154
Top = 360
Top = 357
Width = 734
Align = alBottom
ClientHeight = 154
@ -205,19 +205,19 @@ object Form1: TForm1
Cursor = crVSplit
Left = 0
Height = 5
Top = 355
Top = 352
Width = 734
Align = alBottom
ResizeAnchor = akBottom
end
object ScriptPanel: TPanel
Left = 0
Height = 331
Height = 328
Top = 24
Width = 734
Align = alClient
BevelOuter = bvNone
ClientHeight = 331
ClientHeight = 328
ClientWidth = 734
DockSite = True
TabOrder = 4
@ -225,7 +225,7 @@ object Form1: TForm1
OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl
Left = 150
Height = 296
Height = 293
Top = 0
Width = 584
Align = alClient
@ -244,7 +244,7 @@ object Form1: TForm1
object SearchPanel: TPanel
Left = 0
Height = 35
Top = 296
Top = 293
Width = 734
Align = alBottom
BevelOuter = bvSpace
@ -340,7 +340,7 @@ object Form1: TForm1
end
object LabeledEditSearch: TLabeledEdit
Left = 104
Height = 21
Height = 27
Top = 6
Width = 174
EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -348,10 +348,10 @@ object Form1: TForm1
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 73
EditLabel.Height = 14
EditLabel.Top = 9
EditLabel.Width = 28
EditLabel.Left = 67
EditLabel.Height = 18
EditLabel.Top = 10
EditLabel.Width = 34
EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False
LabelPosition = lpLeft
@ -364,9 +364,9 @@ object Form1: TForm1
end
object CheckBoxMatchCase: TCheckBox
Left = 320
Height = 17
Height = 22
Top = 7
Width = 72
Width = 97
Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick
TabOrder = 1
@ -374,29 +374,31 @@ object Form1: TForm1
end
object Splitter1: TSplitter
Left = 145
Height = 296
Height = 293
Top = 0
Width = 5
OnCanResize = Splitter1CanResize
Visible = False
end
inline frmFunctionList: TFunctionListFrame
Height = 296
Height = 293
Width = 145
ClientHeight = 296
ClientHeight = 293
ClientWidth = 145
TabOrder = 3
Visible = False
inherited FunctionList: TTreeView
Height = 275
Height = 266
Width = 145
DefaultItemHeight = 19
OnChange = FunctionListChange
OnDeletion = nil
OnEnter = FunctionListEnter
OnExit = FunctionListExit
end
inherited editSearchList: TEdit
Top = 275
Height = 27
Top = 266
Width = 145
OnExit = editSearchListExit
OnKeyPress = editSearchListKeyPress

5836
Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

393
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -1,195 +1,198 @@
{
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.
psexportedmethods.inc for the Mufasa Macro Library
}
AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
AddFunction(@psWriteln,'procedure writeln(s : string);');
{ DTM }
SetCurrSection('DTM');
AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; out dtm: pDTM): Boolean;');
AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; out p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
{maths}
SetCurrSection('Math');
AddFunction(@ceil,'function ceil(e : extended) : integer');
AddFunction(@power,'function pow(base,exponent : extended) : extended');
AddFunction(@max,'function Max(a, b: Integer): Integer;');
AddFunction(@min,'function Min(a, b: Integer): Integer;');
AddFunction(@minE,'function MinE(a, b: extended): Extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;');
AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
AddFunction(@hypot,'function Hypot(X, Y: Extended): Extended;');
AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;');
{window}
SetCurrSection('Window');
AddFunction(@Freeze, 'function freeze:boolean;');
AddFunction(@Unfreeze, 'function unfreeze: boolean;');
AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(out w, h:integer);');
AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
AddFunction(@SetTargetArray, 'procedure SetTargetArray(P: Integer; Size: TPoint);');
AddFunction(@ActivateClient, 'procedure activateclient;');
{files}
SetCurrSection('Files');
AddFunction(@ps_CreateFile, 'function CreateFile(Path: string): Integer;');
AddFunction(@ps_OpenFile, 'function OpenFile(Path: string; Shared: Boolean): Integer;');
AddFunction(@ps_RewriteFile, 'function RewriteFile(Path: string; Shared: Boolean): Integer;');
AddFunction(@ps_CloseFile, 'procedure CloseFile(FileNum: Integer);');
AddFunction(@ps_EndOfFile, 'function EndOfFile(FileNum: Integer): Boolean;');
AddFunction(@ps_FileSize, 'function FileSize(FileNum: Integer): LongInt;');
AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;');
AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
AddFunction(@ps_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
{other}
SetCurrSection('Other');
AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
AddFunction(@psWait, 'procedure wait(t: integer);');
AddFunction(@psWait, 'procedure Sleep(t: integer);');
AddFunction(@GetTickCount, 'function GetSystemTime: LongWord;');
AddFunction(@GetTickCount, 'function GetTickCount: LongWord;');
AddFunction(@GetTimeRunning,'function GetTimeRunning: LongWord;');
AddFunction(@CreateForm,'function CreateForm : TForm;');
AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
AddFunction(@ConvertTime,'procedure ConvertTime(Time : integer; var h,m,s : integer);');
AddFunction(@HakunaMatata,'procedure HakunaMatata;');
AddFunction(@TerminateScript,'procedure TerminateScript;');
AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w,h : integer);');
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp : integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap : integer;');
AddFunction(@Random,'function Random(Int : integer): integer;');
{string}
AddFunction(@Capitalize,'function Capitalize(str : string) : string;');
{web}
AddFunction(@OpenWebPage,'procedure OpenWebPage(url : string);');
{Color + Color Finders}
SetCurrSection('Color');
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@FindColor, 'function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function findcolortoleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function findcolortolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColors, 'function findcolors(out TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
AddFunction(@CountColor,'function CountColor(Color, xs, ys, xe, ye: Integer): Integer;');
AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
AddFunction(@FindColorsToleranceOptimised,'function FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorsTolerance,'function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean');
AddFunction(@FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean');
AddFunction(@ColorToHSL, 'procedure ColorToHSL(c: integer; out r,g,b: extended);');
{Mouse etc.}
SetCurrSection('Mouse');
AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
AddFunction(@GetMousePos, 'procedure GetMousePos(out x, y: integer);');
AddFunction(@HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
AddFunction(@ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
AddFunction(@ClickMouse, 'procedure ClickMouse(x, y: integer; clickType: integer);');
{Keyboard}
SetCurrSection('Keyboard');
AddFunction(@KeyDown, 'procedure KeyDown(key: Word);');
AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
AddFunction(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function isKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
{ OCR}
SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;');
{Bitmaps}
SetCurrSection('Bitmaps');
AddFunction(@GetMufasaBitmap,'function GetMufasaBitmap(bmp : integer) : TMufasaBitmap;');
AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; out BmpW,BmpH : integer);');
AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
AddFunction(@BitmapFromClient,'function BitmapFromClient(const xs, ys, xe, ye: Integer): Integer;');
AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; out x, y: Integer): Boolean;');
AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;');
AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');
AddFunction(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; out x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);');
AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);');
AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);');
{tpa}
SetCurrSection('TPA');
AddFunction(@SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;');
{
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.
psexportedmethods.inc for the Mufasa Macro Library
}
AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
AddFunction(@psWriteln,'procedure writeln(s : string);');
{ DTM }
SetCurrSection('DTM');
AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; out dtm: pDTM): Boolean;');
AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; out p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
{maths}
SetCurrSection('Math');
AddFunction(@ceil,'function ceil(e : extended) : integer');
AddFunction(@power,'function pow(base,exponent : extended) : extended');
AddFunction(@max,'function Max(a, b: Integer): Integer;');
AddFunction(@min,'function Min(a, b: Integer): Integer;');
AddFunction(@minE,'function MinE(a, b: extended): Extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;');
AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
AddFunction(@hypot,'function Hypot(X, Y: Extended): Extended;');
AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;');
{window}
SetCurrSection('Window');
AddFunction(@Freeze, 'function freeze:boolean;');
AddFunction(@Unfreeze, 'function unfreeze: boolean;');
AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(out w, h:integer);');
AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
AddFunction(@SetTargetArray, 'procedure SetTargetArray(P: Integer; Size: TPoint);');
AddFunction(@ActivateClient, 'procedure activateclient;');
{files}
SetCurrSection('Files');
AddFunction(@ps_CreateFile, 'function CreateFile(Path: string): Integer;');
AddFunction(@ps_OpenFile, 'function OpenFile(Path: string; Shared: Boolean): Integer;');
AddFunction(@ps_RewriteFile, 'function RewriteFile(Path: string; Shared: Boolean): Integer;');
AddFunction(@ps_CloseFile, 'procedure CloseFile(FileNum: Integer);');
AddFunction(@ps_EndOfFile, 'function EndOfFile(FileNum: Integer): Boolean;');
AddFunction(@ps_FileSize, 'function FileSize(FileNum: Integer): LongInt;');
AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;');
AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
AddFunction(@ps_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
{other}
SetCurrSection('Other');
AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
AddFunction(@psWait, 'procedure wait(t: integer);');
AddFunction(@psWait, 'procedure Sleep(t: integer);');
AddFunction(@GetTickCount, 'function GetSystemTime: LongWord;');
AddFunction(@GetTickCount, 'function GetTickCount: LongWord;');
AddFunction(@GetTimeRunning,'function GetTimeRunning: LongWord;');
AddFunction(@CreateForm,'function CreateForm : TForm;');
AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
AddFunction(@ConvertTime,'procedure ConvertTime(Time : integer; var h,m,s : integer);');
AddFunction(@HakunaMatata,'procedure HakunaMatata;');
AddFunction(@TerminateScript,'procedure TerminateScript;');
AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w,h : integer);');
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp : integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap : integer;');
AddFunction(@Random,'function Random(Int : integer): integer;');
{string}
AddFunction(@Capitalize,'function Capitalize(str : string) : string;');
{web}
AddFunction(@OpenWebPage,'procedure OpenWebPage(url : string);');
AddFunction(@ps_GetPage,'function GetPage(url : string): string;');
{Color + Color Finders}
SetCurrSection('Color');
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@FindColor, 'function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function findcolortoleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function findcolortolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColors, 'function findcolors(out TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
AddFunction(@CountColor,'function CountColor(Color, xs, ys, xe, ye: Integer): Integer;');
AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
AddFunction(@FindColorsToleranceOptimised,'function FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorsTolerance,'function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean');
AddFunction(@FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean');
AddFunction(@ColorToHSL, 'procedure ColorToHSL(c: integer; out r,g,b: extended);');
{Mouse etc.}
SetCurrSection('Mouse');
AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
AddFunction(@GetMousePos, 'procedure GetMousePos(out x, y: integer);');
AddFunction(@HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
AddFunction(@ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
AddFunction(@ClickMouse, 'procedure ClickMouse(x, y: integer; clickType: integer);');
{Keyboard}
SetCurrSection('Keyboard');
AddFunction(@KeyDown, 'procedure KeyDown(key: Word);');
AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
AddFunction(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function isKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
{ OCR}
SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;');
{Bitmaps}
SetCurrSection('Bitmaps');
AddFunction(@GetMufasaBitmap,'function GetMufasaBitmap(bmp : integer) : TMufasaBitmap;');
AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; out BmpW,BmpH : integer);');
AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
AddFunction(@BitmapFromClient,'function BitmapFromClient(const xs, ys, xe, ye: Integer): Integer;');
AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; out x, y: Integer): Boolean;');
AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;');
AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');
AddFunction(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; out x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);');
AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);');
AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);');
{tpa}
SetCurrSection('TPA');
AddFunction(@SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;');

40
Units/MMLAddon/internets.pas
View File

@ -1,13 +1,27 @@
unit internets;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
implementation
end.
unit internets;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
function GetPage(URL: String): String;
implementation
uses
httpsend;
function GetPage(URL: String): String;
var
s: TStringList;
begin
s:=TStringList.Create;
HttpGetText(URL, s);
result := String(s.GetText);
s.Free;
end;
end.

2
Units/MMLAddon/mmlpsthread.pas
View File

@ -112,6 +112,7 @@ uses
uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types
math, //Maths!
internets, // internets
strutils,
input,
tpa, //Tpa stuff
@ -225,6 +226,7 @@ end;
{$I PSInc/Wrappers/keyboard.inc}
{$I PSInc/Wrappers/dtm.inc}
{$I PSInc/Wrappers/ocr.inc}
{$I PSInc/Wrappers/internets.inc}
procedure TMMLPSThread.OnProcessDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;

182
Units/MMLAddon/updater.pas Normal file
View File

@ -0,0 +1,182 @@
unit updater;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, httpsend,blcksock;
type
{ TMMLUpdateThread = class(TThread)
procedure Execute; override;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
end; }
TMemory = pointer;
TMMLFileDownloader = class(TObject)
private
FFileURL: String;
FReplacementFile: String;
FTotal: Integer;
HTTPSend: THTTPSend;
FFileSize: Integer;
FDownloaded: Boolean;
FOnChange: TProcedure;
public
constructor Create;
destructor Destroy; override;
function DownloadAndSave: Boolean;
function Replace: Boolean;
property FileURL: String read FFileURL write FFileURL;
property ReplacementFile: String read FReplacementFile write FReplacementFile;
property Downloaded: Boolean read FDownloaded;
property OnChange: TProcedure read FOnChange write FOnChange;
function GetPercentage: Integer;
private
procedure TryToGetFileSize;
procedure OnMonitor(Sender: TObject; Writing: Boolean;
const Buffer: TMemory; Len: Integer);
procedure OnStatus(Sender: TObject; Reason: THookSocketReason;
const Value: String);
end;
implementation
procedure TMMLFileDownloader.TryToGetFileSize;
var
i,p:integer;
begin
if assigned(HTTPSend.Headers) then
for i := 0 to HTTPSend.headers.count - 1 do
begin
p := Pos('Content-Length: ', HTTPSend.headers.strings[i]);
if p <> 0 then
FFileSize := StrToInt(Copy(HTTPSend.headers.strings[i],
p+length('Content-Length: '),length( HTTPSend.headers.strings[i]) - p) );
end;
end;
procedure TMMLFileDownloader.OnStatus(Sender: TObject; Reason: THookSocketReason;
const Value: String);
begin
if FFileSize = 0 then
TryToGetFileSize;
if Assigned(FOnChange) then
FOnChange();
end;
procedure TMMLFileDownloader.OnMonitor(Sender: TObject; Writing: Boolean;
const Buffer: TMemory; Len: Integer);
var
i,p:integer;
begin
if writing then exit;
Inc(FTotal, len);
if FFileSize = 0 then
TryToGetFileSize;
if Assigned(FOnChange) then
FOnChange();
// writeln('Percent done: ' + IntToStr(GetPercentage));
end;
function TMMLFileDownloader.GetPercentage: Integer;
begin
if FFileSize <> 0 then
Exit( Round( (FTotal / FFileSize) * 100.0) )
else
Exit(-1);
end;
function TMMLFileDownloader.DownloadAndSave: Boolean;
var
response: TStream;
i:integer;
f: TFileStream;
begin
HTTPSend := THTTPSend.Create;
HTTPSend.Sock.OnMonitor:=@Self.OnMonitor;
HTTPSend.Sock.OnStatus:=@Self.OnStatus;
if FReplacementFile = '' then
raise Exception.Create('ReplacementFile not set');
if FileURL = '' then
raise Exception.Create('FileURL not set');
Response := TFileStream.Create(FReplacementFile + '_', fmCreate);
try
Result := HTTPSend.HTTPMethod('GET', FileURL);
if Result then
begin
Response.Seek(0, soFromBeginning);
Response.CopyFrom(HTTPSend.Document, 0);
end;
FDownloaded := True;
finally
HTTPSend.Free;
Response.Free;
end;
end;
function TMMLFileDownloader.Replace: Boolean;
begin
if not Downloaded then
raise Exception.Create('Nothing downloaded');
if FReplacementFile = '' then
raise Exception.Create('ReplacementFile not set');
if not FileExists(FReplacementFile) then
raise Exception.Create('ReplacementFile not found');
if not FileExists(FReplacementFile+ '_') then
raise Exception.Create('ReplacementFile + _ not found');
RenameFile(FReplacementFile, FReplacementFile+'_old_');
RenameFile(FReplacementFile+'_', FReplacementFile);
DeleteFile(FReplacementFile+'_old_');
end;
constructor TMMLFileDownloader.Create;
begin
inherited Create;
FTotal := 0;
FFileSize := 0;
FDownloaded := False;
FReplacementFile:='';
FFileURL := '';
end;
destructor TMMLFileDownloader.Destroy;
begin
inherited;
end;
end.

2
Units/MMLCore/finder.pas
View File

@ -1797,7 +1797,7 @@ var
// Bitwise
// TODO: Change to record. One that indicates if there is a match at bit i
// and one that indicates it has already been matched at bit i...
// and one that indicates it has already been tested at bit i...
b: Array of Array of Integer;
// bounds

4
Units/MMLCore/window.pas
View File

@ -330,7 +330,7 @@ begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
Self.XWindowImage := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, width, height, AllPlanes, ZPixmap);
if QWord(Self.XWindowImage) = 0 then
if Self.XWindowImage = nil then
begin
Writeln('ReturnData: XGetImage Error. Dumping data now:');
Writeln('xs, ys, width, height: ' + inttostr(xs) + ', ' + inttostr(ys) +
@ -377,7 +377,7 @@ begin
if not Self.XImageFreed then
begin
Self.XImageFreed:=True;
if(QWord(Self.XWindowImage) <> 0) then // 0, nil?
if(Self.XWindowImage <> nil) then
begin
XDestroyImage(Self.XWindowImage);
end;