1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 09:12:19 -05:00
This commit is contained in:
Merlijn Wajer 2010-04-05 23:39:32 +02:00
commit fac150bfa9
49 changed files with 3106 additions and 2574 deletions

View File

@ -10,10 +10,32 @@ begin
Writeln('Free your extension here');
end;
procedure Attach;
function GetNumbers(const str : string) : string;
var
i : integer;
begin;
Settings.SetKeyValue('TestSetting','1337');
Writeln('Your extension has been enabled, do stuff here');
for i := 1 to length(str) do
case str[i] of
'0'..'9': result := result + str[i];
end;
end;
procedure Attach;
var
Fonts : string;
Contents : string;
newvers :integer;
Vers : integer;
begin;
Vers := StrToIntDef(Settings.GetKeyValueDef('FontVersion','-1'),-1);
newvers := strtointdef(GetNumbers(getpage('http://simba.villavu.com/bin/Fonts/Version')),-1);
if newVers > vers then
begin;
Writeln('Updating your fonts!');
fonts := GetPage('http://simba.villavu.com/bin/Fonts/Fonts.tar.bz2');
if DecompressBZip2(Fonts,Contents,4096) then
UnTarEx(Contents,FontPath,true);
Settings.SetKeyValue('FontVersion',inttostr(newvers));
end;
end;
Procedure Detach;
@ -24,7 +46,7 @@ end;
//Called to retrieve the name of your extension
function GetName : string;
begin;
result := 'Test Extension';
result := 'Font updater example';
end;
//Called to retrieve the version of your extension

View File

@ -14,7 +14,10 @@ type
Const
RESULT_OK = 0;
RESULT_ERROR = 1;
RESULT_ERROR = -1;
MOUSE_UP = 0;
MOUSE_DOWN = 1;
var
C: TClient;
@ -36,7 +39,7 @@ end;
{ Mouse }
function getmousepos(var t: tpoint): integer; cdecl;
function getMousePos(var t: tpoint): integer; cdecl;
begin
try
@ -50,17 +53,60 @@ begin
end;
end;
{function ConvIntClickType(Int : Integer) : TClickType;inline;
begin;
case int of
ps_mouse_right : result := mouse_Right;
ps_mouse_left : result := mouse_left;
ps_mouse_middle: result := mouse_middle;
else
raise exception.CreateFMT('Unknown Clicktype (%d) passed.',[int]);
function setMousePos(var t: tpoint): integer; cdecl;
begin
try
C.IOManager.SetMousePos(t.x,t.y);
result := RESULT_OK;
except on e : Exception do
begin
result := RESULT_ERROR;
last_error := PChar(e.Message);
end;
end; }
end;
end;
function ConvIntClickType(Int : Integer) : TClickType;inline;
begin
case int of
0 : result := mouse_Left;
1 : result := mouse_Right;
2: result := mouse_Middle;
end;
end;
function getMouseButtonState(But: Integer): Integer;
begin
try
if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then
result := MOUSE_DOWN;
except on e : Exception do
begin
result := RESULT_ERROR;
last_error := PChar(e.Message);
end;
end;
end;
function setMouseButtonState(But, State, X, Y: Integer): Integer;
begin
try
if State = MOUSE_UP then
begin
C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end else if state = MOUSE_DOWN then
begin
C.IOManager.HoldMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end;
except on e : Exception do
begin
result := RESULT_ERROR;
last_error := PChar(e.Message);
end;
end;
end;
function returnpoints: PTPoint; cdecl;
@ -170,7 +216,10 @@ end;
exports
test,
init,
getmousepos,
getMousePos,
setMousePos,
getMouseButtonState,
setMouseButtonState,
returnpoints,
printpoints,
hoi,

View File

@ -3,6 +3,7 @@
from ctypes import *
import platform
from mmlmouse import Mouse
from time import sleep
class MMLCoreException(Exception):
def __init__(self, err):
@ -24,7 +25,20 @@ class MMLCore(object):
DLL = MMLCore('../libmml.so')
m = Mouse(DLL)
print m._getMousePos()
print m[(Mouse.Pos, Mouse.Left, Mouse.Right)]
m[(Mouse.Pos, Mouse.Right)] = ((300,300), True)
print m.getButtonStates()
sleep(2)
# Reset all buttons..
m[(Mouse.Left, Mouse.Right, Mouse.Middle)] = [False for x in range(3)]
for v in zip((Mouse.Left, Mouse.Right), m[(Mouse.Left, Mouse.Right)]):
print v
print m.getPos()
del DLL

View File

@ -1,10 +1,19 @@
from ctypes import *
from mmltypes import POINT, PPOINT
from mmltypes import isiterable
class MouseException(Exception):
def __init__(self, err):
Exception.__init__(self, err)
# Usage:
class Mouse(object):
# _mc = MMLCore reference.
_mc = None
Left ='Left'
Right = 'Right'
Middle = 'Middle'
Pos = 'Pos'
# last pointer position
_lpp = (0, 0)
@ -14,30 +23,130 @@ class Mouse(object):
self._mc = MC
self._initialiseDLLFuncs()
pass
def setPos(self, pos):
return self.__setitem__(Mouse.Pos, pos)
def _initialiseDLLFuncs(self):
self._mc.dll.getmousepos.restype = c_int
self._mc.dll.getmousepos.argtypes = [PPOINT]
pass
def getPos(self):
return self._getMousePos()
def getButtonStates(self):
return zip(self._getButtons().keys(), \
self.__getitem__(self._getButtons().keys()))
def setButtonState(self, button, downup):
return self.__setitem__(button, downup)
# Will be used to get the states of the mouse
def __getitem__(self, item):
pass
'''Can currently return the state of mouse buttons as well as the
mouse position. Supports iterable arguments'''
if isiterable(item):
res = []
for i in item:
if i == self.Pos:
res.append(self._getMousePos())
elif i in self._getButtons().keys():
res.append(self._getMouseButtonState(self._buttonToInt(i)))
else:
raise MouseException('Invalid mouse button')
return res
else:
if item == self.Pos:
return self._getMousePos()
if item in self._getButtons().keys():
return self._getMouseButtonState(self_buttonToInt(item))
raise MouseException('item is not iterable nor a (valid) string')
# Will be used to set states of the mouse
def __setitem__(self, item, value):
pass
'''Can currently set the state of mouse buttons as well as the
mouse position. Supports iterable arguments'''
ak = self._getButtons().keys() + [self.Pos]
# internal function
if isiterable(item) and isiterable(value):
isfalse = lambda x: True if not x in ak else False
for i in map(isfalse, item):
if i:
raise MouseException('One of the items is not valid. Items:', item)
if len(item) != len(value):
raise MouseException('Not enough values for items')
for i, v in dict(zip(item, value)).iteritems():
if i == self.Pos:
self._setMousePos(v)
elif i in self._getButtons().keys():
self._setMouseButtonState(self._buttonToInt(i), \
1 if v else 0)
return
else:
if item in ak:
if item == self.Pos:
self_.setMousePos(value)
elif item in self._getButtons().keys():
self._setMouseButtonState(self._buttonToInt(item), \
1 if value else 0)
return
else:
raise MouseException('Invalid item / value')
raise MouseException('FIXME')
# Tools
def _getButtons(self):
'''Return mouse buttons with their corresponding button DLL number as dict'''
return {self.Left : 0, self.Right : 1, self.Middle : 2}
def _buttonToInt(self, button):
'''Return button number for button'''
return self._getButtons()[button]
# Internal DLL stuff
def _getMousePos(self):
ret = POINT()
ok = self._mc.dll.getmousepos(byref(ret))
ok = self._mc.dll.getMousePos(byref(ret))
# FIXME: Perhaps use some sort of assertion?
# We should print dll.last_error is ok != 0
self._lpp = (ret.x, ret.y)
return (ret.x, ret.y)
# internal function
def _setMousePos(self, p):
ret = POINT()
ret.x, ret.y = p
ok = self._mc.dll.setMousePos(byref(ret))
if ok != 0:
pass # Raise exception
self._lpp = (ret.x, ret.y)
return ok
def _getMouseButtonState(self, button):
ok = self._mc.dll.getMouseButtonState(button)
if ok < 0:
pass #Raise exception
return ok == 1
def _setMouseButtonState(self, button, state):
ok = self._mc.dll.setMouseButtonState(c_int(button), c_int(state), *map(lambda x: c_int(x), self._getMousePos()))
if ok != 0:
pass # Raise exception
return ok
def _initialiseDLLFuncs(self):
'''Define all mouse related DLL-calls'''
self._mc.dll.getMousePos.restype = c_int
self._mc.dll.getMousePos.argtypes = [PPOINT]
self._mc.dll.setMousePos.restype = c_int
self._mc.dll.setMousePos.argtypes = [PPOINT]
self._mc.dll.getMouseButtonState.restype = c_int
self._mc.dll.getMouseButtonState.argtypes = [c_int]
self._mc.dll.setMouseButtonState.restype = c_int
self._mc.dll.setMouseButtonState.argtypes = [c_int, c_int, c_int, c_int]
pass

View File

@ -6,4 +6,4 @@ class POINT(Structure):
PPOINT = POINTER(POINT)
isiterable = lambda x: hasattr(x, '__iter__')

View File

@ -1,11 +1,11 @@
unit extensionmanager;
{$mode objfpc}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,virtualextension,psextension,mufasabase,mufasatypes;
Classes, SysUtils,virtualextension,psextension,mufasabase;
type
TExtension = TVirtualSimbaExtension;
@ -38,7 +38,7 @@ var
implementation
uses
TestUnit, settingssandbox,simbasettings;
TestUnit, settingssandbox,simbasettings,MufasaTypes;
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
var
@ -149,6 +149,7 @@ begin
if HookExists(HookName) then
if ExecuteHook(HookName, Args, Result) <> 0 then
begin
mDebugLn('Execute hook failed: Hookname: %s',[hookname]);
// Not succesfull.
end;
end;

View File

@ -1,6 +1,6 @@
unit extensionmanagergui;
{$mode objfpc}
{$mode objfpc}{$H+}
interface

View File

@ -52,7 +52,6 @@ object ScriptFrame: TScriptFrame
Option = 0
Priority = 0
end>
Highlighter = SynFreePascalSyn1
Keystrokes = <
item
Command = ecUp
@ -710,19 +709,4 @@ object ScriptFrame: TScriptFrame
end
end
end
object SynFreePascalSyn1: TSynFreePascalSyn
Enabled = False
CommentAttri.Foreground = clBlue
CommentAttri.Style = [fsBold]
IdentifierAttri.Foreground = clDefault
NumberAttri.Foreground = clNavy
StringAttri.Foreground = clBlue
SymbolAttri.Foreground = clRed
DirectiveAttri.Foreground = clRed
DirectiveAttri.Style = [fsBold]
CompilerMode = pcmObjFPC
NestedComments = True
left = 320
top = 16
end
end

View File

@ -16,144 +16,137 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[
+'mand'#2#13#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9
+'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'Click'
+'Dir'#7#4'cdUp'#7'Command'#2#12#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0
+#0#0#11'Highlighter'#7#17'SynFreePascalSyn1'#10'Keystrokes'#14#1#7'Command'#7
+#4'ecUp'#8'ShortCut'#2'&'#0#1#7'Command'#7#7'ecSelUp'#8'ShortCut'#3'& '#0#1#7
+'Command'#7#10'ecScrollUp'#8'ShortCut'#3'&@'#0#1#7'Command'#7#6'ecDown'#8'Sh'
+'ortCut'#2'('#0#1#7'Command'#7#9'ecSelDown'#8'ShortCut'#3'( '#0#1#7'Command'
+#7#12'ecScrollDown'#8'ShortCut'#3'(@'#0#1#7'Command'#7#6'ecLeft'#8'ShortCut'
+#2'%'#0#1#7'Command'#7#9'ecSelLeft'#8'ShortCut'#3'% '#0#1#7'Command'#7#10'ec'
+'WordLeft'#8'ShortCut'#3'%@'#0#1#7'Command'#7#13'ecSelWordLeft'#8'ShortCut'#3
+'%`'#0#1#7'Command'#7#7'ecRight'#8'ShortCut'#2''''#0#1#7'Command'#7#10'ecSel'
+'Right'#8'ShortCut'#3''' '#0#1#7'Command'#7#11'ecWordRight'#8'ShortCut'#3''''
+'@'#0#1#7'Command'#7#14'ecSelWordRight'#8'ShortCut'#3'''`'#0#1#7'Command'#7
+#10'ecPageDown'#8'ShortCut'#2'"'#0#1#7'Command'#7#13'ecSelPageDown'#8'ShortC'
+'ut'#3'" '#0#1#7'Command'#7#12'ecPageBottom'#8'ShortCut'#3'"@'#0#1#7'Command'
+#7#15'ecSelPageBottom'#8'ShortCut'#3'"`'#0#1#7'Command'#7#8'ecPageUp'#8'Shor'
+'tCut'#2'!'#0#1#7'Command'#7#11'ecSelPageUp'#8'ShortCut'#3'! '#0#1#7'Command'
+#7#9'ecPageTop'#8'ShortCut'#3'!@'#0#1#7'Command'#7#12'ecSelPageTop'#8'ShortC'
+'ut'#3'!`'#0#1#7'Command'#7#11'ecLineStart'#8'ShortCut'#2'$'#0#1#7'Command'#7
+#14'ecSelLineStart'#8'ShortCut'#3'$ '#0#1#7'Command'#7#11'ecEditorTop'#8'Sho'
+'rtCut'#3'$@'#0#1#7'Command'#7#14'ecSelEditorTop'#8'ShortCut'#3'$`'#0#1#7'Co'
+'mmand'#7#9'ecLineEnd'#8'ShortCut'#2'#'#0#1#7'Command'#7#12'ecSelLineEnd'#8
+'ShortCut'#3'# '#0#1#7'Command'#7#14'ecEditorBottom'#8'ShortCut'#3'#@'#0#1#7
+'Command'#7#17'ecSelEditorBottom'#8'ShortCut'#3'#`'#0#1#7'Command'#7#12'ecTo'
+'ggleMode'#8'ShortCut'#2'-'#0#1#7'Command'#7#6'ecCopy'#8'ShortCut'#3'-@'#0#1
+#7'Command'#7#7'ecPaste'#8'ShortCut'#3'- '#0#1#7'Command'#7#12'ecDeleteChar'
+#8'ShortCut'#2'.'#0#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'. '#0#1#7'Command'
+#7#16'ecDeleteLastChar'#8'ShortCut'#2#8#0#1#7'Command'#7#16'ecDeleteLastChar'
+#8'ShortCut'#3#8' '#0#1#7'Command'#7#16'ecDeleteLastWord'#8'ShortCut'#3#8'@'
+#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#7#6'ecRed'
+'o'#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#2#13
+#0#1#7'Command'#7#11'ecSelectAll'#8'ShortCut'#3'A@'#0#1#7'Command'#7#6'ecCop'
+'y'#8'ShortCut'#3'C@'#0#1#7'Command'#7#13'ecBlockIndent'#8'ShortCut'#3'I@'#0
+#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#3'M@'#0#1#7'Command'#7#15'ecBloc'
+'kUnindent'#8'ShortCut'#3'U@'#0#1#7'Command'#7#7'ecPaste'#8'ShortCut'#3'V@'#0
+#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'X@'#0#1#7'Command'#7#12'ecDeleteLine'
+#8'ShortCut'#3'Y@'#0#1#7'Command'#7#11'ecDeleteEOL'#8'ShortCut'#3'Y`'#0#1#7
+'Command'#7#6'ecUndo'#8'ShortCut'#3'Z@'#0#1#7'Command'#7#6'ecRedo'#8'ShortCu'
+'t'#3'Z`'#0#1#7'Command'#7#13'ecGotoMarker0'#8'ShortCut'#3'0@'#0#1#7'Command'
+#7#13'ecGotoMarker1'#8'ShortCut'#3'1@'#0#1#7'Command'#7#13'ecGotoMarker2'#8
+'ShortCut'#3'2@'#0#1#7'Command'#7#13'ecGotoMarker3'#8'ShortCut'#3'3@'#0#1#7
+'Command'#7#13'ecGotoMarker4'#8'ShortCut'#3'4@'#0#1#7'Command'#7#13'ecGotoMa'
+'rker5'#8'ShortCut'#3'5@'#0#1#7'Command'#7#13'ecGotoMarker6'#8'ShortCut'#3'6'
+'@'#0#1#7'Command'#7#13'ecGotoMarker7'#8'ShortCut'#3'7@'#0#1#7'Command'#7#13
+'ecGotoMarker8'#8'ShortCut'#3'8@'#0#1#7'Command'#7#13'ecGotoMarker9'#8'Short'
+'Cut'#3'9@'#0#1#7'Command'#7#12'ecSetMarker0'#8'ShortCut'#3'0`'#0#1#7'Comman'
+'d'#7#12'ecSetMarker1'#8'ShortCut'#3'1`'#0#1#7'Command'#7#12'ecSetMarker2'#8
+'ShortCut'#3'2`'#0#1#7'Command'#7#12'ecSetMarker3'#8'ShortCut'#3'3`'#0#1#7'C'
+'ommand'#7#12'ecSetMarker4'#8'ShortCut'#3'4`'#0#1#7'Command'#7#12'ecSetMarke'
+'r5'#8'ShortCut'#3'5`'#0#1#7'Command'#7#12'ecSetMarker6'#8'ShortCut'#3'6`'#0
+#1#7'Command'#7#12'ecSetMarker7'#8'ShortCut'#3'7`'#0#1#7'Command'#7#12'ecSet'
+'Marker8'#8'ShortCut'#3'8`'#0#1#7'Command'#7#12'ecSetMarker9'#8'ShortCut'#3
,'9`'#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4'1'#160#0#0#0#1#7'Comman'
+'d'#7#12'EcFoldLevel2'#8'ShortCut'#4'2'#160#0#0#0#1#7'Command'#7#12'EcFoldLe'
+'vel1'#8'ShortCut'#4'3'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'
+#4'4'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4'5'#160#0#0#0#1
+#7'Command'#7#12'EcFoldLevel6'#8'ShortCut'#4'6'#160#0#0#0#1#7'Command'#7#12
+'EcFoldLevel7'#8'ShortCut'#4'7'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel8'#8
+'ShortCut'#4'8'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel9'#8'ShortCut'#4'9'
+#160#0#0#0#1#7'Command'#7#12'EcFoldLevel0'#8'ShortCut'#4'0'#160#0#0#0#1#7'Co'
+'mmand'#7#13'EcFoldCurrent'#8'ShortCut'#4'-'#160#0#0#0#1#7'Command'#7#15'EcU'
+'nFoldCurrent'#8'ShortCut'#4'+'#160#0#0#0#1#7'Command'#7#18'EcToggleMarkupWo'
+'rd'#8'ShortCut'#4'M'#128#0#0#0#1#7'Command'#7#14'ecNormalSelect'#8'ShortCut'
+#3'N`'#0#1#7'Command'#7#14'ecColumnSelect'#8'ShortCut'#3'C`'#0#1#7'Command'#7
+#12'ecLineSelect'#8'ShortCut'#3'L`'#0#1#7'Command'#7#5'ecTab'#8'ShortCut'#2#9
+#0#1#7'Command'#7#10'ecShiftTab'#8'ShortCut'#3#9' '#0#1#7'Command'#7#14'ecMa'
+'tchBracket'#8'ShortCut'#3'B`'#0#1#7'Command'#7#10'ecColSelUp'#8'ShortCut'#4
+'&'#160#0#0#0#1#7'Command'#7#12'ecColSelDown'#8'ShortCut'#4'('#160#0#0#0#1#7
+'Command'#7#12'ecColSelLeft'#8'ShortCut'#4'%'#160#0#0#0#1#7'Command'#7#13'ec'
+'ColSelRight'#8'ShortCut'#4''''#160#0#0#0#1#7'Command'#7#16'ecColSelPageDown'
+#8'ShortCut'#4'"'#160#0#0#0#1#7'Command'#7#18'ecColSelPageBottom'#8'ShortCut'
+#4'"'#224#0#0#0#1#7'Command'#7#14'ecColSelPageUp'#8'ShortCut'#4'!'#160#0#0#0
+#1#7'Command'#7#15'ecColSelPageTop'#8'ShortCut'#4'!'#224#0#0#0#1#7'Command'#7
+#17'ecColSelLineStart'#8'ShortCut'#4'$'#160#0#0#0#1#7'Command'#7#15'ecColSel'
+'LineEnd'#8'ShortCut'#4'#'#160#0#0#0#1#7'Command'#7#17'ecColSelEditorTop'#8
+'ShortCut'#4'$'#224#0#0#0#1#7'Command'#7#20'ecColSelEditorBottom'#8'ShortCut'
+#4'#'#224#0#0#0#0#12'MouseActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssSh'
+'ift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickD'
+'ir'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0
+#0#1#5'Shift'#11#7'ssShift'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'
+#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'
+#2#1#9'MoveCaret'#9#6'Option'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#5'ssAlt'#0
+#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7
+#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3#9'MoveCaret'#9#6'Option'
+#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#5'ssAlt'#0#9'ShiftMask'#11#7
+'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'Cl'
+'ickDir'#7#6'cdDown'#7'Command'#2#3#9'MoveCaret'#9#6'Option'#2#1#8'Priority'
+#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCoun'
+'t'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#12#9'MoveCaret'#8#6'Opt'
+'ion'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6
+'mbLeft'#10'ClickCount'#7#8'ccDouble'#8'ClickDir'#7#6'cdDown'#7'Command'#2#6
+#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'
+#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccTriple'#8'ClickDir'#7#6'cdD'
+'own'#7'Command'#2#7#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shif'
+'t'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#6'ccQuad'#8
+'ClickDir'#7#6'cdDown'#7'Command'#2#8#9'MoveCaret'#9#6'Option'#2#0#8'Priorit'
+'y'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#8'mbMiddle'#10'Click'
+'Count'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#10#9'MoveCaret'#9
+#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#6'ssCtrl'#0#9'ShiftMask'#11#7
+'ssShift'#5'ssAlt'#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSi'
+'ngle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#11#9'MoveCaret'#8#6'Option'#2#0#8
+'Priority'#2#0#0#0#15'MouseSelActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6
+#0#0#10'Keystrokes'#14#1#7'Command'#7#4'ecUp'#8'ShortCut'#2'&'#0#1#7'Command'
+#7#7'ecSelUp'#8'ShortCut'#3'& '#0#1#7'Command'#7#10'ecScrollUp'#8'ShortCut'#3
+'&@'#0#1#7'Command'#7#6'ecDown'#8'ShortCut'#2'('#0#1#7'Command'#7#9'ecSelDow'
+'n'#8'ShortCut'#3'( '#0#1#7'Command'#7#12'ecScrollDown'#8'ShortCut'#3'(@'#0#1
+#7'Command'#7#6'ecLeft'#8'ShortCut'#2'%'#0#1#7'Command'#7#9'ecSelLeft'#8'Sho'
+'rtCut'#3'% '#0#1#7'Command'#7#10'ecWordLeft'#8'ShortCut'#3'%@'#0#1#7'Comman'
+'d'#7#13'ecSelWordLeft'#8'ShortCut'#3'%`'#0#1#7'Command'#7#7'ecRight'#8'Shor'
+'tCut'#2''''#0#1#7'Command'#7#10'ecSelRight'#8'ShortCut'#3''' '#0#1#7'Comman'
+'d'#7#11'ecWordRight'#8'ShortCut'#3'''@'#0#1#7'Command'#7#14'ecSelWordRight'
+#8'ShortCut'#3'''`'#0#1#7'Command'#7#10'ecPageDown'#8'ShortCut'#2'"'#0#1#7'C'
+'ommand'#7#13'ecSelPageDown'#8'ShortCut'#3'" '#0#1#7'Command'#7#12'ecPageBot'
+'tom'#8'ShortCut'#3'"@'#0#1#7'Command'#7#15'ecSelPageBottom'#8'ShortCut'#3'"'
+'`'#0#1#7'Command'#7#8'ecPageUp'#8'ShortCut'#2'!'#0#1#7'Command'#7#11'ecSelP'
+'ageUp'#8'ShortCut'#3'! '#0#1#7'Command'#7#9'ecPageTop'#8'ShortCut'#3'!@'#0#1
+#7'Command'#7#12'ecSelPageTop'#8'ShortCut'#3'!`'#0#1#7'Command'#7#11'ecLineS'
+'tart'#8'ShortCut'#2'$'#0#1#7'Command'#7#14'ecSelLineStart'#8'ShortCut'#3'$ '
+#0#1#7'Command'#7#11'ecEditorTop'#8'ShortCut'#3'$@'#0#1#7'Command'#7#14'ecSe'
+'lEditorTop'#8'ShortCut'#3'$`'#0#1#7'Command'#7#9'ecLineEnd'#8'ShortCut'#2'#'
+#0#1#7'Command'#7#12'ecSelLineEnd'#8'ShortCut'#3'# '#0#1#7'Command'#7#14'ecE'
+'ditorBottom'#8'ShortCut'#3'#@'#0#1#7'Command'#7#17'ecSelEditorBottom'#8'Sho'
+'rtCut'#3'#`'#0#1#7'Command'#7#12'ecToggleMode'#8'ShortCut'#2'-'#0#1#7'Comma'
+'nd'#7#6'ecCopy'#8'ShortCut'#3'-@'#0#1#7'Command'#7#7'ecPaste'#8'ShortCut'#3
+'- '#0#1#7'Command'#7#12'ecDeleteChar'#8'ShortCut'#2'.'#0#1#7'Command'#7#5'e'
+'cCut'#8'ShortCut'#3'. '#0#1#7'Command'#7#16'ecDeleteLastChar'#8'ShortCut'#2
+#8#0#1#7'Command'#7#16'ecDeleteLastChar'#8'ShortCut'#3#8' '#0#1#7'Command'#7
+#16'ecDeleteLastWord'#8'ShortCut'#3#8'@'#0#1#7'Command'#7#6'ecUndo'#8'ShortC'
+'ut'#4#8#128#0#0#0#1#7'Command'#7#6'ecRedo'#8'ShortCut'#4#8#160#0#0#0#1#7'Co'
+'mmand'#7#11'ecLineBreak'#8'ShortCut'#2#13#0#1#7'Command'#7#11'ecSelectAll'#8
+'ShortCut'#3'A@'#0#1#7'Command'#7#6'ecCopy'#8'ShortCut'#3'C@'#0#1#7'Command'
+#7#13'ecBlockIndent'#8'ShortCut'#3'I@'#0#1#7'Command'#7#11'ecLineBreak'#8'Sh'
+'ortCut'#3'M@'#0#1#7'Command'#7#15'ecBlockUnindent'#8'ShortCut'#3'U@'#0#1#7
+'Command'#7#7'ecPaste'#8'ShortCut'#3'V@'#0#1#7'Command'#7#5'ecCut'#8'ShortCu'
+'t'#3'X@'#0#1#7'Command'#7#12'ecDeleteLine'#8'ShortCut'#3'Y@'#0#1#7'Command'
+#7#11'ecDeleteEOL'#8'ShortCut'#3'Y`'#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#3
+'Z@'#0#1#7'Command'#7#6'ecRedo'#8'ShortCut'#3'Z`'#0#1#7'Command'#7#13'ecGoto'
+'Marker0'#8'ShortCut'#3'0@'#0#1#7'Command'#7#13'ecGotoMarker1'#8'ShortCut'#3
+'1@'#0#1#7'Command'#7#13'ecGotoMarker2'#8'ShortCut'#3'2@'#0#1#7'Command'#7#13
+'ecGotoMarker3'#8'ShortCut'#3'3@'#0#1#7'Command'#7#13'ecGotoMarker4'#8'Short'
+'Cut'#3'4@'#0#1#7'Command'#7#13'ecGotoMarker5'#8'ShortCut'#3'5@'#0#1#7'Comma'
+'nd'#7#13'ecGotoMarker6'#8'ShortCut'#3'6@'#0#1#7'Command'#7#13'ecGotoMarker7'
+#8'ShortCut'#3'7@'#0#1#7'Command'#7#13'ecGotoMarker8'#8'ShortCut'#3'8@'#0#1#7
+'Command'#7#13'ecGotoMarker9'#8'ShortCut'#3'9@'#0#1#7'Command'#7#12'ecSetMar'
+'ker0'#8'ShortCut'#3'0`'#0#1#7'Command'#7#12'ecSetMarker1'#8'ShortCut'#3'1`'
+#0#1#7'Command'#7#12'ecSetMarker2'#8'ShortCut'#3'2`'#0#1#7'Command'#7#12'ecS'
+'etMarker3'#8'ShortCut'#3'3`'#0#1#7'Command'#7#12'ecSetMarker4'#8'ShortCut'#3
+'4`'#0#1#7'Command'#7#12'ecSetMarker5'#8'ShortCut'#3'5`'#0#1#7'Command'#7#12
+'ecSetMarker6'#8'ShortCut'#3'6`'#0#1#7'Command'#7#12'ecSetMarker7'#8'ShortCu'
+'t'#3'7`'#0#1#7'Command'#7#12'ecSetMarker8'#8'ShortCut'#3'8`'#0#1#7'Command'
+#7#12'ecSetMarker9'#8'ShortCut'#3'9`'#0#1#7'Command'#7#12'EcFoldLevel1'#8'Sh'
,'ortCut'#4'1'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel2'#8'ShortCut'#4'2'#160
+#0#0#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4'3'#160#0#0#0#1#7'Comman'
+'d'#7#12'EcFoldLevel1'#8'ShortCut'#4'4'#160#0#0#0#1#7'Command'#7#12'EcFoldLe'
+'vel1'#8'ShortCut'#4'5'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel6'#8'ShortCut'
+#4'6'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel7'#8'ShortCut'#4'7'#160#0#0#0#1
+#7'Command'#7#12'EcFoldLevel8'#8'ShortCut'#4'8'#160#0#0#0#1#7'Command'#7#12
+'EcFoldLevel9'#8'ShortCut'#4'9'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel0'#8
+'ShortCut'#4'0'#160#0#0#0#1#7'Command'#7#13'EcFoldCurrent'#8'ShortCut'#4'-'
+#160#0#0#0#1#7'Command'#7#15'EcUnFoldCurrent'#8'ShortCut'#4'+'#160#0#0#0#1#7
+'Command'#7#18'EcToggleMarkupWord'#8'ShortCut'#4'M'#128#0#0#0#1#7'Command'#7
+#14'ecNormalSelect'#8'ShortCut'#3'N`'#0#1#7'Command'#7#14'ecColumnSelect'#8
+'ShortCut'#3'C`'#0#1#7'Command'#7#12'ecLineSelect'#8'ShortCut'#3'L`'#0#1#7'C'
+'ommand'#7#5'ecTab'#8'ShortCut'#2#9#0#1#7'Command'#7#10'ecShiftTab'#8'ShortC'
+'ut'#3#9' '#0#1#7'Command'#7#14'ecMatchBracket'#8'ShortCut'#3'B`'#0#1#7'Comm'
+'and'#7#10'ecColSelUp'#8'ShortCut'#4'&'#160#0#0#0#1#7'Command'#7#12'ecColSel'
+'Down'#8'ShortCut'#4'('#160#0#0#0#1#7'Command'#7#12'ecColSelLeft'#8'ShortCut'
+#4'%'#160#0#0#0#1#7'Command'#7#13'ecColSelRight'#8'ShortCut'#4''''#160#0#0#0
+#1#7'Command'#7#16'ecColSelPageDown'#8'ShortCut'#4'"'#160#0#0#0#1#7'Command'
+#7#18'ecColSelPageBottom'#8'ShortCut'#4'"'#224#0#0#0#1#7'Command'#7#14'ecCol'
+'SelPageUp'#8'ShortCut'#4'!'#160#0#0#0#1#7'Command'#7#15'ecColSelPageTop'#8
+'ShortCut'#4'!'#224#0#0#0#1#7'Command'#7#17'ecColSelLineStart'#8'ShortCut'#4
+'$'#160#0#0#0#1#7'Command'#7#15'ecColSelLineEnd'#8'ShortCut'#4'#'#160#0#0#0#1
+#7'Command'#7#17'ecColSelEditorTop'#8'ShortCut'#4'$'#224#0#0#0#1#7'Command'#7
+#20'ecColSelEditorBottom'#8'ShortCut'#4'#'#224#0#0#0#0#12'MouseActions'#14#1
+#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10
+'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#1#9'MoveCare'
+'t'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9'ShiftMask'
+#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'
+#8'ClickDir'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Option'#2#1#8'Prior'
+'ity'#2#0#0#1#5'Shift'#11#5'ssAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6
+'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7
+'Command'#2#9#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#13'Lines.Stri'
+'ngs'#1#6#12'program new;'#6#5'begin'#6#4'end.'#0#7'Options'#11#12'eoAutoInd'
+'ent'#11'eoGroupUndo'#15'eoScrollPastEol'#11'eoSmartTabs'#11'eoTabIndent'#14
+'eoTabsToSpaces'#20'eoTrimTrailingSpaces'#18'eoBracketHighlight'#0#21'Bracke'
+'tHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7#13'SynEditChange'#18'OnCommand'
+'Processed'#7#23'SynEditCommandProcessed'#16'OnProcessCommand'#7#21'SynEditP'
+'rocessCommand'#20'OnProcessUserCommand'#7#25'SynEditProcessUserCommand'#19
+'OnSpecialLineColors'#7#24'SynEditSpecialLineColors'#14'OnStatusChange'#7#19
+'SynEditStatusChange'#0#244#18'TSynGutterPartList'#0#0#15'TSynGutterMarks'#0
+#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width'#2#17#12'MouseActions'
+#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'MarkupInfo.Foreground'#7#6
+'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMultiplesOf'#2#1#9'ZeroSta'
+'rt'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0#5'Width'#2#4#13'Modifi'
,'edColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0#19'TSynGutterSeparat'
+'or'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'MouseActions'#14#1#5
+'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccS'
+'ingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret'#8#6'Option'#2#0#8
+'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8
+'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14
+#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9
+'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'
+#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#1#8'Prio'
+'rity'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'Clic'
+'kCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9'MoveCaret'#8#6
+'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6'clNone'#21'Ma'
+'rkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1#5'Shift'#11#0
+#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDi'
+'r'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0
+#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9'ShiftMask'#11#6
+'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'c'
+'dDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'S'
+'hift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'
+#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'
+#2#1#8'Priority'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'SynFreePascalSyn1'
+#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18'CommentAttri.Style'
+#11#6'fsBold'#0#26'IdentifierAttri.Foreground'#7#9'clDefault'#22'NumberAttri'
+'.Foreground'#7#6'clNavy'#22'StringAttri.Foreground'#7#6'clBlue'#22'SymbolAt'
+'tri.Foreground'#7#5'clRed'#25'DirectiveAttri.Foreground'#7#5'clRed'#20'Dire'
+'ctiveAttri.Style'#11#6'fsBold'#0#12'CompilerMode'#7#9'pcmObjFPC'#14'NestedC'
+'omments'#9#4'left'#3'@'#1#3'top'#2#16#0#0#0
+'Command'#2#3#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7
+'ssShift'#5'ssAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbL'
+'eft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3#9
+'MoveCaret'#9#6'Option'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11
+#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'
+#7'Command'#2#12#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11
+#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccDouble'#8'Cl'
+'ickDir'#7#6'cdDown'#7'Command'#2#6#9'MoveCaret'#9#6'Option'#2#0#8'Priority'
+#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'
+#7#8'ccTriple'#8'ClickDir'#7#6'cdDown'#7'Command'#2#7#9'MoveCaret'#9#6'Optio'
+'n'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mb'
+'Left'#10'ClickCount'#7#6'ccQuad'#8'ClickDir'#7#6'cdDown'#7'Command'#2#8#9'M'
+'oveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11
+#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDo'
+'wn'#7'Command'#2#10#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shif'
+'t'#11#6'ssCtrl'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#6'ssCtrl'#0#6'Button'
+#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2
+#11#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#15'MouseSelActions'#14#1
+#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'cc'
+'Single'#8'ClickDir'#7#6'cdDown'#7'Command'#2#9#9'MoveCaret'#8#6'Option'#2#0
+#8'Priority'#2#0#0#0#13'Lines.Strings'#1#6#12'program new;'#6#5'begin'#6#4'e'
+'nd.'#0#7'Options'#11#12'eoAutoIndent'#11'eoGroupUndo'#15'eoScrollPastEol'#11
+'eoSmartTabs'#11'eoTabIndent'#14'eoTabsToSpaces'#20'eoTrimTrailingSpaces'#18
+'eoBracketHighlight'#0#21'BracketHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7
+#13'SynEditChange'#18'OnCommandProcessed'#7#23'SynEditCommandProcessed'#16'O'
+'nProcessCommand'#7#21'SynEditProcessCommand'#20'OnProcessUserCommand'#7#25
+'SynEditProcessUserCommand'#19'OnSpecialLineColors'#7#24'SynEditSpecialLineC'
+'olors'#14'OnStatusChange'#7#19'SynEditStatusChange'#0#244#18'TSynGutterPart'
+'List'#0#0#15'TSynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0
+#5'Width'#2#17#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'
+#21'MarkupInfo.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNum'
+'bersMultiplesOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TSynGutterCha'
+'nges'#0#5'Width'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedColor'#7#7'clG'
,'reen'#0#0#19'TSynGutterSeparator'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFoldi'
+'ng'#0#12'MouseActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'm'
+'bRight'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9
+'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11
+#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7
+#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5
+'Shift'#11#7'ssShift'#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'
+#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCar'
+'et'#8#6'Option'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'B'
+'utton'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Comm'
+'and'#2#0#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Bac'
+'kground'#7#6'clNone'#21'MarkupInfo.Foreground'#7#6'clGray'#20'MouseActionsE'
+'xpanded'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'Clic'
+'kCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6
+'Option'#2#0#8'Priority'#2#0#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6
+'ssCtrl'#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7
+#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2
+#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7
+#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15
+#9'MoveCaret'#8#6'Option'#2#1#8'Priority'#2#0#0#0#0#0#0#0#0
]);

View File

@ -46,7 +46,6 @@ type
TScriptFrame = class(TFrame)
SynEdit: TSynEdit;
SynFreePascalSyn1: TSynFreePascalSyn;
procedure SynEditChange(Sender: TObject);
procedure SynEditClickLink(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
@ -356,7 +355,13 @@ begin
try
Filter := WordAtCaret(Synedit, sp, ep);
Form1.CodeCompletionStart := Point(sp, Synedit.CaretY);
mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1);
//mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1);
s := SynEdit.Lines[SynEdit.Carety-1];
if ep > length(s) then //We are outside the real text, go back to the last char
mp.Run(ms, nil, Synedit.SelStart - ep + length(s))
else
mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1);
s := mp.GetExpressionAtPos;
if (s <> '') then
@ -602,11 +607,13 @@ begin
FScriptState:= ss_None;
ScriptErrorLine:= -1;
OwnerSheet.Caption:= ScriptName;
SynEdit.Options:= SynEdit.Options- [eoGroupUndo];
SynEdit.Options:= SynEdit.Options+ [eoGroupUndo,eoPersistentCaret];
SynEdit.Highlighter := Form1.CurrHighlighter;
SynEdit.Options:= SynEdit.Options + [eoTabIndent] - [eoSmartTabs];
SynEdit.IncrementColor.Background := $30D070;
SynEdit.HighlightAllColor.Background:= clYellow;
SynEdit.HighlightAllColor.Foreground:= clDefault;
SynEdit.TabWidth := 2;
SynEdit.BlockIndent := 2;
MarkCaret := TSynEditMarkupHighlightAllCaret(SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret]);
if assigned(MarkCaret) then
begin

View File

@ -1,6 +1,6 @@
unit psextension;
{$mode objfpc}
{$mode objfpc}{$H+}
interface
@ -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//Writeln
testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
;
function TSimbaPSExtension.HookExists(HookName: String): Boolean;
@ -116,8 +116,18 @@ end;
procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript);
begin
Sender.Comp.AddTypes('TStringArray','Array of String');
Sender.Comp.AddConstantN('AppPath','string').SetString(MainDir + DirectorySeparator);
Sender.Comp.AddConstantN('IncludePath','string').SetString(Form1.IncludePath);
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.AddFunction(@formWritelnEx,'procedure Writeln(s : string)');
Sender.AddFunction(@ext_GetPage,'function GetPage(url : string) : 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.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
Sender.AddRegisteredVariable('Simba','TForm');
Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu');
@ -158,14 +168,14 @@ procedure TSimbaPSExtension.SIRegister_Settings(Cl: TPSPascalCompiler);
begin
with cl.AddClassN(nil,'TMMLSettingsSandbox') do
begin;
RegisterMethod('function IsKey(KeyName: String): Boolean;');
RegisterMethod('function IsDirectory(KeyName: String): Boolean;');
RegisterMethod('function SetKeyValue(Keyname : string; Value : string) : boolean;');
RegisterMethod('function GetKeyValue(KeyName: String): String;');
RegisterMethod('function GetKeyValueDef(KeyName, defVal: String): String;');
RegisterMethod('function ListKeys(KeyName: String): TStringArray;');
RegisterMethod('function DeleteKey(KeyName: String): Boolean;');
RegisterMethod('function DeleteSubKeys(KeyName: String): Boolean;');
RegisterMethod('function IsKey(const KeyName: String): Boolean;');
RegisterMethod('function IsDirectory(const KeyName: String): Boolean;');
RegisterMethod('function SetKeyValue(const Keyname, Value : string) : boolean;');
RegisterMethod('function GetKeyValue(const KeyName: String): String;');
RegisterMethod('function GetKeyValueDef(const KeyName, defVal: String): String;');
RegisterMethod('function ListKeys(const KeyName: String; out Keys :TStringArray): boolean;');
RegisterMethod('function DeleteKey(const KeyName: String): Boolean;');
RegisterMethod('function DeleteSubKeys(const KeyName: String): Boolean;');
RegisterProperty('Prefix','String',iptR);
end;
end;

View File

@ -9,6 +9,7 @@ object SettingsForm: TSettingsForm
ClientWidth = 360
OnCreate = FormCreate
OnDestroy = FormDestroy
OnMouseUp = MouseUp
LCLVersion = '0.9.29'
object SettingsTreeView: TTreeView
Left = 16
@ -16,11 +17,13 @@ object SettingsForm: TSettingsForm
Top = 16
Width = 324
Anchors = [akTop, akLeft, akRight, akBottom]
DefaultItemHeight = 15
DefaultItemHeight = 19
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 0
OnDblClick = SettingsTreeViewDblClick
OnKeyPress = OnKeyPress
OnMouseUp = MouseUp
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
end
object SettingsFormButtonOK: TButton
@ -43,4 +46,30 @@ object SettingsForm: TSettingsForm
OnClick = SettingsFormButtonCancelClick
TabOrder = 2
end
object DeleteButton: TButton
Left = 120
Height = 25
Top = 511
Width = 120
Anchors = [akBottom]
Caption = 'Delete Selected'
OnClick = DeleteSelected
TabOrder = 3
end
object SettingsPopup: TPopupMenu
left = 40
top = 32
object PopupRename: TMenuItem
Caption = 'Rename'
OnClick = PopupRenameClick
end
object PopupDelete: TMenuItem
Caption = 'Delete'
OnClick = PopupDeleteClick
end
object PopupCreate: TMenuItem
Caption = 'Create subkey'
OnClick = PopupCreateKey
end
end
end

View File

@ -4,17 +4,26 @@ LazarusResources.Add('TSettingsForm','FORMDATA',[
'TPF0'#13'TSettingsForm'#12'SettingsForm'#4'Left'#3'3'#2#6'Height'#3'.'#2#3'T'
+'op'#3#173#0#5'Width'#3'h'#1#13'ActiveControl'#7#16'SettingsTreeView'#7'Capt'
+'ion'#6#14'Simba Settings'#12'ClientHeight'#3'.'#2#11'ClientWidth'#3'h'#1#8
+'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#10'LCLVersion'#6#6
+'0.9.29'#0#9'TTreeView'#16'SettingsTreeView'#4'Left'#2#16#6'Height'#3#217#1#3
+'Top'#2#16#5'Width'#3'D'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akB'
+'ottom'#0#17'DefaultItemHeight'#2#15#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAut'
+'oBoth'#8'TabOrder'#2#0#10'OnDblClick'#7#24'SettingsTreeViewDblClick'#7'Opti'
+'ons'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'
+#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoT'
+'oolTips'#0#0#0#7'TButton'#20'SettingsFormButtonOK'#4'Left'#3#9#1#6'Height'#2
+#25#3'Top'#3#255#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Ca'
+'ption'#6#2'OK'#7'OnClick'#7#25'SettingsFormButtonOKClick'#8'TabOrder'#2#1#0
+#0#7'TButton'#24'SettingsFormButtonCancel'#4'Left'#2#16#6'Height'#2#25#3'Top'
+#3#255#1#5'Width'#2'K'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#6
+'Cancel'#7'OnClick'#7#29'SettingsFormButtonCancelClick'#8'TabOrder'#2#2#0#0#0
+'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#9'OnMouseUp'#7#7
+'MouseUp'#10'LCLVersion'#6#6'0.9.29'#0#9'TTreeView'#16'SettingsTreeView'#4'L'
+'eft'#2#16#6'Height'#3#217#1#3'Top'#2#16#5'Width'#3'D'#1#7'Anchors'#11#5'akT'
+'op'#6'akLeft'#7'akRight'#8'akBottom'#0#17'DefaultItemHeight'#2#19#8'ReadOnl'
+'y'#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#10'OnDblClick'#7#24'Se'
+'ttingsTreeViewDblClick'#10'OnKeyPress'#7#10'OnKeyPress'#9'OnMouseUp'#7#7'Mo'
+'useUp'#7'Options'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepC'
+'ollapsedNodes'#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoSh'
+'owRoot'#11'tvoToolTips'#0#0#0#7'TButton'#20'SettingsFormButtonOK'#4'Left'#3
+#9#1#6'Height'#2#25#3'Top'#3#255#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8
+'akBottom'#0#7'Caption'#6#2'OK'#7'OnClick'#7#25'SettingsFormButtonOKClick'#8
+'TabOrder'#2#1#0#0#7'TButton'#24'SettingsFormButtonCancel'#4'Left'#2#16#6'He'
+'ight'#2#25#3'Top'#3#255#1#5'Width'#2'K'#7'Anchors'#11#6'akLeft'#8'akBottom'
+#0#7'Caption'#6#6'Cancel'#7'OnClick'#7#29'SettingsFormButtonCancelClick'#8'T'
+'abOrder'#2#2#0#0#7'TButton'#12'DeleteButton'#4'Left'#2'x'#6'Height'#2#25#3
+'Top'#3#255#1#5'Width'#2'x'#7'Anchors'#11#8'akBottom'#0#7'Caption'#6#15'Dele'
+'te Selected'#7'OnClick'#7#14'DeleteSelected'#8'TabOrder'#2#3#0#0#10'TPopupM'
+'enu'#13'SettingsPopup'#4'left'#2'('#3'top'#2' '#0#9'TMenuItem'#11'PopupRena'
+'me'#7'Caption'#6#6'Rename'#7'OnClick'#7#16'PopupRenameClick'#0#0#9'TMenuIte'
+'m'#11'PopupDelete'#7'Caption'#6#6'Delete'#7'OnClick'#7#16'PopupDeleteClick'
+#0#0#9'TMenuItem'#11'PopupCreate'#7'Caption'#6#13'Create subkey'#7'OnClick'#7
+#14'PopupCreateKey'#0#0#0#0
]);

View File

@ -1,24 +1,37 @@
unit simbasettings;
{$mode objfpc} {$M+}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls,MufasaBase, Graphics, Dialogs,
ComCtrls, StdCtrls, settings;
ComCtrls, StdCtrls, Menus, settings;
type
{ TSettingsForm }
TSettingsForm = class(TForm)
DeleteButton: TButton;
PopupCreate: TMenuItem;
PopupRename: TMenuItem;
PopupDelete: TMenuItem;
SettingsPopup: TPopupMenu;
SettingsFormButtonCancel: TButton;
SettingsFormButtonOK: TButton;
SettingsTreeView: TTreeView;
Settings: TMMLSettings;
procedure DeleteSelected(Sender: TObject);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OnKeyPress(Sender: TObject; var Key: char);
procedure PopupCreateKey(Sender: TObject);
procedure PopupDeleteClick(Sender: TObject);
procedure PopupRenameClick(Sender: TObject);
procedure SettingsFormButtonCancelClick(Sender: TObject);
procedure SettingsFormButtonOKClick(Sender: TObject);
procedure DeleteANode(N: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure SettingsTreeViewDblClick(Sender: TObject);
@ -35,6 +48,8 @@ var
implementation
uses LCLtype;
{ TSettingsForm }
procedure TSettingsForm.FormCreate(Sender: TObject);
@ -73,11 +88,115 @@ begin
Self.ModalResult:=mrOK;
end;
procedure TSettingsForm.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
N: TTreeNode;
begin
if Button = mbRight then
begin
N := SettingsTreeView.GetNodeAt(X, Y);
if N = nil then
exit;
SettingsTreeView.Selected := N;
SettingsPopup.PopUp();
end;
end;
procedure TSettingsForm.OnKeyPress(Sender: TObject; var Key: char);
var
N: TTreeNode;
begin
if (Ord(Key) = VK_DELETE) or (Ord(Key) = VK_BACK) then
begin
N := SettingsTreeView.Selected;
if N = nil then
exit;
DeleteANode(N);
end;
end;
procedure TSettingsForm.PopupCreateKey(Sender: TObject);
var
KeyName, P: String;
N, NN: TTreeNode;
begin
N := SettingsTreeView.Selected;
if N = nil then
exit;
if N.Data <> nil then
exit;
if N.GetFirstChild <> nil then
if N.GetFirstChild.Data <> nil then
exit;
KeyName := InputBox('Create new Key', 'Please enter the key name', '');
if KeyName = '' then
exit;
P := Settings.GetNodePath(N);
if Settings.CreateKey(P + '/' + KeyName) then
mDebugLn('Added key ' + KeyName);
end;
procedure TSettingsForm.FormDestroy(Sender: TObject);
begin
Settings.Free;
end;
procedure TSettingsForm.PopupDeleteClick(Sender: TObject);
begin
DeleteSelected(Sender);
end;
procedure TSettingsForm.PopupRenameClick(Sender: TObject);
var
N: TTreeNode;
MBox, Path: String;
begin
N := SettingsTreeView.Selected;
if N = nil then
exit;
Path := Settings.GetNodePath(N);
MBox := InputBox('Rename', 'Please fill in the new name', '');
if MBox = '' then
exit;
if Settings.RenameKey(Path, MBox) then
N.Text := MBox;
end;
procedure TSettingsForm.DeleteSelected(Sender: TObject);
var
N: TTreeNode;
begin
N := SettingsTreeView.Selected;
if N = nil then
exit;
DeleteANode(N);
end;
procedure TSettingsForm.DeleteANode(N: TTreeNode);
var
Path: String;
begin
if N = nil then
exit;
if MessageDlg('Delete a setting', 'Are you sure you want to delete this setting?', mtWarning, [mbYes, mbNo], 0) = mrNo then
exit;
Path := Settings.GetNodePath(N);
Settings.DeleteKey(Path);
N.DeleteChildren;
N.Delete;
end;
procedure TSettingsForm.SettingsTreeViewDblClick(Sender: TObject);
var
p, pp: TPoint;

View File

@ -1,13 +1,13 @@
object Form1: TForm1
Left = 345
Height = 555
Top = 260
Width = 739
Left = 423
Height = 557
Top = 159
Width = 666
ActiveControl = ScriptPanel
AllowDropFiles = True
Caption = 'THA FUKING SIMBA'
ClientHeight = 535
ClientWidth = 739
ClientHeight = 537
ClientWidth = 666
KeyPreview = True
Menu = MainMenu
OnClose = FormClose
@ -21,21 +21,21 @@ object Form1: TForm1
Left = 0
Height = 24
Top = 0
Width = 739
Width = 666
Caption = 'ToolBar1'
Images = Mufasa_Image_List
ParentShowHint = False
ShowHint = True
TabOrder = 0
object TB_Run: TToolButton
Left = 168
Left = 170
Hint = 'Run'
Top = 2
Action = ActionRunScript
ImageIndex = 6
end
object TB_Pause: TToolButton
Left = 191
Left = 193
Hint = 'Pause'
Top = 2
Action = ActionPauseScript
@ -43,7 +43,7 @@ object Form1: TForm1
ImageIndex = 5
end
object TB_Stop: TToolButton
Left = 214
Left = 216
Hint = 'Stop'
Top = 2
Action = ActionStopScript
@ -51,39 +51,39 @@ object Form1: TForm1
ImageIndex = 7
end
object ToolButton1: TToolButton
Left = 237
Left = 239
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton1'
Style = tbsDivider
end
object TB_NewTab: TToolButton
Left = 240
Left = 243
Hint = 'Add tab'
Top = 2
Action = ActionNewTab
end
object TB_CloseTab: TToolButton
Left = 263
Left = 266
Hint = 'Close tab'
Top = 2
Action = ActionCloseTab
end
object ToolButton4: TToolButton
Left = 286
Left = 289
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton4'
Style = tbsDivider
end
object TB_ClearDebug: TToolButton
Left = 289
Left = 293
Hint = 'Clear debug box'
Top = 2
Action = ActionClearDebug
end
object TB_PickColour: TToolButton
Left = 312
Left = 316
Hint = 'Pick a color'
Top = 2
Caption = 'TB_PickColour'
@ -91,7 +91,7 @@ object Form1: TForm1
OnClick = ButtonPickClick
end
object TB_SelectClient: TToolButton
Left = 335
Left = 339
Hint = 'Select a client'
Top = 2
Caption = 'TB_SelectClient'
@ -99,14 +99,14 @@ object Form1: TForm1
OnMouseDown = ButtonSelectorDown
end
object ToolButton8: TToolButton
Left = 358
Left = 362
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton8'
Style = tbsDivider
end
object TB_ReloadPlugins: TToolButton
Left = 361
Left = 366
Hint = 'Reload plugins'
Top = 2
Caption = 'TB_ReloadPlugins'
@ -114,7 +114,7 @@ object Form1: TForm1
ImageIndex = 13
end
object TB_Tray: TToolButton
Left = 384
Left = 389
Hint = 'Minimize to tray'
Top = 2
Caption = 'TB_Tray'
@ -132,7 +132,7 @@ object Form1: TForm1
object ToolButton2: TToolButton
Left = 93
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton2'
Style = tbsDivider
end
@ -158,14 +158,14 @@ object Form1: TForm1
Enabled = False
end
object ToolButton3: TToolButton
Left = 430
Left = 435
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton3'
Style = tbsDivider
end
object TT_Update: TToolButton
Left = 433
Left = 439
Hint = 'A new update is available'
Top = 2
Caption = 'TT_Update'
@ -173,33 +173,33 @@ object Form1: TForm1
OnClick = TT_UpdateClick
end
object TT_Cut: TToolButton
Left = 96
Left = 97
Top = 2
Caption = 'Cu&t'
ImageIndex = 3
OnClick = ActionCutExecute
end
object TT_Copy: TToolButton
Left = 119
Left = 120
Top = 2
Caption = '&Copy'
ImageIndex = 22
OnClick = ActionCopyExecute
end
object TT_Paste: TToolButton
Left = 142
Left = 143
Top = 2
Action = ActionPaste
end
object ToolButton9: TToolButton
Left = 165
Left = 166
Top = 2
Width = 3
Width = 4
Caption = 'ToolButton9'
Style = tbsDivider
end
object TT_Console: TToolButton
Left = 407
Left = 412
Hint = 'Hide/Show Console'
Top = 2
Action = ActionConsole
@ -207,9 +207,9 @@ object Form1: TForm1
end
object StatusBar: TStatusBar
Left = 0
Height = 22
Top = 513
Width = 739
Height = 23
Top = 514
Width = 666
Panels = <
item
Width = 60
@ -230,18 +230,21 @@ object Form1: TForm1
object PanelMemo: TPanel
Left = 0
Height = 154
Top = 359
Width = 739
Top = 360
Width = 666
Align = alBottom
ClientHeight = 154
ClientWidth = 739
ClientWidth = 666
TabOrder = 2
object Memo1: TMemo
Left = 1
Height = 152
Top = 1
Width = 737
Width = 664
Align = alClient
Font.Height = -13
Font.Name = 'Courier New'
ParentFont = False
ScrollBars = ssAutoBoth
TabOrder = 0
end
@ -250,29 +253,29 @@ object Form1: TForm1
Cursor = crVSplit
Left = 0
Height = 5
Top = 354
Width = 739
Top = 355
Width = 666
Align = alBottom
ResizeAnchor = akBottom
end
object ScriptPanel: TPanel
Left = 0
Height = 330
Height = 331
Top = 24
Width = 739
Width = 666
Align = alClient
BevelOuter = bvNone
ClientHeight = 330
ClientWidth = 739
ClientHeight = 331
ClientWidth = 666
DockSite = True
TabOrder = 4
OnDockDrop = ScriptPanelDockDrop
OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl
Left = 155
Height = 295
Height = 296
Top = 0
Width = 584
Width = 511
Align = alClient
Images = Mufasa_Image_List
PopupMenu = TabPopup
@ -289,12 +292,12 @@ object Form1: TForm1
object SearchPanel: TPanel
Left = 0
Height = 35
Top = 295
Width = 739
Top = 296
Width = 666
Align = alBottom
BevelOuter = bvSpace
ClientHeight = 35
ClientWidth = 739
ClientWidth = 666
TabOrder = 1
Visible = False
object SpeedButtonSearch: TSpeedButton
@ -385,7 +388,7 @@ object Form1: TForm1
end
object LabeledEditSearch: TLabeledEdit
Left = 104
Height = 23
Height = 21
Top = 6
Width = 174
EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -393,10 +396,10 @@ object Form1: TForm1
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 71
EditLabel.Height = 16
EditLabel.Left = 73
EditLabel.Height = 14
EditLabel.Top = 9
EditLabel.Width = 30
EditLabel.Width = 28
EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False
LabelPosition = lpLeft
@ -409,9 +412,9 @@ object Form1: TForm1
end
object CheckBoxMatchCase: TCheckBox
Left = 320
Height = 19
Height = 17
Top = 7
Width = 80
Width = 72
Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick
TabOrder = 1
@ -419,28 +422,28 @@ object Form1: TForm1
end
object SplitterFunctionList: TSplitter
Left = 150
Height = 295
Height = 296
Top = 0
Width = 5
OnCanResize = SplitterFunctionListCanResize
Visible = False
end
inline frmFunctionList: TFunctionListFrame
Height = 295
Height = 296
Width = 150
ClientHeight = 295
ClientHeight = 296
ClientWidth = 150
OnEndDock = nil
TabOrder = 3
inherited FunctionList: TTreeView
Height = 252
Height = 257
Width = 150
OnChange = FunctionListChange
OnEnter = FunctionListEnter
OnExit = FunctionListExit
end
inherited editSearchList: TEdit
Top = 272
Top = 275
Width = 150
OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown
@ -3082,4 +3085,30 @@ object Form1: TForm1
left = 488
top = 200
end
object LazHighlighter: TSynFreePascalSyn
Enabled = False
CommentAttri.Foreground = clBlue
CommentAttri.Style = [fsBold]
IdentifierAttri.Foreground = clDefault
NumberAttri.Foreground = clNavy
StringAttri.Foreground = clBlue
SymbolAttri.Foreground = clRed
DirectiveAttri.Foreground = clRed
DirectiveAttri.Style = [fsBold]
CompilerMode = pcmObjFPC
NestedComments = True
left = 528
top = 200
end
object SCARHighlighter: TSynFreePascalSyn
Enabled = False
CommentAttri.Foreground = clGreen
CommentAttri.Style = []
NumberAttri.Foreground = clHotLight
StringAttri.Foreground = clFuchsia
CompilerMode = pcmObjFPC
NestedComments = True
left = 568
top = 200
end
end

File diff suppressed because it is too large Load Diff

View File

@ -46,7 +46,7 @@ uses
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const
SimbaVersion = 602;
SimbaVersion = 607;
type
@ -96,6 +96,7 @@ type
ActionTabNext: TAction;
ActionList: TActionList;
CheckBoxMatchCase: TCheckBox;
LazHighlighter: TSynFreePascalSyn;
frmFunctionList: TFunctionListFrame;
LabeledEditSearch: TLabeledEdit;
MainMenu: TMainMenu;
@ -116,6 +117,7 @@ type
MenuItemDivider9: TMenuItem;
MouseTimer: TTimer;
NewsTimer: TTimer;
SCARHighlighter: TSynFreePascalSyn;
TT_Console: TToolButton;
TT_Cut: TToolButton;
TT_Copy: TToolButton;
@ -327,18 +329,24 @@ type
SearchStart : TPoint;
LastTab : integer;
UpdatingFonts : boolean;
function GetExtPath: string;
function GetFontPath: String;
function GetHighlighter: TSynCustomHighlighter;
function GetIncludePath: String;
function GetPluginPath: string;
function GetScriptState: TScriptState;
function GetShowHintAuto: boolean;
function GetSimbaNews: String;
procedure SetExtPath(const AValue: string);
procedure SetFontPath(const AValue: String);
procedure SetIncludePath(const AValue: String);
procedure SetPluginPath(const AValue: string);
procedure SetShowHintAuto(const AValue: boolean);
procedure SetScriptState(const State: TScriptState);
function LoadSettingDef(Key : string; Def : string) : string;
function CreateSetting(Key : string; Value : string) : string;
procedure SetSetting(key : string; Value : string; save : boolean = false);
function SettingExtists(key : string) : boolean;
function LoadSettingDef(const Key, Def : string) : string;
function CreateSetting(const Key, Value : string) : string;
procedure SetSetting(const key,Value : string; save : boolean = false);
function SettingExtists(const key : string) : boolean;
procedure FontUpdate;
public
DebugStream: String;
@ -382,13 +390,17 @@ type
procedure CreateDefaultEnvironment;
procedure LoadFormSettings;
procedure SaveFormSettings;
procedure AddRecentFile(filename : string);
procedure LoadExtensions;
procedure AddRecentFile(const filename : string);
procedure InitalizeTMThread(var Thread : TMThread);
procedure HandleParameters;
procedure OnSaveScript(const Filename : string);
property ShowHintAuto : boolean read GetShowHintAuto write SetShowHintAuto;
property IncludePath : String read GetIncludePath write SetIncludePath;
property FontPath : String read GetFontPath write SetFontPath;
property PluginPath : string read GetPluginPath write SetPluginPath;
property ExtPath : string read GetExtPath write SetExtPath;
property CurrHighlighter : TSynCustomHighlighter read GetHighlighter;
end;
{ TProcThread }
@ -996,12 +1008,16 @@ begin
CreateSetting('Settings/MainForm/NormalSize','739:555');
CreateSetting('Settings/FunctionList/ShowOnStart','True');
CreateSetting('Settings/CodeHints/ShowAutomatically','True');
CreateSetting('Settings/SourceEditor/LazColors','True');
CreateSetting('Settings/Extensions/FileExtension','sex');
CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF});
CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version');
CreateSetting('Settings/Fonts/VersionLink', FontURL + 'Version');
CreateSetting('Settings/Fonts/UpdateLink', FontURL + 'Fonts.tar.bz2');
CreateSetting('Settings/News/URL', 'http://simba.villavu.com/bin/news');
{Creates the paths and returns the path}
PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS));
extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
@ -1027,41 +1043,6 @@ begin
end;
procedure TForm1.LoadFormSettings;
var
extCount : integer;
function LoadExtension(Number : integer) : boolean;
var
Path : string;
ExtPath : string;
ExtEnabled : boolean;
begin;
result := false;
if (number < 0) or (number >= extCount) then
exit;
path := 'Extensions/Extension' + inttostr(number);
if SettingExtists(Path) = false then
exit;
ExtPath := LoadSettingDef(Path + '/Path','');
if ExtPath = '' then
exit;
ExtEnabled := StrToBoolDef(LoadSettingDef(Path + '/Enabled','false'),false);
if ExtManager.LoadPSExtension(ExtPath,ExtEnabled) = false then
exit;
Result := true;
end;
procedure DeleteExtension(number : integer);
var
i : integer;
path : string;
begin;
path := 'Extensions/Extension';
SettingsForm.Settings.DeleteKey(path + inttostr(number));
for i := number + 1 to extCount - 1 do
SettingsForm.Settings.RenameKey(path + inttostr(i),'Extension' + inttostr(i-1));
SetSetting('Extensions/ExtensionCount',inttostr(extCount - 1),true);
dec(extCount);
end;
var
str,str2 : string;
Data : TStringArray;
@ -1105,14 +1086,6 @@ begin
else
ShowConsole(false);
{$endif}
extCount := StrToIntDef(LoadSettingDef('Extensions/ExtensionCount/','0'),0);
for i := 0 to extCount - 1 do
while (i < extCount) and not LoadExtension(i) do
DeleteExtension(i);
SetSetting('Extensions/ExtensionCount',inttostr(extCount));
str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex');
ExtManager.LoadPSExtensionsDir(str,str2);
end;
procedure TForm1.SaveFormSettings;
@ -1161,7 +1134,57 @@ begin
end;
end;
procedure TForm1.AddRecentFile(filename: string);
procedure TForm1.LoadExtensions;
var
extCount : integer;
function LoadExtension(Number : integer) : boolean;
var
Path : string;
ExtPath : string;
ExtEnabled : boolean;
begin;
result := false;
if (number < 0) or (number >= extCount) then
exit;
path := 'Extensions/Extension' + inttostr(number);
if SettingExtists(Path) = false then
exit;
ExtPath := LoadSettingDef(Path + '/Path','');
if ExtPath = '' then
exit;
ExtEnabled := StrToBoolDef(LoadSettingDef(Path + '/Enabled','false'),false);
if ExtManager.LoadPSExtension(ExtPath,ExtEnabled) = false then
exit;
Result := true;
end;
procedure DeleteExtension(number : integer);
var
i : integer;
path : string;
begin;
path := 'Extensions/Extension';
SettingsForm.Settings.DeleteKey(path + inttostr(number));
for i := number + 1 to extCount - 1 do
SettingsForm.Settings.RenameKey(path + inttostr(i),'Extension' + inttostr(i-1));
SetSetting('Extensions/ExtensionCount',inttostr(extCount - 1),true);
dec(extCount);
end;
var
str,str2 : string;
i : integer;
begin
extCount := StrToIntDef(LoadSettingDef('Extensions/ExtensionCount/','0'),0);
for i := 0 to extCount - 1 do
while (i < extCount) and not LoadExtension(i) do
DeleteExtension(i);
SetSetting('Extensions/ExtensionCount',inttostr(extCount));
str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex');
ExtManager.LoadPSExtensionsDir(str,str2);
end;
procedure TForm1.AddRecentFile(const filename: string);
var
MaxRecentFiles : integer;
Len,i : integer;
@ -1189,22 +1212,20 @@ procedure TForm1.InitalizeTMThread(var Thread: TMThread);
var
DbgImgInfo : TDbgImgInfo;
AppPath : string;
pluginspath: string;
ScriptPath : string;
UseCPascal: String;
Se: TMMLSettingsSandbox;
loadFontsOnScriptStart: boolean;
begin
AppPath:= MainDir + DS;
PluginsPath := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)));
CurrScript.ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'False');
try
if lowercase(UseCPascal) = 'true' then
Thread := TCPThread.Create(True,@CurrentSyncInfo,PluginsPath)
Thread := TCPThread.Create(True,@CurrentSyncInfo,PluginPath)
else
Thread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
Thread := TPSThread.Create(True,@CurrentSyncInfo,PluginPath);
except
mDebugLn('Failed to initialise the library!');
Exit;
@ -1227,15 +1248,15 @@ begin
if CurrScript.ScriptFile <> '' then
ScriptPath := IncludeTrailingPathDelimiter(ExtractFileDir(CurrScript.ScriptFile));
if DirectoryExists(PluginsPath) then
PluginsGlob.AddPath(PluginsPath);
if DirectoryExists(PluginPath) then
PluginsGlob.AddPath(PluginPath);
if not DirectoryExists(IncludePath) then
if FirstRun then
FormWritelnEx('Warning: The include directory specified in the Settings isn''t valid.');
if not DirectoryExists(fontPath) then
if FirstRun then
FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginsPath,fontPath);
Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginPath,fontPath);
if selector.haspicked then Thread.Client.IOManager.SetTarget(Selector.LastPick);
@ -1246,10 +1267,10 @@ begin
begin
Self.OCR_Fonts := TMOCR.Create(Thread.Client);
OCR_Fonts.InitTOCR(fontPath);
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts);
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts
end else
if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts);
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts;
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
Se.Prefix := 'Scripts/';
@ -1289,15 +1310,15 @@ begin
with CurrScript do
begin
ScriptFile:= SetDirSeparators(Filename);
ScriptName:= ExtractFileNameOnly(Filename);
ScriptName:= ExtractFileNameOnly(ScriptFile);
mDebugLn('Script name will be: ' + ScriptName);
FormWritelnEx('Succesfully saved: ' + Filename);
FormWritelnEx('Succesfully saved: ' + ScriptFile);
StartText:= SynEdit.Lines.Text;
ScriptChanged := false;
SynEdit.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]);
CurrTab.TabSheet.Caption:= ScriptName;
Self.AddRecentFile(FileName);
Self.AddRecentFile(ScriptFile);
StatusBar.Panels[Panel_ScriptName].Text:= ScriptName;
StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile;
end;
@ -1924,6 +1945,8 @@ begin
//Fill the codeinsight buffer
FillThread.Resume;
//Load the extensions
LoadExtensions;
end;
procedure TForm1.FormDestroy(Sender: TObject);
@ -2029,7 +2052,7 @@ var
SynExporterHTML : TSynExporterHTML;
begin;
SynExporterHTML := TSynExporterHTML.Create(nil);
SynExporterHTML.Highlighter := CurrScript.SynFreePascalSyn1;
SynExporterHTML.Highlighter := CurrHighlighter;
SynExporterHTML.ExportAsText:= True;
with TSaveDialog.Create(nil) do
try
@ -2175,12 +2198,12 @@ begin
FunctionListShown(not MenuItemFunctionList.Checked);
end;
function GetSimbaNews: String;
function TForm1.GetSimbaNews: String;
var
t: TDownloadThread;
begin
t := TDownloadThread.Create(true);
t.InputURL:='http://simba.villavu.com/bin/news';
t.InputURL:=LoadSettingDef('Settings/News/URL', 'http://simba.villavu.com/bin/news');
t.Resume;
while not t.done do
begin
@ -2190,6 +2213,11 @@ begin
Exit(t.ResultStr);
end;
procedure TForm1.SetExtPath(const AValue: string);
begin
SetSetting('Settings/Extensions/Path',AValue,true);
end;
procedure TForm1.NewsTimerTimer(Sender: TObject);
var
s: String;
@ -2343,16 +2371,39 @@ begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS)));
end;
function TForm1.GetExtPath: string;
begin
result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS)));
end;
function TForm1.GetHighlighter: TSynCustomHighlighter;
begin
if lowercase(LoadSettingDef('Settings/SourceEditor/LazColors','True')) = 'true' then
result := LazHighlighter
else
result := SCARHighlighter;
end;
function TForm1.GetIncludePath: String;
begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Includes/Path', ExpandFileName(MainDir+DS+'Includes' + DS)));
end;
function TForm1.GetPluginPath: string;
begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+DS+'Plugins' + DS)));
end;
procedure TForm1.SetIncludePath(const AValue: String);
begin
SetSetting('Settings/Includes/Path',AValue,true);
end;
procedure TForm1.SetPluginPath(const AValue: string);
begin
SetSetting('Settings/Plugins/Path',AValue,true);
end;
procedure TForm1.SetScriptState(const State: TScriptState);
begin
CurrScript.FScriptState:= State;
@ -2381,17 +2432,17 @@ begin
end;
end;
function TForm1.LoadSettingDef(Key: string; Def: string): string;
function TForm1.LoadSettingDef(const Key,Def: string): string;
begin
result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile);
end;
function TForm1.CreateSetting(Key: string; Value: string): string;
function TForm1.CreateSetting(const Key,Value: string): string;
begin
result := SettingsForm.Settings.GetKeyValueDef(Key,value);
end;
procedure TForm1.SetSetting(key: string; Value: string; save : boolean);
procedure TForm1.SetSetting(const key,Value: string; save : boolean);
begin
//Creates the setting if needed
SettingsForm.Settings.SetKeyValue(key,value);
@ -2399,7 +2450,7 @@ begin
SettingsForm.Settings.SaveToXML(SimbaSettingsFile);
end;
function TForm1.SettingExtists(key: string): boolean;
function TForm1.SettingExtists(const key: string): boolean;
begin
result :=SettingsForm.Settings.KeyExists(key);
end;
@ -2545,7 +2596,8 @@ begin
Exit;
with TOpenDialog.Create(nil) do
try
Filter:= 'Simba Files|*.simb;*.cogat;*.mufa;*.txt|Any files|*.*';
Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+
'|Any files|*.*';
if Execute then
if FileExists(filename) then
result := LoadScriptFile(filename);
@ -2626,12 +2678,14 @@ begin
Result := false;
with TSaveDialog.Create(nil) do
try
Filter:= 'Simba files|*.simb;*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*';
filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +
LoadSettingDef('Settings/Extensions/FileExtension','sex')+
'|Any files|*.*';
if Execute then
begin;
if ExtractFileExt(FileName) = '' then
begin;
ScriptFile := FileName + '.simb';
ScriptFile := FileName + '.simba';
end else
ScriptFile := FileName;
CurrScript.SynEdit.Lines.SaveToFile(ScriptFile);

View File

@ -1,6 +1,6 @@
unit virtualextension;
{$mode objfpc}
{$mode objfpc}{$H+}
interface

View File

@ -0,0 +1,14 @@
program new;
var
Font : TFont;
begin
Font := TFont.Create;
Font.Name := 'Courier New';
Font.Size := 10;
Font.Style := [];
LoadSystemFont(Font,'test');
DisplayDebugImgWindow(0,0);
DisplayDebugImgWindow(150,50);
DrawBitmapDebugImg(BitmapFromText('BMP[0] has not been freed','test'));
Font.free;
end.

View File

@ -82,7 +82,7 @@ end;
procedure SetBitmapName(Bmp : integer; name : string); extdecl;
begin;
CurrThread.Client.MBitmaps[Bmp].BmpName:= name;
CurrThread.Client.MBitmaps[Bmp].Name:= name;
end;
function CreateMirroredBitmap(Bmp : integer) : integer; extdecl;
@ -270,7 +270,7 @@ begin;
result := CurrThread.Client.MBitmaps[Bitmap].CreateTMask;
end;
function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; extdecl;
function FindMaskTolerance(const mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; extdecl;
begin;
result := CurrThread.Client.MFinder.FindMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;

View File

@ -21,110 +21,57 @@
DTM.inc for the Mufasa Macro Library
}
function ps_FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean; extdecl;
var
temp: pDTM;
function ps_FindDTM(DTM: Integer; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean; extdecl;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTM(temp, x, y, x1, y1, x2, y2)
else
begin
x := 0;
y := 0;
Result := False;
end;
with CurrThread.Client do
result := MFinder.FindDTM(MDTM.GetDTM(DTM),x,y,xs,ys,xe,ye);
end;
function ps_FindDTMs(DTM: Integer; out p: TPointArray; x1, y1, x2, y2: Integer): Boolean; extdecl;
var
temp: pDTM;
function ps_FindDTMs(DTM: Integer; out p: TPointArray; xs, ys, xe, ye: Integer): Boolean; extdecl;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTMs(temp, p, x1, y1, x2, y2, 0)
else
begin
setlength(p,0);
Result := False;
end;
with CurrThread.Client do
result := MFinder.FindDTMs(MDTM.GetDTM(DTM), p, xs, ys, xe, ye);
end;
function ps_FindDTMRotatedAlternating(DTM: Integer; out x, y: Integer; x1, y1, x2, y2:
function ps_FindDTMRotatedAlternating(DTM: Integer; out x, y: Integer; xs, ys, xe, ye:
Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean; extdecl;
var
temp: pDTM;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound,true)
else
begin
x := 0;
y := 0;
Result := False;
end;
with CurrThread.Client do
result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM), x,y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,true);
end;
function ps_FindDTMRotatedSE(DTM: Integer; out x, y: Integer; x1, y1, x2, y2:
function ps_FindDTMRotatedSE(DTM: Integer; out x, y: Integer; xs, ys, xe, ye:
Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean; extdecl;
var
temp: pDTM;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound,false)
else
begin
x := 0;
y := 0;
Result := False;
end;
with CurrThread.Client do
result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM), x, y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,false);
end;
function ps_FindDTMsRotatedAlternating(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
var
temp: pDTM;
function ps_FindDTMsRotatedAlternating(DTM: Integer; out Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTMsRotated(temp, Points, x1, y1, x2, y2,
sAngle, eAngle, aStep, aFound, 0,true)
else
Result := False;
with CurrThread.Client do
result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM), Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, true);
end;
function ps_FindDTMsRotatedSE(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
var
temp: pDTM;
function ps_FindDTMsRotatedSE(DTM: Integer; out Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then
Result := CurrThread.Client.MFinder.FindDTMsRotated(temp, Points, x1, y1, x2, y2,
sAngle, eAngle, aStep, aFound, 0,false)
else
Result := False;
with CurrThread.Client do
result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM), Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, false);
end;
{function ps_FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, extdecl;
y1, x2, y2: Integer; sAngle, eAngle,
aStep: Extended; out aFound: T2DExtendedArray)
: Boolean;
begin
Result := CurrThread.Client.MDTM.FindDTMsRotated(DTM, Points, x1, y1, x2, y2,
sAngle, eAngle, aStep, aFound);
end; }
procedure ps_SetDTMName(DTM : integer; name : string);
procedure ps_SetDTMName(DTM : integer;const name : string);
begin
CurrThread.Client.MDTM.SetDTMName(DTM,name);
end;
function ps_DTMFromString(DTMString: String): Integer; extdecl;
var
dtm: pDTM;
function ps_DTMFromString(const DTMString: String): Integer; extdecl;
begin
With CurrThread.Client.MDTM do
begin
dtm := StringToDTM(DTMString);
Result := AddpDTM(dtm);
end;
Result := AddpDTM(StringToDTM(DTMString));
end;
procedure ps_FreeDTM(DTM: Integer); extdecl;
@ -132,23 +79,32 @@ begin
CurrThread.Client.MDTM.FreeDTM(DTM);
end;
function ps_GetDTM(index: Integer; out dtm: pDTM): Boolean; extdecl;
function ps_GetDTM(index: Integer) : pDTM; extdecl;
begin
Result := CurrThread.Client.MDTM.GetDTM(index, dtm);
CurrThread.Client.MDTM.GetDTM(index);
end;
function ps_AddDTM(d: TDTM): Integer; extdecl;
function ps_AddDTM(const d: TDTM): Integer; extdecl;
begin
Result := CurrThread.Client.MDTM.AddDTM(d);
end;
function ps_AddpDTM(d: pDTM): Integer; extdecl;
function ps_AddpDTM(const d: pDTM): Integer; extdecl;
begin
Result := CurrThread.Client.MDTM.AddpDTM(d);
Result := CurrThread.Client.MDTM.AddpDTM(d);
end;
Procedure ps_PrintpDTM(aDTM : pDTM);extdecl;
procedure ps_PrintpDTM(const aDTM : pDTM);extdecl;
begin
PrintpDTM(aDTM);
PrintpDTM(aDTM);
end;
function ps_pDTMToTDTM(Const DTM: pDTM): TDTM;extdecl;
begin
result := pDTMToTDTM(DTM);
end;
function ps_tDTMTopDTM(Const DTM: TDTM): pDTM;extdecl;
begin
result := tDTMTopDTM(DTM);
end;

View File

@ -21,18 +21,74 @@
extensions.inc for the Mufasa Macro Library
}
type
TStringArray = array of string;
function ext_UnTar(const Input : string; out Content : TStringArray) : boolean;
var
Stream : TStringStream;
begin
result := false;
try
Stream := TStringStream.Create(Input);
content := UnTar(Stream);
result := (length(content) > 0);
finally
stream.free;
end;
end;
function ext_GetPage(url : string) : string;
function ext_UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;
var
Stream : TStringStream;
MS : TMemoryStream;
begin
result := false;
try
Stream := TStringStream.Create(Input);
result := UnTar(stream,outputdir,overwrite);
finally
stream.free;
end;
end;
function ext_DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;
var
Stream : TStringStream;
MS : TMemoryStream;
begin
result := false;
try
Stream := TStringStream.Create(Input);
ms := DecompressBZip2(Stream,blocksize);
if ms.size > 0 then
begin
ms.Position:= 0;
SetLength(output,ms.Size);
MS.Read(output[1],MS.size);
ms.free;
result := true;
end;
finally
stream.free;
end;
end;
function ext_GetPage(const url : string) : string;
var
t: TDownloadThread;
begin
t := TDownloadThread.Create(true);
t.InputURL:='url';
t.Resume;
while not t.done do
begin
Application.ProcessMessages;
Sleep(25);
result := '';
try
t := TDownloadThread.Create(true);
t.InputURL:=url;
t.Resume;
while not t.done do
begin
Application.ProcessMessages;
Sleep(25);
end;
Exit(t.ResultStr);
except
on e : exception do
mDebugLn('Exception in GetPage in Extensions: ' + e.message);
end;
Exit(t.ResultStr);
end;

View File

@ -21,17 +21,17 @@
File.inc for the Mufasa Macro Library
}
function ps_CreateFile(Path: string): Integer; extdecl;
function ps_CreateFile(const Path: string): Integer; extdecl;
begin
Result := CurrThread.Client.MFiles.CreateFile(Path);
end;
function ps_OpenFile(Path: string; Shared: Boolean): Integer; extdecl;
function ps_OpenFile(const Path: string; Shared: Boolean): Integer; extdecl;
begin
Result := CurrThread.Client.MFiles.OpenFile(Path, Shared);
end;
function ps_RewriteFile(Path: string; Shared: Boolean): Integer; extdecl;
function ps_RewriteFile(const Path: string; Shared: Boolean): Integer; extdecl;
begin
Result := CurrThread.Client.MFiles.RewriteFile(Path, Shared);
end;
@ -81,7 +81,7 @@ begin
result := CreateDir(directoryName);
end;
procedure ps_WriteINI(Section, KeyName, NewString, FileName: string);extdecl;
procedure ps_WriteINI(const Section, KeyName, NewString, FileName: string);extdecl;
var
tempini : TIniFile;
begin;
@ -90,7 +90,7 @@ begin;
tempini.free;
end;
function ps_ReadINI(Section, KeyName, FileName: string): string;extdecl;
function ps_ReadINI(const Section, KeyName, FileName: string): string;extdecl;
var
tempini : TIniFile;
begin;
@ -99,7 +99,7 @@ begin;
tempini.free;
end;
procedure ps_DeleteINI(Section, KeyName, FileName: string); extdecl;
procedure ps_DeleteINI(const Section, KeyName, FileName: string); extdecl;
var
tempini : TIniFile;
begin;

View File

@ -1,14 +1,14 @@
function rs_GetUpText: String; extdecl;
function ps_rs_GetUpText: String; extdecl;
begin
Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true);
end;
function rs_GetUpTextAt(x, y : integer): string; extdecl;
function ps_rs_GetUpTextAt(x, y : integer): string; extdecl;
begin
result := CurrThread.Client.MOCR.GetUpTextAtEx(x,y,true);
end;
function BitmapFromText(text, font: String): integer; extdecl;
function ps_BitmapFromText(const text, font: String): integer; extdecl;
var
bmp: TMufasaBitmap;
begin
@ -16,23 +16,28 @@ begin
Result := CurrThread.Client.MBitmaps.AddBMP(bmp);
end;
function MaskFromText(text, font: String): TMask; extdecl;
function ps_MaskFromText(const text, font: String): TMask; extdecl;
begin
Result := CurrThread.Client.MOCR.TextToMask(text,font);
end;
procedure TPAFromTextWrap(text, font: String;out w,h : integer;out TPA : TPointArray); extdecl;
procedure ps_TPAFromTextWrap(const text, font: String;out w,h : integer;out TPA : TPointArray); extdecl;
begin
TPA := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end;
function TPAFromText(text, font: String;out w,h : integer): TPointArray; extdecl;
function ps_TPAFromText(const text, font: String;out w,h : integer): TPointArray; extdecl;
begin
Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end;
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string; extdecl;
function ps_GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer;const font: string): string; extdecl;
begin
result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font);
end;
function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;extdecl;
begin
result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName);
end;

View File

@ -21,6 +21,14 @@
Settings.inc for the Mufasa Macro Library
}
function SetSettingValue(KeyName,value : string) : boolean;
begin
if CurrThread.Sett <> nil then
result:= CurrThread.Sett.SetKeyValue(KeyName,Value)
else
result:=false;
end;
function KeyIsSetting(KeyName: String): Boolean;
begin
if CurrThread.Sett <> nil then

View File

@ -26,22 +26,21 @@ AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special,
{ DTM }
SetCurrSection('DTM');
AddFunction(@ps_PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; out dtm: pDTM): Boolean;');
AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(DTM: pDTM): TDTM;');
AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(DTM: TDTM): pDTM;');
AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer; name : string);');
AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);');
AddFunction(@ps_DTMFromString, 'function DTMFromString(const DTMString: String): Integer;');
AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
AddFunction(@ps_FindDTMRotatedSE, 'function FindDTMRotatedSE(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@ps_FindDTMRotatedSE, 'function FindDTMRotatedSE(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(const d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(const d: pDTM): Integer;');
AddFunction(@ps_PrintpDTM, 'procedure PrintpDTM(const tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : pDTM');
AddFunction(@ps_pDTMToTDTM, 'function pDTMToTDTM(const DTM: pDTM): TDTM;');
AddFunction(@ps_tDTMTopDTM, 'function tDTMTopDTM(const DTM: TDTM): pDTM;');
{maths}
SetCurrSection('Math');
@ -55,13 +54,13 @@ AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;');
AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;');
AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;');
AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;');
AddFunction(@IntToBox,'function IntToBox(xs,ys,xe,ye : integer) : TBox;');
AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
AddFunction(@PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;');
AddFunction(@PointInBox,'function PointInBox(PT : TPoint; Box: TBox): Boolean;');
AddFunction(@ps_sqr,'function Sqr(e : extended) : extended;');
AddFunction(@ps_point,'function Point(x,y:integer) : TPoint;');
AddFunction(@ps_Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
AddFunction(@ps_Distance,'function Distance(xs,ys,xe,ye : integer) : integer;');
AddFunction(@ps_hypot,'function Hypot(X, Y: Extended): Extended;');
AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;');
AddFunction(@ps_incex,'procedure IncEx(var x : integer; increase : integer);');
@ -91,22 +90,22 @@ AddFunction(@IsTargetValid, 'function IsTargetValid: boolean;');
{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_CreateFile, 'function CreateFile(const Path: string): Integer;');
AddFunction(@ps_OpenFile, 'function OpenFile(const Path: string; Shared: Boolean): Integer;');
AddFunction(@ps_RewriteFile, 'function RewriteFile(const 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; var 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_SetFileCharPointer, 'function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
AddFunction(@ps_DirectoryExists,'function DirectoryExists( const DirectoryName : string ) : Boolean;');
AddFunction(@ps_CreateDirectory,'function CreateDirectory( const DirectoryName : string) : boolean;');
AddFunction(@ps_FileExists,'function FileExists ( const FileName : string ) : Boolean;');
AddFunction(@ps_WriteINI,'procedure WriteINI(Section, KeyName, NewString, FileName: string);');
AddFunction(@ps_ReadINI,'function ReadINI(Section, KeyName, FileName: string): string;');
AddFunction(@ps_DeleteINI,'procedure DeleteINI(Section, KeyName, FileName: string);');
AddFunction(@ps_DirectoryExists,'function DirectoryExists(const DirectoryName : string ) : Boolean;');
AddFunction(@ps_CreateDirectory,'function CreateDirectory(const DirectoryName : string) : boolean;');
AddFunction(@ps_FileExists,'function FileExists (const FileName : string ) : Boolean;');
AddFunction(@ps_WriteINI,'procedure WriteINI(const Section, KeyName, NewString, FileName: string);');
AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;');
AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);');
{other}
SetCurrSection('Other');
@ -129,7 +128,7 @@ AddFunction(@GetDebugBitmap,'function GetDebugBitmap: integer;');
AddFunction(@ps_Random,'function Random(Int: integer): integer;');
AddFunction(@ClearDebug,'procedure ClearDebug;');
AddFunction(@PlaySound,'procedure PlaySound( Sound : string);');
AddFunction(@StopSound,'Procedure StopSound;');
AddFunction(@StopSound,'procedure StopSound;');
AddFunction(@psSetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: String): boolean;');
AddFunction(@psGetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: String): boolean;');
@ -196,10 +195,10 @@ AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;');
AddFunction(@GetColorsWrap,'procedure GetColorsWrap(Coords : TPointArray; var Colors :TIntegerArray);');
AddFunction(@FindColor, 'function FindColor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColors, 'function FindColors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@FindColor, 'function FindColor(var x, y: integer; color, xs, ys, xe, ye: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(var x, y: integer; color, xs, ys, xe, ye, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(var x, y: integer; color, xs, ys, xe, ye, tol: integer): boolean;');
AddFunction(@FindColors, 'function FindColors(var TPA: TPointArray; color, xs, ys, xe, ye: 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;');
@ -231,13 +230,14 @@ AddFunction(@GetKeyCode,'function GetKeyCode(c : char) : integer;');
{ OCR}
SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;');
AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;');
AddFunction(@TPAFromText, 'function TPAFromText(text, font: String;var w,h : integer): TPointArray;');
AddFunction(@TPAFromTextWrap,'procedure TPAFromTextWrap(text, font: String;var w,h : integer;var TPA : TPointArray);');
AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;');
AddFunction(@GetTextAt,'function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer; font: string): string;');
AddFunction(@ps_rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@ps_rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;');
AddFunction(@ps_BitmapFromText, 'function BitmapFromText(const text, font: String): integer;');
AddFunction(@ps_TPAFromText, 'function TPAFromText(const text, font: String;var w,h : integer): TPointArray;');
AddFunction(@ps_TPAFromTextWrap,'procedure TPAFromTextWrap(const text, font: String;var w,h : integer;var TPA : TPointArray);');
AddFunction(@ps_MaskFromText, 'function MaskFromText(const text, font: String): TMask;');
AddFunction(@ps_GetTextAt,'function GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer;const font: string): string;');
AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;');
{Bitmaps}
SetCurrSection('Bitmaps');
@ -280,7 +280,7 @@ AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) :
AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
AddFunction(@CreateMaskFromBitmap,'function CreateMaskFromBitmap(Bitmap : integer) : TMask;');
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(const mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap: integer; TPA: TPointArray; Color: integer);');
@ -323,7 +323,7 @@ AddFunction(@GetSamePointsATPA,'function GetSamePointsATPA( ATPA : T2DPointArray
AddFunction(@FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
AddFunction(@SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);');
AddFunction(@LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);');
AddFunction(@RotatePoint,'Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;');
AddFunction(@RotatePoint,'function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;');
AddFunction(@FindGapsTPA,'function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;');
AddFunction(@RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;');
AddFunction(@CombineTPA,'function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;');
@ -332,16 +332,16 @@ AddFunction(@ReArrangeandShortenArray,'function ReArrangeandShortenArray(a: TPoi
AddFunction(@TPAtoATPAEx,'function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;');
AddFunction(@TPAtoATPA,'function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;');
AddFunction(@CombineIntArray,'function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;');
AddFunction(@MergeATPA,'Function MergeATPA(ATPA : T2DPointArray) : TPointArray;');
AddFunction(@MergeATPA,'function MergeATPA(ATPA : T2DPointArray) : TPointArray;');
AddFunction(@TPAFromBox,'function TPAFromBox(const Box : TBox) : TPointArray;');
AddFunction(@RotatePoints,'Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;');
AddFunction(@RotatePoints,'function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;');
AddFunction(@FindTPAEdges,'function FindTPAEdges(p: TPointArray): TPointArray;');
AddFunction(@ClearTPAFromTPA,'function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;');
AddFunction(@ReturnPointsNotInTPA,'Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;');
AddFunction(@ReturnPointsNotInTPA,'function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;');
AddFunction(@PointInTPA,'function PointInTPA(p: TPoint; arP: TPointArray): Boolean;');
AddFunction(@ClearDoubleTPA,'procedure ClearDoubleTPA(var TPA: TPointArray);');
AddFunction(@TPACountSort,'Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);');
AddFunction(@TPACountSortBase,'Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);');
AddFunction(@TPACountSort,'procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);');
AddFunction(@TPACountSortBase,'procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);');
AddFunction(@InvertTIA,'procedure InvertTIA(var tI: TIntegerArray);');
AddFunction(@SumIntegerArray,'function SumIntegerArray(Ints : TIntegerArray): Integer;');
AddFunction(@AverageTIA,'function AverageTIA(tI: TIntegerArray): Integer;');
@ -371,6 +371,7 @@ AddFunction(@KeyIsSetting, 'function KeyIsSetting(KeyName: String): Boolean;');
AddFunction(@KeyIsDirectory, 'function KeyIsDirectory(KeyName: String): Boolean;');
AddFunction(@GetSettingValue, 'function GetSettingValue(KeyName: String): String;');
AddFunction(@GetSettingValueDef, 'function GetSettingValueDef(KeyName, defVal: String): String;');
AddFunction(@SetSettingValue,'function SetSettingValue(KeyName,value : string) : boolean;');
AddFunction(@ListSettings, 'function ListSettings(KeyName: String; var KeyReturn: TStringArray) : boolean;');
AddFunction(@DeleteSetting, 'function DeleteSetting(KeyName: String): Boolean;');
AddFunction(@DeleteSubSettings, 'function DeleteSubSettings(KeyName: String): Boolean;');

View File

@ -1,6 +1,6 @@
unit mmisc;
{$mode objfpc}
{$mode objfpc}{$H+}
interface
@ -9,7 +9,7 @@ uses
function DecompressBZip2(const input : TStream; const BlockSize : Cardinal = 4096) : TMemoryStream;
function UnTar(const Input : TStream) : TStringArray;overload;
function UnTar(const Input : TStream; outputdir : string; overwrite : boolean): boolean;overload;
function UnTar(const Input : TStream;const outputdir : string; overwrite : boolean): boolean;overload;
implementation
@ -63,7 +63,7 @@ begin;
Tar.Free;
end;
function UnTar(const Input: TStream; outputdir: string; overwrite: boolean): boolean; overload;
function UnTar(const Input: TStream; const outputdir: string; overwrite: boolean): boolean; overload;
var
Tar : TTarArchive;
DirRec : TTarDirRec;

View File

@ -476,23 +476,6 @@ end;
{***implementation TPSThread***}
{
Note to Raymond: For PascalScript, Create it on the .Create,
Execute it on the .Execute, and don't forget to Destroy it on .Destroy.
Furthermore, all the wrappers can be in the unit "implementation" section.
Better still to create an .inc for it, otherwise this unit will become huge.
(You can even split up the .inc's in stuff like color, bitmap, etc. )
Also, don't add PS to this unit, but make a seperate unit for it.
Unit "MMLPSThread", perhaps?
See the TestUnit for use of this thread, it's pretty straightforward.
It may also be wise to turn the "Importing of wrappers" into an include as
well, it will really make the unit more straightforward to use and read.
}
constructor TPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
var
I : integer;
@ -572,7 +555,7 @@ var
Fonts : TMFonts;
begin
{$I PSInc/pscompile.inc}
Fonts := Client.MOCR.GetFonts;
Fonts := Client.MOCR.Fonts;
for i := fonts.count - 1 downto 0 do
Sender.Comp.AddConstantN(Fonts[i].Name,'string').SetString(Fonts[i].Name);
@ -600,14 +583,44 @@ begin
end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
var
PSClass : TPSCompileTimeClass;
begin
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
with PSClass do
begin;
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
RegisterMethod('procedure FastSetPixel(x,y : integer; Color : TColor);');
RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
RegisterMethod('procedure SetTransparentColor(Col : TColor);');
RegisterMethod('function GetTransparentColor : TColor;');
RegisterProperty('TransparentColorSet','Boolean',iptR);
RegisterMethod('procedure FastDrawClear(Color : TColor);');
RegisterMethod('procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);');
RegisterMethod('procedure FastReplaceColor(OldColor, NewColor: TColor);');
RegisterMethod('procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );');
RegisterMethod('procedure Desaturate(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure GreyScale(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer);');
RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
RegisterMethod('function Copy: TMufasaBitmap;');
RegisterMethod('function ToString : string;');
RegisterMethod('function CreateTMask : TMask;');
RegisterMethod('constructor create');
RegisterMethod('procedure Free');
RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
RegisterMethod('procedure LoadFromFile(const FileName : string);');
RegisterProperty('Width','Integer',iptR);
RegisterProperty('Height','Integer',iptR);
RegisterProperty('Index','Integer',iptR);
RegisterProperty('Name','String',iptRW);
end;
end;
@ -622,20 +635,51 @@ begin;
CurrThread.Client.MBitmaps.FreeBMP(Self.Index);
end;
procedure MufasaBitmapIndex(self : TMufasaBitmap; var Index : integer);
begin;
Index := self.Index;
end;
procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end;
procedure MBmp_Width_r(self : TMufasaBitmap; var Width : integer);begin; Width := self.Width; end;
procedure MBmp_Height_r(self : TMufasaBitmap; var Height : integer);begin; Height := self.Height; end;
procedure MBmp_Name_r(self : TMufasaBitmap; var Name : String);begin; Name := self.Name; end;
procedure MBmp_Name_w(self : TMufasaBitmap; const Name : String);begin; Self.name := name; end;
procedure MBmp_TransColorSet_r(Self : TMufasaBitmap; var IsSet : boolean); begin IsSet := self.TransparentColorSet; end;
procedure RIRegister_Mufasa(cl: TPSRuntimeClassImporter);
var
PSClass : TPSRuntimeClass;
begin;
with cl.Add(TMufasaBitmap) do
PSClass :=cl.Add(TMufasaBitmap);
with PSClass do
begin
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
RegisterMethod(@TMufasaBitmap.StretchResize,'STRETCHRESIZE');
RegisterMethod(@TMufasaBitmap.FastSetPixel,'FASTSETPIXEL');
RegisterMethod(@TMufasaBitmap.FastSetPixels,'FASTSETPIXELS');
RegisterMethod(@TMufasaBitmap.DrawATPA,'DRAWATPA');
RegisterMethod(@TMufasaBitmap.DrawTPA,'DRAWTPA');
RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL');
RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR');
RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR');
RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR');
RegisterMethod(@TMufasaBitmap.FastDrawTransparent,'FASTDRAWTRANSPARENT');
RegisterMethod(@TMufasaBitmap.FastReplaceColor,'FASTREPLACECOLOR');
RegisterMethod(@TMufasaBitmap.RotateBitmap,'ROTATEBITMAP');
RegisterMethod(@TMufasaBitmap.Desaturate,'DESATURATE');
RegisterMethod(@TMufasaBitmap.GreyScale,'GREYSCALE');
RegisterMethod(@TMufasaBitmap.Brightness,'BRIGHTNESS');
RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST');
RegisterMethod(@TMufasaBitmap.Invert,'INVERT');
RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE');
RegisterMethod(@TMufasaBitmap.Copy, 'COPY');
RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING');
RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK');
RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET');
RegisterPropertyHelper(@MBmp_Index_r,nil,'INDEX');
RegisterPropertyHelper(@MBmp_Width_r,nil,'WIDTH');
RegisterPropertyHelper(@MBmp_Height_r,nil,'HEIGHT');
RegisterPropertyHelper(@MBmp_Name_r,@MBmp_Name_w,'NAME');
RegisterConstructor(@CreateMufasaBitmap,'CREATE');
RegisterMethod(@FreeMufasaBitmap,'FREE');
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
RegisterPropertyHelper(@MufasaBitmapIndex,nil,'INDEX');
end;
end;

View File

@ -1,6 +1,6 @@
unit scriptproperties;
{$mode objfpc}
{$mode objfpc}{$H+}
interface

View File

@ -334,6 +334,9 @@ begin
Exit('');
end;
{
newKey is not the entire key path.
}
function TMMLSettings.RenameKey(oldKey, newKey: string): boolean;
var
Node : TTreeNode;
@ -342,21 +345,25 @@ var
i : integer;
begin
result := false;
writeln(oldkey);
Path := KeyNameToKeys(OldKey);
if length(path) = 1 then
exit;
if pos('/',newKey) > 0 then
exit;
if not KeyExists(oldkey) then
exit;
for i := length(oldKey) downto 1 do
{ for i := length(oldKey) downto 1 do
if oldkey[i] = '/' then
begin
newstr:= Copy(oldkey,1,i) + NewKey;
break;
end;
if KeyExists(NewKey) then
exit;
exit; }
Node := WalkToNode(oldKey);
Node.Text:= NewKey;
result := true;

View File

@ -22,7 +22,7 @@
}
unit settingssandbox;
{$mode objfpc}
{$mode objfpc}{$H+}
interface
@ -42,15 +42,14 @@ type
public
constructor Create(sett: TMMLSettings);
destructor Destroy; override;
function IsKey(KeyName: String): Boolean;
function IsDirectory(KeyName: String): Boolean;
function SetKeyValue(Keyname : string; Value : string) : boolean;
function GetKeyValue(KeyName: String): String;
function GetKeyValueDef(KeyName, defVal: String): String;
function ListKeys(KeyName: String; out Keys : TStringArray): boolean;
function DeleteKey(KeyName: String): Boolean;
function DeleteSubKeys(KeyName: String): Boolean;
function IsKey(const KeyName: String): Boolean;
function IsDirectory(const KeyName: String): Boolean;
function SetKeyValue(const Keyname, Value : string) : boolean;
function GetKeyValue(const KeyName: String): String;
function GetKeyValueDef(const KeyName, defVal: String): String;
function ListKeys(const KeyName: String; out Keys : TStringArray): boolean;
function DeleteKey(const KeyName: String): Boolean;
function DeleteSubKeys(const KeyName: String): Boolean;
property prefix : string read GetPrefix write SetPrefix;
end;
@ -80,45 +79,43 @@ begin
FPrefix := s;
end;
function TMMLSettingsSandbox.ListKeys(KeyName: String; out Keys :TStringArray): boolean;
function TMMLSettingsSandbox.ListKeys(const KeyName: String; out Keys :TStringArray): boolean;
begin
exit(ST.ListKeys(Prefix + KeyName,keys))
end;
function TMMLSettingsSandbox.GetKeyValue(KeyName: String): String;
function TMMLSettingsSandbox.GetKeyValue(const KeyName: String): String;
begin
exit(ST.GetKeyValue(Prefix + KeyName))
end;
function TMMLSettingsSandbox.GetKeyValueDef(KeyName, defVal: String): String;
function TMMLSettingsSandbox.GetKeyValueDef(const KeyName, defVal: String): String;
begin
exit(ST.GetKeyValueDef(Prefix + KeyName, defVal))
end;
function TMMLSettingsSandbox.IsKey(KeyName: String): Boolean;
function TMMLSettingsSandbox.IsKey(const KeyName: String): Boolean;
begin
exit(ST.IsKey(Prefix + KeyName))
end;
function TMMLSettingsSandbox.IsDirectory(KeyName: String): Boolean;
function TMMLSettingsSandbox.IsDirectory(const KeyName: String): Boolean;
begin
exit(ST.IsDirectory(Prefix + KeyName))
end;
function TMMLSettingsSandbox.SetKeyValue(Keyname: string; Value: string
function TMMLSettingsSandbox.SetKeyValue(const Keyname,Value: string
): boolean;
begin
Writeln(KeyName);
Writeln(Value);
exit(ST.SetKeyValue(prefix + keyname,value,true));
end;
function TMMLSettingsSandbox.DeleteKey(KeyName: String): Boolean;
function TMMLSettingsSandbox.DeleteKey(const KeyName: String): Boolean;
begin
exit(ST.DeleteKey(Prefix + KeyName));
end;
function TMMLSettingsSandbox.DeleteSubKeys(KeyName: String): Boolean;
function TMMLSettingsSandbox.DeleteSubKeys(const KeyName: String): Boolean;
begin
exit(ST.DeleteSubKeys(Prefix + KeyName));
end;

View File

@ -1,6 +1,6 @@
unit stringutil;
{$mode objfpc}
{$mode objfpc}{$H+}
interface

View File

@ -38,11 +38,12 @@ type
TransparentColor : TRGB32;
TransparentSet : boolean;
FIndex : integer;
FName : string;
public
OnDestroy : procedure(Bitmap : TMufasaBitmap) of object;
FakeData : array of TRGB32;
//FakeData : array of TRGB32;
FData : PRGB32;
BmpName : string; //Optional?
property Name : string read FName write FName;
property Index : integer read FIndex write FIndex;
procedure SetSize(AWidth,AHeight : integer);
procedure StretchResize(AWidth,AHeight : integer);
@ -69,15 +70,16 @@ type
procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean; xs, ys, xe, ye: Integer);overload;
procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);overload;
procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
procedure Desaturate;overload;
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
procedure Desaturate;overload;
procedure GreyScale(TargetBitmap : TMufasaBitmap);overload;
procedure GreyScale;
procedure Brightness(br: integer);overload;
procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer); overload;
procedure Contrast(co: Extended);overload;
procedure Brightness(br: integer);overload;
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
procedure Invert;
procedure Contrast(co: Extended);overload;
procedure Invert(TargetBitmap : TMufasaBitmap);overload;
procedure Invert;overload;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload;
function Copy: TMufasaBitmap;
@ -369,7 +371,7 @@ function TMBitmaps.CreateBMPFromString(BmpName: string; width, height: integer;
Data: string): integer;
begin
Result := Self.CreateBMPFromString(width,height,data);
Bmp[Result].BmpName:= BmpName;
Bmp[Result].Name:= BmpName;
end;
@ -578,9 +580,9 @@ end;
procedure TMufasaBitmap.LoadFromTBitmap(bmp: TBitmap);
begin
bmp.BeginUpdate();
// bmp.BeginUpdate();
LoadFromRawImage(bmp.RawImage);
bmp.EndUpdate();
// bmp.EndUpdate();
end;
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);
@ -1028,6 +1030,24 @@ begin
end;
end;
procedure TMufasaBitmap.Invert(TargetBitmap: TMufasaBitmap);
var
I : integer;
PtrOld,PtrNew : PRGB32;
begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
for i := (h*w-1) downto 0 do
begin;
PtrNew^.r := not PtrOld^.r;
PtrNew^.g := not PtrOld^.g;
PtrNew^.b := not PtrOld^.b;
inc(ptrOld);
inc(PtrNew);
end;
end;
procedure TMufasaBitmap.Posterize(TargetBitmap: TMufasaBitmap; Po: integer);
var
I : integer;
@ -1127,10 +1147,10 @@ begin
for i := 0 to BmpsCurr do
if BmpArray[i] <> nil then
begin;
if BmpArray[i].BmpName = '' then
if BmpArray[i].Name = '' then
TClient(Client).Writeln(Format('BMP[%d] has not been freed in the script, freeing it now.',[i]))
else
TClient(Client).Writeln(Format('BMP[%s] has not been freed in the script, freeing it now.',[BmpArray[i].BmpName]));
TClient(Client).Writeln(Format('BMP[%s] has not been freed in the script, freeing it now.',[BmpArray[i].Name]));
FreeAndNil(BmpArray[i]);
end;
SetLength(BmpArray,0);
@ -1206,7 +1226,7 @@ end;
constructor TMufasaBitmap.Create;
begin
inherited Create;
BmpName:= '';
Name:= '';
TransparentSet:= False;
setSize(0,0);
{FData:= nil;

View File

@ -60,13 +60,9 @@ implementation
procedure TClient.WriteLn(s: string);
begin
if self <> nil then
begin;
if Assigned(WritelnProc) then
WritelnProc(s)
else
mDebugLn(s);
end else
if (self <> nil) and Assigned(WritelnProc) then
WritelnProc(s)
else
mDebugLn(s);
end;

View File

@ -31,47 +31,24 @@ uses
Classes, SysUtils, MufasaTypes;
type
{ TMDTM }
TMDTM = class(TObject)
private
public
function AddDTM(d: TDTM): Integer;
function AddpDTM(d: pDTM): Integer;
function GetDTM(index: Integer; out dtm: pDTM): Boolean;
procedure FreeDTM(DTM: Integer);
function StringToDTM(S: String): pDTM;
function SetDTMName(DTM: Integer; S: String): boolean;
{ function FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2,
y2: Integer): Boolean;
function FindDTMs(DTM: Integer; out Points: TPointArray; x1, y1, x2,
y2: Integer): Boolean;
function FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2,
y2: Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean;
function FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1,
y1, x2, y2: Integer; sAngle, eAngle,
aStep: Extended; out aFound: T2DExtendedArray)
: Boolean;
function pFindDTM(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2:
Integer): Boolean;
function pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2,
y2: Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean;
function pFindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1,
y1, x2, y2: Integer; sAngle, eAngle,
aStep: Extended; out aFound: T2DExtendedArray)
: Boolean;
}
constructor Create(Owner: TObject);
destructor Destroy; override;
private
Client: TObject;
DTMList: Array Of pDTM;
FreeSpots: Array Of Integer;
Client: TObject;
DTMList: Array Of pDTM;
FreeSpots: Array Of Integer;
procedure CheckIndex(index : integer);
public
function AddDTM(const d: TDTM): Integer;
function AddpDTM(const d: pDTM): Integer;
function GetDTM(index: Integer) :pDTM;
procedure FreeDTM(DTM: Integer);
function StringToDTM(const S: String): pDTM;
procedure SetDTMName(DTM: Integer;const S: String);
constructor Create(Owner: TObject);
destructor Destroy; override;
end;
implementation
@ -125,27 +102,20 @@ begin
inherited Destroy;
end;
{Function AreaShape(Color, Tolerance, Size, Shape: Integer; P: TPoint) : Boolean; inline;
Begin
End;}
// Rotates the given point (p) by A (in radians) around the point defined by cx, cy.
function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint; inline;
function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint; inline;
begin
Result.X := Round(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
Result.Y := Round(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
end;
function HexToInt(HexNum: string): LongInt;inline;
function HexToInt(const HexNum: string): LongInt;inline;
begin
Result:=StrToInt('$' + HexNum);
end;
function TMDTM.StringToDTM(S: String): pDTM;
function TMDTM.StringToDTM(const S: String): pDTM;
var
b: PBufferByteArray;
Source : String;
@ -192,29 +162,22 @@ begin
result.l := length(result.p);
end;
function TMDTM.AddDTM(d: TDTM): Integer;
procedure TMDTM.CheckIndex(index: integer);
begin
if Length(FreeSpots) > 0 then
begin
DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d);
Result := FreeSpots[High(FreeSpots)];
SetLength(FreeSpots, High(FreeSpots));
end
else
begin
SetLength(DTMList, Length(DTMList) + 1);
DTMList[High(DTMList)] := TDTMTopDTM(d);
Result := High(DTMList);
end;
if (index < 0) or (index >= Length(DTMList)) then
raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
end;
function TMDTM.AddDTM(const d: TDTM): Integer;
begin
Result := AddpDTM(tDTMTopDTM(d));
end;
{/\
Adds the given pDTM to the DTM Array, and returns it's index.
/\}
function TMDTM.AddpDTM(d: pDTM): Integer;
function TMDTM.AddpDTM(const d: pDTM): Integer;
begin
if Length(FreeSpots) > 0 then
begin
@ -222,12 +185,13 @@ begin
Result := FreeSpots[High(FreeSpots)];
SetLength(FreeSpots, High(FreeSpots));
end
Else
else
begin
SetLength(DTMList, Length(DTMList) + 1);
DTMList[High(DTMList)] := d;
Result := High(DTMList);
end;
NormalizeDTM(DTMList[result]);
end;
{/\
@ -235,30 +199,16 @@ end;
Returns true is succesfull, false if the dtm does not exist.
/\}
function TMDTM.GetDTM(index: Integer; out dtm: pDTM): Boolean;
function TMDTM.GetDTM(index: Integer) :pDTM;
begin
Result := True;
try
dtm := DTMList[index];
except
begin
raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.',
[index]);
//WriteLn('DTM Index ' + IntToStr(index) + ' does not exist');
Result := False;
end;
end
CheckIndex(index);
result := DTMList[index];
end;
function TMDTM.SetDTMName(DTM: Integer; s: string): boolean;
procedure TMDTM.SetDTMName(DTM: Integer;const s: string);
begin
try
DTMList[DTM].n:= s;
Exit(true);
except
raise Exception.CreateFMT('SetDTMName: The given DTM %d does not exist.', [DTM]);
end;
Exit(False);
CheckIndex(DTM);
DTMList[DTM].n := s;
end;
{/\
@ -267,79 +217,21 @@ end;
Will keep track of not used index, so it is very memory efficient.
/\}
Procedure TMDTM.FreeDTM(DTM: Integer);
procedure TMDTM.FreeDTM(DTM: Integer);
begin
try
SetLength(DTMList[DTM].p, 0);
SetLength(DTMList[DTM].c, 0);
SetLength(DTMList[DTM].t, 0);
SetLength(DTMList[DTM].asz, 0);
SetLength(DTMList[DTM].ash, 0);
DTMList[DTM].l := 0;
except
raise Exception.CreateFmt('Invalid DTM passed to FreeDTM', []);
//WriteLn('Invalid DTM');
end;
CheckIndex(DTM);
SetLength(DTMList[DTM].p, 0);
SetLength(DTMList[DTM].c, 0);
SetLength(DTMList[DTM].t, 0);
SetLength(DTMList[DTM].asz, 0);
SetLength(DTMList[DTM].ash, 0);
SetLength(DTMList[DTM].bp,0);
DTMList[DTM].l := 0;
DTMList[DTM].n := '';
SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := DTM;
end;
{
Tries to find the given DTM (index). If found will put the point the dtm has
been found at in x, y and result to true.
}
{function TMDTM.FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
var
temp: pDTM;
begin
if GetDTM(DTM, temp) then
Result := pFindDTM(temp, x, y, x1, y1, x2, y2)
else
begin
x := 0;
y := 0;
Result := False;
end;
end; }
{
Tries to find the given pDTM. If found will put the point the dtm has
been found at in x, y and result to true.
}
{function TMDTM.pFindDTM(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
begin
end; }
{/\
Tries to find the given DTM (index). Will return true if it has found one or more
DTM's. All the occurances are stored in the Points (TPointArray)
/\}
{function TMDTM.FindDTMs(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer): Boolean;
Var
temp: pDTM;
Begin
If GetDTM(DTM, temp) Then
Result := pFindDTMs(temp, Points, x1, y1, x2, y2)
Else
Begin
SetLength(Points, 0);
Result := False;
End;
End; }
{/\
Tries to find the given pDTM. Will return true if it has found one or more
DTM's. All the occurances are stored in the Points (TPointArray)
/\}
{wat}
// Then, first find all occurances of all colours on the given client.
// Each point has a colour, and we call them C_0...C_n.
@ -369,20 +261,20 @@ End; }
Returns all Angles in an Extended array.
/\}
{Function TMDTM.FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
{function TMDTM.FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
Var
temp: pDTM;
Begin
If GetDTM(DTM, temp) Then
Result := pFindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
Else
else
Begin
x := 0;
y := 0;
aFound := 0.0;
Result := False;
End;
End; }
end;
end; }
{/\
Tries to find the given pDTM. If found will put the point the dtm has
@ -391,11 +283,11 @@ End; }
Returns all Angles in an Extended array.
/\}
{Function TMDTM.pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
{function TMDTM.pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
Begin
End; }
end; }
{/\
Tries to find the given DTM (index). Will return true if it has found one or more
@ -405,19 +297,19 @@ End; }
Returns all Angles in a Two Dimensional Extended array.
/\}
{Function TMDTM.FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean;
{function TMDTM.FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean;
Var
temp: pDTM;
Begin
If GetDTM(DTM, temp) Then
Result := pFindDTMsRotated(temp, Points, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
Else
else
Begin
SetLength(Points, 0);
SetLength(aFound, 0);
Result := False;
End;
End; }
end;
end; }
{/\
Tries to find the given pDTM. Will return true if it has found one or more
@ -427,12 +319,5 @@ End; }
Returns all Angles in a Two Dimensional Extended array.
/\}
{Function TMDTM.pFindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean;
Begin
// Don't forget to pre calculate the rotated points at the start.
// Saves a lot of rotatepoint() calls.
End; }
end.

View File

@ -31,15 +31,15 @@ uses
Classes, SysUtils, MufasaTypes;
Function pDTMToTDTM(Const DTM: pDTM): TDTM;
Function tDTMTopDTM(Const DTM: TDTM): pDTM;
Procedure PrintpDTM(aDTM : pDTM);
function pDTMToTDTM(Const DTM: pDTM): TDTM;
function tDTMTopDTM(Const DTM: TDTM): pDTM;
procedure PrintpDTM(const aDTM : pDTM);
procedure initdtm(out d: pdtm; len: integer);
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
Function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;
function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;const
sAngle, eAngle, aStep: Extended): TBox;
function DTMConsistent(var dtm: pdtm): boolean;
function DTMConsistent(const dtm: pdtm): boolean;
procedure NormalizeDTM(var dtm: pdtm);
function RotateDTM(const dtm: pdtm; angle: extended) : pdtm;
function copydtm(const dtm: pdtm): pdtm;
@ -55,7 +55,6 @@ implementation
uses math,MufasaBase;
procedure RotatePoints_(Var P: TPointArray; A, cx, cy: Extended);
Var
I, L: Integer;
CosA,SinA : extended;
@ -99,7 +98,7 @@ begin
d.bp[i] := False;
end;
Procedure PrintpDTM(aDTM : pDTM);
procedure PrintpDTM(const aDTM : pDTM);
var
i : integer;
begin;
@ -111,7 +110,7 @@ begin;
mDebugLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i]) + ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
end;
Function pDTMToTDTM(Const DTM: pDTM): TDTM;
function pDTMToTDTM(Const DTM: pDTM): TDTM;
Var
Temp: TDTMPointDef;
@ -147,19 +146,17 @@ End;
Converts a TDTM to a pDTM.
/\}
Function tDTMTopDTM(Const DTM: TDTM): pDTM;
Var
//Temp: TDTMPointDef;
function tDTMTopDTM(Const DTM: TDTM): pDTM;
var
I: Integer;
Begin
SetLength(Result.p, Length(DTM.SubPoints) + 1);
SetLength(Result.c, Length(DTM.SubPoints) + 1);
SetLength(Result.t, Length(DTM.SubPoints) + 1);
SetLength(Result.asz, Length(DTM.SubPoints) + 1);
SetLength(Result.ash, Length(DTM.SubPoints) + 1);
SetLength(Result.bp, Length(DTM.SubPoints) + 1);
begin
Result.l := Length(DTM.SubPoints) + 1; //The mainpoint is in a different structure
SetLength(Result.p, Result.l);
SetLength(Result.c, Result.l);
SetLength(Result.t, Result.l);
SetLength(Result.asz, Result.l);
SetLength(Result.ash, Result.l);
SetLength(Result.bp, Result.l);
Result.p[0].x := DTM.MainPoint.x;
Result.p[0].y := DTM.MainPoint.y;
@ -168,7 +165,7 @@ Begin
Result.asz[0] := DTM.MainPoint.AreaSize;
Result.ash[0] := DTM.MainPoint.AreaShape;
For I := 1 To Length(DTM.SubPoints) Do // High + 1 = Length
For I := 1 To Result.l - 1 Do // High + 1 = Length
Begin
Result.p[I].x := DTM.SubPoints[I - 1].x;
Result.p[I].y := DTM.SubPoints[I - 1].y;
@ -178,14 +175,13 @@ Begin
Result.ash[I] := DTM.SubPoints[I - 1].AreaShape;
End;
Result.l := length(Result.p);
setlength(result.bp, result.l);
for i := 0 to result.l -1 do
result.bp[i] := false;
End;
end;
{ TODO: Check if bounds are correct? }
function DTMConsistent(var dtm: pdtm): boolean;
function DTMConsistent(const dtm: pdtm): boolean;
var
i: integer;
begin
@ -229,7 +225,7 @@ begin
dtm.p[0] := dtm.p[0] - dtm.p[0]; //Point(0,0);
end;
Function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
var
i: Integer;
@ -256,8 +252,8 @@ begin
Result.y2 := y2 - b.y2;
end;
Function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;
sAngle, eAngle, aStep: Extended): TBox;
function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;
const sAngle, eAngle, aStep: Extended): TBox;
var
i: Integer;

View File

@ -43,14 +43,14 @@ type
constructor Create(Owner : TObject);
destructor Destroy; override;
public
function CreateFile(Path: string): Integer;
function OpenFile(Path: string; Shared: Boolean): Integer;
function RewriteFile(Path: string; Shared: Boolean): Integer;
function CreateFile(const Path: string): Integer;
function OpenFile(const Path: string; Shared: Boolean): Integer;
function RewriteFile(const Path: string; Shared: Boolean): Integer;
procedure CloseFile(FileNum: Integer);
function EndOfFile(FileNum: Integer): Boolean;
function FileSizeMuf(FileNum: Integer): LongInt;
function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
function WriteFileString(FileNum: Integer; s: string): Boolean;
function WriteFileString(FileNum: Integer;const s: string): Boolean;
Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
function FilePointerPos(FileNum: Integer): Integer;
protected
@ -226,7 +226,7 @@ End;
Returns -1 if unsuccesfull.
/\}
function TMFiles.CreateFile(Path: string): Integer;
function TMFiles.CreateFile(const Path: string): Integer;
Var
FS: TFileStream;
@ -249,7 +249,7 @@ end;
Returns -1 if unsuccesfull.
/\}
function TMFiles.OpenFile(Path: string; Shared: Boolean): Integer;
function TMFiles.OpenFile(const Path: string; Shared: Boolean): Integer;
Var
FS: TFileStream;
@ -290,7 +290,7 @@ end;
Returns -1 if unsuccesfull.
/\}
function TMFiles.RewriteFile(Path: string; Shared: Boolean): Integer;
function TMFiles.RewriteFile(const Path: string; Shared: Boolean): Integer;
Var
FS: TFileStream;
@ -454,7 +454,7 @@ end;
Writes s in the given File.
/\}
function TMFiles.WriteFileString(FileNum: Integer; s: string): Boolean;
function TMFiles.WriteFileString(FileNum: Integer;const s: string): Boolean;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);

View File

@ -30,7 +30,7 @@ interface
{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks).
uses
Classes, SysUtils,bitmaps,MufasaBase, MufasaTypes; // Types
colour_conv, Classes, SysUtils,bitmaps,MufasaBase, MufasaTypes; // Types
{ TMFinder Class }
@ -42,69 +42,66 @@ uses
}
type
TMFinder = class(TObject)
constructor Create(aClient: TObject);
destructor Destroy; override;
private
TMFinder = class(TObject)
private
Client: TObject;
Percentage : array[0..255] of Extended; //We store all the possible RGB / 255 divisions.
CachedWidth, CachedHeight : integer;
ClientTPA : TPointArray;
hueMod, satMod: Extended;
CTS: Integer;
Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
procedure DefaultOperations(var xs,ys,xe,ye : integer);
//Loads the Spiral into ClientTPA (Will not cause problems)
procedure LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer);
public
WarnOnly : boolean;
function FindColorsToleranceOptimised(out Points: TPointArray; Color,xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColorToleranceOptimised(out x, y: Integer; Color, xs, ys,xe, ye, tol: Integer): Boolean;
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
function CountColor(Color, xs, ys, xe, ye: Integer): Integer;
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var.
function FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean;
function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;
function FindColorSpiralTolerance(var x, y: Integer; color, xs, ys, xe, ye,Tol: Integer): Boolean;
function FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean;
function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;
function FindColors(out TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea: Integer): Boolean;
function FindColoredAreaTolerance(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea, tol: Integer): Boolean;
//Mask
function FindMaskTolerance(const mask: TMask; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
procedure CheckMask(const Mask : TMask);
//Bitmap functions
function FindBitmap(bitmap: TMufasaBitmap; out x, y: Integer): Boolean;
function FindBitmapIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
function FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
function FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
function FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;
Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
procedure DefaultOperations(var xs,ys,xe,ye : integer);
//Loads the Spiral into ClientTPA (Will not cause problems)
procedure LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer);
public
function FindColorsToleranceOptimised(out Points: TPointArray; Color,
xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColorToleranceOptimised(out x, y: Integer; Color, xs, ys,
xe, ye, tol: Integer): Boolean;
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
function CountColor(Color, xs, ys, xe, ye: Integer): Integer;
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var.
function FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean;
function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;
function FindColorSpiralTolerance(var x, y: Integer; color, xs, ys, xe, ye,Tol: Integer): Boolean;
function FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean;
function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;
function FindColors(out TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea: Integer): Boolean;
function FindColoredAreaTolerance(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea, tol: Integer): Boolean;
//Mask
function FindMaskTolerance(mask: TMask; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
procedure CheckMask(Mask : TMask);
//Bitmap functions
function FindBitmap(bitmap: TMufasaBitmap; out x, y: Integer): Boolean;
function FindBitmapIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
function FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
function FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
function FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;
function FindDTM(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
function FindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
function FindDTMsRotated(_DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer; Alternating : boolean): Boolean;
//Donno
function GetColors(Coords: TPointArray): TIntegerArray;
// tol speeds
procedure SetToleranceSpeed(nCTS: Integer);
function GetToleranceSpeed: Integer;
procedure SetToleranceSpeed2Modifiers(nHue, nSat: Extended);
procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);
protected
Client: TObject;
Percentage : array[0..255] of Extended; //We store all the possible RGB / 255 divisions.
CachedWidth, CachedHeight : integer;
ClientTPA : TPointArray;
hueMod, satMod: Extended;
CTS: Integer;
end;
function FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): Boolean;
function FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean;
//Donno
function GetColors(const Coords: TPointArray): TIntegerArray;
// tol speeds
procedure SetToleranceSpeed(nCTS: Integer);
function GetToleranceSpeed: Integer;
procedure SetToleranceSpeed2Modifiers(const nHue, nSat: Extended);
procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);
constructor Create(aClient: TObject);
destructor Destroy; override;
end;
implementation
uses
colour_conv,// For RGBToColor, etc.
// colour_conv,// For RGBToColor, etc.
Client, // For the Client Casts.
math, //min/max
tpa, //TPABounds
@ -254,6 +251,7 @@ var
begin
inherited Create;
WarnOnly := False;
Self.Client := aClient;
Self.CTS := 1;
Self.hueMod := 0.2;
@ -281,7 +279,7 @@ begin
Result := Self.CTS;
end;
procedure TMFinder.SetToleranceSpeed2Modifiers(nHue, nSat: Extended);
procedure TMFinder.SetToleranceSpeed2Modifiers(const nHue, nSat: Extended);
begin
Self.hueMod := nHue;
Self.satMod := nSat;
@ -338,34 +336,64 @@ begin
SetLength(ClientTPA,NewWidth * NewHeight);
end;
procedure Swap(var A,B : integer);
var
c : integer;
begin
c := a;
a := b;
b := c;
end;
procedure TMFinder.DefaultOperations(var xs, ys, xe, ye: integer);
var
w,h : integer;
begin
if xs > xe then
raise Exception.CreateFMT('Finder function: Xs > xe (%d,%d)',[xs,xe]);
if (xs > xe) then
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed wrong values to a finder function: xs > xe (%d,%d). Swapping the values for now.',[xs,xe]));
swap(xs,xe);
end else
raise Exception.CreateFMT('You passed wrong values to a finder function: xs > xe (%d,%d).',[xs,xe]);
if ys > ye then
raise Exception.CreateFMT('Finder function: Ys > ye (%d,%d)',[ys,ye]);
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed wrong values to a finder function: ys > ye (%d,%d). Swapping the values for now.',[ys,ye]));
swap(ys,ye);
end else
raise Exception.CreateFMT('You passed wrong values to a finder function: ys > ye (%d,%d).',[ys,ye]);
if xs < 0 then
// xs := 0;
raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct xs: %d.', [xs]);
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed a wrong xs to a finder function: %d. That is below 0, thus out of bounds. Setting the value to 0 for now.',[xs]));
xs := 0;
end else
raise Exception.createFMT('You passed a wrong xs to a finder function: %d. That is below 0, thus out of bounds.',[xs]);
if ys < 0 then
// ys := 0;
raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct ys: %d.', [ys]);
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed a wrong ys to a finder function: %d. That is below 0, thus out of bounds. Setting the value to 0 for now.',[ys]));
ys := 0;
end else
raise Exception.createFMT('You passed a wrong ys to a finder function: %d. That is below 0, thus out of bounds.',[ys]);
TClient(Self.Client).IOManager.GetDimensions(w,h);
if (w <> CachedWidth) or (h <> CachedHeight) then
UpdateCachedValues(w,h);
if xe >= w then
// xe := w-1;
raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct xe: %d.', [xe]);
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed a wrong xe to a finder function: %d. The client has a width of %d, thus the xe is out of bounds. Setting the value to %d (w-1) for now.',[xe,w,w-1]));
xe := w-1;
end else
raise Exception.createFMT('You passed a wrong xe to a finder function: %d. The client has a width of %d, thus the xe is out of bounds.',[xe,w]);
if ye >= h then
// ye := h-1;
raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct ye: %d.', [ye]);
if WarnOnly then
begin
TClient(Client).WriteLn(Format('Warning! You passed a wrong ye to a finder function: %d. The client has a height of %d, thus the ye is out of bounds. Setting the value to %d (h-1) for now.',[ye,h,h-1]));
ye := h-1;
end else
raise Exception.createFMT('You passed a wrong ye to a finder function: %d. The client has a height of %d, thus the ye is out of bounds.',[ye,h]);
end;
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
@ -1181,6 +1209,7 @@ begin
//Finally lets test H2
if Abs(H2 - H1) > HueTol then
continue;
//We survived the checks, this point is a match!
hit:
ClientTPA[c].x := xx;
ClientTPA[c].y := yy;
@ -1323,7 +1352,7 @@ end;
{ Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-( }
//We do not check whether every white pixel is in tol range with every other white pixel..
function TMFinder.FindMaskTolerance(mask: TMask; out x, y: Integer; xs,
function TMFinder.FindMaskTolerance(const mask: TMask; out x, y: Integer; xs,
ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
var
MainRowdata : TPRGB32Array;
@ -1400,7 +1429,7 @@ begin
TClient(Client).IOManager.FreeReturnData;
end;
procedure TMFinder.CheckMask(Mask: TMask);
procedure TMFinder.CheckMask(const Mask: TMask);
begin
if (Mask.W < 1) or (Mask.H < 1) or (Mask.WhiteHi < 0) or (Mask.BlackHi < 0) then
raise exception.CreateFMT('Mask is invalid. Width/Height: (%d,%d). WhiteHi/BlackHi: (%d,%d)',[Mask.W,Mask.H,Mask.WhiteHi,Mask.BlackHi]);
@ -1875,8 +1904,12 @@ begin
end;
end;
function TMFinder.FindDTM(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
{
Tries to find the given DTM. If found will put the point the dtm has
been found at in x, y and result to true.
}
function TMFinder.FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
var
P: TPointArray;
begin
@ -1890,6 +1923,7 @@ begin
Exit(False);
end;
//MaxToFind, if it's < 1 it won't stop looking
function TMFinder.FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
var
// Colours of DTMs
@ -1934,10 +1968,7 @@ begin
// Is the area valid?
DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then
begin
raise Exception.CreateFmt('FindDTMs: DTM is not consistent.', []);
Exit;
end;
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
// Get the area we should search in for the Main Point.
MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
@ -2048,13 +2079,13 @@ begin
Result := (pc > 0);
end;
function TMFinder.FindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
function TMFinder.FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
var
P: TPointArray;
F: T2DExtendedArray;
begin
FindDTMsRotated(dtm, P, x1, y1, x2, y2, sAngle, eAngle, aStep, F, 1,Alternating);
FindDTMsRotated(dtm, P, x1, y1, x2, y2, sAngle, eAngle, aStep, F,Alternating,1);
if Length(P) = 0 then
exit(false);
aFound := F[0][0];
@ -2063,9 +2094,9 @@ begin
Exit(True);
end;
function TMFinder.FindDTMsRotated(_DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer; Alternating : boolean): Boolean;
function TMFinder.FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer): Boolean;
var
DTM: pDTM;
DTMRot: pDTM;
// Colours of DTMs
clR,clG,clB : array of byte;
@ -2113,17 +2144,14 @@ var
begin
// Is the area valid?
DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(_dtm) then
begin
raise Exception.CreateFmt('FindDTMsRotated: DTM is not consistent.', []);
Exit;
end;
if not DTMConsistent(dtm) then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
NormalizeDTM(_dtm);
NormalizeDTM(DTM);
setlength(goodPoints, _dtm.l);
for i := 0 to _dtm.l - 1 do
goodPoints[i] := not _dtm.bp[i];
setlength(goodPoints, DTM.l);
for i := 0 to DTM.l - 1 do
goodPoints[i] := not DTM.bp[i];
// Init data structure B.
W := x2 - x1;
@ -2139,18 +2167,22 @@ begin
end;
// Convert colors to there components
SetLength(clR,_dtm.l);
SetLength(clG,_dtm.l);
SetLength(clB,_dtm.l);
for i := 0 to _dtm.l - 1 do
ColorToRGB(_dtm.c[i],clR[i],clG[i],clB[i]);
SetLength(clR,DTM.l);
SetLength(clG,DTM.l);
SetLength(clB,DTM.l);
for i := 0 to DTM.l - 1 do
ColorToRGB(DTM.c[i],clR[i],clG[i],clB[i]);
//Compiler hints
SetLength(hh,_dtm.l);
SetLength(ss,_dtm.l);
SetLength(ll,_dtm.l);
for i := 0 to _DTM.l - 1 do
ColorToHSL(_dtm.c[i],hh[i],ss[i],ll[i]);
SetLength(hh,DTM.l);
SetLength(ss,DTM.l);
SetLength(ll,DTM.l);
for i := 0 to DTM.l - 1 do
ColorToHSL(DTM.c[i],hh[i],ss[i],ll[i]);
{We create a kinda 'fake' rotated DTM. This dtm only has points + len, no other crap.
Since this other 'crap' equals the original DTM, no need to copy that!}
DTMRot.l := DTM.l;
GetToleranceSpeed2Modifiers(hMod, sMod);
ccts := CTS;
@ -2170,27 +2202,30 @@ begin
s := sAngle;
while s < eAngle do
begin
dtm := RotateDTM(_dtm, s);
//Rotate the DTM, the rest is just like FindDTMs
MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
//CD starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box.
// DTMRot := RotateDTM(DTM, s);
DTMRot.p := RotatePoints(DTM.p,s,0,0);
//DTMRot now has the same points as the original DTM, just rotated!
//The other stuff in the structure doesn't matter, as it's the same as the original DTM..
//So from now on if we want to see what 'point' we're at, use DTMRot.p, for the rest just use the original DTM
MA := ValidMainPointBox(DTMRot, x1, y1, x2, y2);
//CD(ClientData) starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box.
MA.x1 := MA.x1 - x1;
MA.y1 := MA.y1 - y1;
MA.x2 := MA.x2 - x1;
MA.y2 := MA.y2 - y1;
//MA is now fixed to the new (0,0) box...
for yy := MA.y1 to MA.y2 do //Coord of the mainpoint in the search area
for yy := MA.y1 to MA.y2 do //(xx,yy) is now the coord of the mainpoint in the search area
for xx := MA.x1 to MA.x2 do
begin
//Mainpoint can have area size as well, so we must check that just like any subpoint.
for i := 0 to dtm.l - 1 do
for i := 0 to DTMRot.l - 1 do
begin //change to use other areashapes too.
Found := false;
//With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - dtm.asz[i] + dtm.p[i].x);
StartY := max(0,yy - dtm.asz[i] + dtm.p[i].y);
EndX := Min(Ma.x2,xx + dtm.asz[i] + dtm.p[i].x);
EndY := Min(ma.y2,yy + dtm.asz[i] + dtm.p[i].y);
StartX := max(0,xx - DTM.asz[i] + DTMRot.p[i].x);
StartY := max(0,yy - DTM.asz[i] + DTMRot.p[i].y);
EndX := Min(Ma.x2,xx + DTM.asz[i] + DTMRot.p[i].x);
EndY := Min(ma.y2,yy + DTM.asz[i] + DTMRot.p[i].y);
for xxx := StartX to EndX do //The search area for the subpoint
begin
for yyy := StartY to EndY do
@ -2201,7 +2236,7 @@ begin
// Checking point i now. (Store that we matched it)
ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i);
if ColorSame(ccts,dtm.t[i],clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then
if ColorSame(ccts,DTM.t[i],clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then
b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end;
@ -2252,7 +2287,7 @@ begin
// raise Exception.CreateFmt('Not done yet!', []);
end;
function TMFinder.GetColors(Coords: TPointArray): TIntegerArray;
function TMFinder.GetColors(const Coords: TPointArray): TIntegerArray;
var
Box : TBox;
Len, I,w,h : integer;

View File

@ -28,7 +28,7 @@ unit fontloader;
interface
uses
Classes, SysUtils,
Classes, SysUtils,Graphics,bitmaps,
ocrutil,lclintf; // contains the actual `loading'
{
@ -36,42 +36,37 @@ uses
}
type
TMFont = class(TObject)
constructor Create;
destructor Destroy; override;
TMFont = class(TObject)
public
Name: String;
Data: TOcrData;
constructor Create;
destructor Destroy; override;
function Copy: TMFont;
end;
{ TMFonts }
function Copy: TMFont;
public
Name: String;
Data: TOcrData;
end;
type
{ TMFonts }
TMFonts = class(TObject)
private
function GetFontIndex(Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont;
private
Fonts: TList;
Path: String;
Client : TObject;
public
constructor Create(Owner : TObject);
destructor Destroy; override;
function GetFont(Name: String): TOcrData;
function FreeFont(Name: String): boolean;
function LoadFont(Name: String; Shadow: Boolean): boolean;
procedure SetPath(aPath: String);
function GetPath: String;
function Copy(Owner : TObject): TMFonts;
function Count : integer;
property Font[Index : integer]: TMfont read GetFontByIndex; default;
end;
TMFonts = class(TObject)
private
Fonts: TList;
FPath: String;
Client : TObject;
function GetFontIndex(const Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont;
procedure SetPath(const aPath: String);
function GetPath: String;
public
constructor Create(Owner : TObject);
destructor Destroy; override;
function GetFont(const Name: String): TOcrData;
function FreeFont(const Name: String): Boolean;
function LoadFont(const Name: String; Shadow: Boolean): boolean;
function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;
function Copy(Owner : TObject): TMFonts;
function Count : integer;
property Path : string read GetPath write SetPath;
property Font[Index : integer]: TMfont read GetFontByIndex; default;
end;
implementation
@ -159,30 +154,30 @@ begin
inherited;
end;
procedure TMFonts.SetPath(aPath: String);
procedure TMFonts.SetPath(const aPath: String);
begin
Path := aPath;
FPath := aPath;
end;
function TMFonts.GetPath: String;
begin
Exit(Path);
Exit(FPath);
end;
function TMFonts.GetFontIndex(Name: String): Integer;
function TMFonts.GetFontIndex(const Name: String): Integer;
var
i: integer;
begin
for i := 0 to Fonts.Count - 1 do
begin
if Name = TMFont(Fonts.Items[i]).Name then
if lowercase(Name) = lowercase(TMFont(Fonts.Items[i]).Name) then
Exit(i);
end;
raise Exception.Create('Font [' + Name + '] not found.');
Exit(-1);
end;
function TMFonts.GetFont(Name: String): TOcrData;
function TMFonts.GetFont(const Name: String): TOcrData;
var
i: integer;
begin
@ -190,7 +185,7 @@ begin
Exit(TMFont(Fonts.Items[i]).Data);
end;
function TMFonts.FreeFont(Name: String): boolean;
function TMFonts.FreeFont(const Name: String): boolean;
var
i: integer;
begin
@ -203,13 +198,13 @@ begin
end;
end;
function TMFonts.LoadFont(Name: String; Shadow: Boolean): boolean;
function TMFonts.LoadFont(const Name: String; Shadow: Boolean): boolean;
var
f: TMFont;
begin
if not DirectoryExists(Path + Name) then
if not DirectoryExists(FPath + Name) then
begin
raise Exception.Create('LoadFont: Directory ' + Path + Name + ' does not exists.');
raise Exception.Create('LoadFont: Directory ' + FPath + Name + ' does not exists.');
Exit(False);
end;
@ -217,20 +212,66 @@ begin
f.Name := Name;
if Shadow then
F.Name := F.Name + '_s';
f.Data := InitOCR(Path + Name + DS, Shadow);
f.Data := InitOCR( LoadGlyphMasks(FPath + Name + DS, Shadow));
Fonts.Add(f);
{$IFDEF FONTDEBUG}
TClient(Client).Writeln('Loaded Font ' + f.Name);
{$ENDIF}
end;
function TMFonts.LoadSystemFont(const SysFont: TFont; const FontName: string): boolean;
var
Masks : TocrGlyphMaskArray;
i,c : integer;
w,h : integer;
Bmp : TBitmap;
NewFont : TMFont;
MBmp : TMufasaBitmap;
begin
SetLength(Masks,255);
MBmp := TMufasaBitmap.Create;
Bmp := TBitmap.Create;
c := 0;
with Bmp.canvas do
begin
Font := SysFont;
Font.Color:= clWhite;
Font.Quality:= fqNonAntialiased;
Brush.Color:= clBlack;
Pen.Style:= psClear;
for i := 1 to 255 do
begin
GetTextSize(chr(i),w,h);
if (w<=0) or (h<=0) then
Continue;
Bmp.SetSize(w,h);
TextOut(0,0,chr(i));
MBmp.LoadFromTBitmap(bmp);
Masks[c] := LoadGlyphMask(MBmp,false,chr(i));
inc(c);
end;
end;
setlength(masks,c);
if c > 0 then
begin
NewFont := TMFont.Create;
NewFont.Name:= FontName;
NewFont.Data := InitOCR(masks);
Fonts.Add(NewFont);
result := true;
end;
bmp.free;
MBmp.free;
end;
function TMFonts.Copy(Owner : TObject): TMFonts;
var
i:integer;
begin
Result := TMFonts.Create(Owner);
Result.Path := Self.GetPath();
Result.Path := FPath;
for i := 0 to Self.Fonts.Count -1 do
Result.Fonts.Add(TMFont(Self.Fonts.Items[i]).Copy());
end;

View File

@ -1,6 +1,6 @@
unit libloader;
{$mode objfpc}
{$mode objfpc}{$H+}
interface

View File

@ -1,6 +1,6 @@
unit mufasabase;
{$mode objfpc}
{$mode objfpc}{$H+}
interface
{$undefine mDebug}

View File

@ -54,6 +54,7 @@ type
B, G, R, A: Byte;
end;
PRGB32 = ^TRGB32;
TRGB32Array = array of TRGB32;
TRetData = record
Ptr : PRGB32;
@ -100,7 +101,7 @@ type
add seperate tpa or boolean array for every point that is to be matched ?
}
pDTM = packed record
pDTM = record
l: Integer;
p: TPointArray;
c, t, asz, ash: TIntegerArray;

View File

@ -33,53 +33,51 @@ uses
graphtype, intfgraphics,graphics;
{End To-Remove unit}
type
{ TMOCR }
type
{ TMOCR }
TMOCR = class(TObject)
constructor Create(Owner: TObject);
destructor Destroy; override;
function InitTOCR(path: string): boolean;
function GetFonts:TMFonts;
procedure SetFonts(NewFonts: TMFonts);
TMOCR = class(TObject)
private
Client: TObject;
FFonts: TMFonts;
{$IFDEF OCRDEBUG}
debugbmp: TMufasaBitmap;
{$ENDIF}
function GetFonts:TMFonts;
procedure SetFonts(const NewFonts: TMFonts);
public
constructor Create(Owner: TObject);
destructor Destroy; override;
function InitTOCR(const path: string): boolean;
function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean;
var _chars, _shadows: T2DPointArray): Boolean;
function GetUpTextAtEx(atX, atY: integer; shadow: boolean): string;
function GetUpTextAt(atX, atY: integer; shadow: boolean): string;
function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean;
var _chars, _shadows: T2DPointArray): Boolean;
function GetUpTextAtEx(atX, atY: integer; shadow: boolean): string;
function GetUpTextAt(atX, atY: integer; shadow: boolean): string;
procedure FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
procedure FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
procedure FilterShadowBitmap(bmp: TMufasaBitmap);
procedure FilterCharsBitmap(bmp: TMufasaBitmap);
procedure FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
procedure FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
procedure FilterShadowBitmap(bmp: TMufasaBitmap);
procedure FilterCharsBitmap(bmp: TMufasaBitmap);
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string;
function TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;
function TextToFontBitmap(Text, font: String): TMufasaBitmap;
function TextToMask(Text, font: String): TMask;
property Fonts : TMFonts read GetFonts write SetFonts;
{$IFDEF OCRDEBUG}
procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
{$ENDIF}
end;
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string;
function TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;
function TextToFontBitmap(Text, font: String): TMufasaBitmap;
function TextToMask(Text, font: String): TMask;
{$IFDEF OCRDEBUG}
procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
{$ENDIF}
private
Client: TObject;
Fonts: TMFonts;
{$IFDEF OCRDEBUG}
public
debugbmp: TMufasaBitmap;
{$ENDIF}
end;
{$IFDEF OCRDEBUG}
{$IFDEF LINUX}
const OCRDebugPath = '/tmp/';
{$ELSE}
const OCRDebugPath = '';
{$ENDIF}
{$ENDIF}
{$IFDEF OCRDEBUG}
{$IFDEF LINUX}
const OCRDebugPath = '/tmp/';
{$ELSE}
const OCRDebugPath = '';
{$ENDIF}
{$ENDIF}
implementation
uses
@ -121,15 +119,13 @@ constructor TMOCR.Create(Owner: TObject);
begin
inherited Create;
Self.Client := Owner;
Self.Fonts := TMFonts.Create(Owner);
Self.FFonts := TMFonts.Create(Owner);
end;
{ Destructor }
destructor TMOCR.Destroy;
begin
Self.Fonts.Free;
Self.FFonts.Free;
inherited Destroy;
end;
@ -137,34 +133,34 @@ end;
InitTOCR loads all fonts in path
We don't do this in the constructor because we may not yet have the path.
}
function TMOCR.InitTOCR(path: string): boolean;
function TMOCR.InitTOCR(const path: string): boolean;
var
dirs: array of string;
i: longint;
begin
// We're going to load all fonts now
Fonts.SetPath(path);
FFonts.Path := path;
dirs := GetDirectories(path);
Result := false;
for i := 0 to high(dirs) do
begin
if Fonts.LoadFont(dirs[i], false) then
if FFonts.LoadFont(dirs[i], false) then
result := true;
end;
If DirectoryExists(path + 'UpChars') then
Fonts.LoadFont('UpChars', true); // shadow
FFonts.LoadFont('UpChars', true); // shadow
end;
{ Get the current pointer to our list of Fonts }
function TMOCR.GetFonts:TMFonts;
begin
Exit(Self.Fonts);
Exit(Self.FFonts);
end;
{ Set new Fonts. We set it to a Copy of NewFonts }
procedure TMOCR.SetFonts(NewFonts: TMFonts);
procedure TMOCR.SetFonts(const NewFonts: TMFonts);
begin
Self.Fonts := NewFonts.Copy(Self.Client);
Self.FFonts := NewFonts.Copy(Self.Client);
end;
{
@ -644,12 +640,12 @@ begin
if shadow then
begin
font := Fonts.GetFont('UpChars_s');
font := FFonts.GetFont('UpChars_s');
thachars := shadows;
end
else
begin
font := Fonts.GetFont('UpChars');
font := FFonts.GetFont('UpChars');
thachars := chars;
end;
@ -714,7 +710,7 @@ var
STPA: T2DPointArray;
begin
fD := Fonts.GetFont(font);
fD := FFonts.GetFont(font);
{writeln(format('W, H: %d, %d', [fD.max_width, fd.max_height]));}
TClient(Client).IOManager.GetDimensions(w, h);
@ -812,7 +808,7 @@ begin
if (tpa[j].x) + ((tpa[j].y) * fD.width) <= high(n) then
n[(tpa[j].x) + ((tpa[j].y) * fD.width)] := 1
else
raise Exception.Create('The automatically split characters are too wide. Try decreasing minspacing');
mDebugLn('The automatically split characters are too wide. Try decreasing minspacing');
end;
result := result + GuessGlyph(n, fD);
end;
@ -827,7 +823,7 @@ var
an: integer;
begin
fontD := Fonts.GetFont(font);
fontD := FFonts.GetFont(font);
c := 0;
off := 0;
setlength(result, 0);

View File

@ -5,63 +5,48 @@ unit ocrutil;
interface
uses
Classes, SysUtils, MufasaTypes;
Classes, SysUtils, MufasaTypes,bitmaps;
type
TNormArray = array of integer;
TocrGlyphMask = record
ascii: char;
width,height: integer;
l,r,t,b: integer;
mask: TNormArray;
end;
TocrGlyphMaskArray = array of TocrGlyphMask;
TocrGlyphMetric = record
xoff,yoff: integer;
width,height: integer;
index: integer; //stores the internal TocrData index for this char
end;
TocrData = record
ascii: array[0..255] of TocrGlyphMetric;
pos: array of array of integer;
pos_adj: array of real;
neg: array of array of integer;
neg_adj: array of real;
map: array of char;
width,height, max_width, max_height: integer;
inputs,outputs: integer;
end;
TNormArray = array of integer;
TocrGlyphMask = record
ascii: char;
width,height: integer;
l,r,t,b: integer;
mask: TNormArray;
end;
TocrGlyphMaskArray = array of TocrGlyphMask;
TocrGlyphMetric = record
xoff,yoff: integer;
width,height: integer;
index: integer; //stores the internal TocrData index for this char
end;
TocrData = record
ascii: array[0..255] of TocrGlyphMetric;
pos: array of array of integer;
pos_adj: array of real;
neg: array of array of integer;
neg_adj: array of real;
map: array of char;
width,height, max_width, max_height: integer;
inputs,outputs: integer;
end;
TocrDataArray = array of TocrData;
TocrDataArray = array of TocrData;
{ We already have PRGB32 -> To be removed later }
type
tRGB = packed record
B, G, R, A: Byte;
end;
tRGBArray = array of tRGB;
tLab = record
L,a,b: real;
end;
{Begin To be removed}
Tbmp = record
data: array of tRGB;
width,height: integer;
end;
{End To be removed}
tLab = record
L,a,b: real;
end;
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
function LoadGlyphMasks(path: string; shadow: boolean): TocrGlyphMaskArray;
function InitOCR(path: string; shadow: boolean): TocrData;
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
function ImageToNorm(src: tRGBArray; w,h: integer): TNormArray;
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
function MakeTPAString(str: string): TpointArray;
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
function LoadGlyphMask(const bmp : TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
function InitOCR(const Masks : TocrGlyphMaskArray): TocrData;
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
implementation
uses
@ -70,425 +55,405 @@ uses
graphtype, intfgraphics,graphics;
{End To-Remove unit}
function ReadBMP(path: string): Tbmp;
var
LazIntf : TLazIntfImage;
RawImageDesc : TRawImageDescription;
begin
if FileExists(path) then
begin;
LazIntf := TLazIntfImage.Create(0,0);
RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height);
LazIntf.DataDescription := RawImageDesc;
LazIntf.LoadFromFile(path);
Result.width := LazIntf.Width;
Result.height := LazIntf.Height;
SetLength(result.data,LazIntf.Width*LazIntf.Height);
Move(LazIntf.PixelData[0],result.data[0],LazIntf.Width*LazIntf.Height*sizeOf(tRGB));
LazIntf.Free;
end;
end;
{initalizes the remaining fields from a TocrGlyphMask and finds the global bounds}
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
var
i,x,y,c,w,h: integer;
l,r,t,b: integer;
dat: TNormArray;
i,x,y,c,w,h: integer;
l,r,t,b: integer;
dat: TNormArray;
begin
width:= 0;
height:= 0;
for c:= 0 to length(glyphs) - 1 do
width:= 0;
height:= 0;
for c:= 0 to length(glyphs) - 1 do
begin
dat:= glyphs[c].mask;
w:= glyphs[c].width;
h:= glyphs[c].height;
l:= w;
r:= 0;
t:= h;
b:= 0;
for i:= 0 to w*h-1 do
begin
dat:= glyphs[c].mask;
w:= glyphs[c].width;
h:= glyphs[c].height;
l:= w;
r:= 0;
t:= h;
b:= 0;
for i:= 0 to w*h-1 do
begin
if dat[i] = 1 then
begin
x:= i mod w;
y:= i div w;
if x > r then r:= x;
if x < l then l:= x;
if y > b then b:= y;
if y < t then t:= y;
end;
end;
if l = w then l:= 0;
if t = h then t:= 0;
glyphs[c].r:= r;
glyphs[c].l:= l;
glyphs[c].b:= b;
glyphs[c].t:= t;
if (r - l + 1) > width then width:= r - l + 1;
if (b - t + 1) > height then height:= b - t + 1;
if dat[i] = 1 then
begin
x:= i mod w;
y:= i div w;
if x > r then r:= x;
if x < l then l:= x;
if y > b then b:= y;
if y < t then t:= y;
end;
end;
if l = w then l:= 0;
if t = h then t:= 0;
glyphs[c].r:= r;
glyphs[c].l:= l;
glyphs[c].b:= b;
glyphs[c].t:= t;
if (r - l + 1) > width then width:= r - l + 1;
if (b - t + 1) > height then height:= b - t + 1;
end;
end;
{Use whatever you want if you don't like this}
function GetFiles(Path, Ext: string): TstringArray;
var
SearchRec : TSearchRec;
c : integer;
SearchRec : TSearchRec;
c : integer;
begin
c := 0;
if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then
begin
repeat
inc(c);
SetLength(Result,c);
Result[c-1] := SearchRec.Name;
until FindNext(SearchRec) <> 0;
SysUtils.FindClose(SearchRec);
end;
c := 0;
if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then
begin
repeat
inc(c);
SetLength(Result,c);
Result[c-1] := SearchRec.Name;
until FindNext(SearchRec) <> 0;
SysUtils.FindClose(SearchRec);
end;
end;
function LoadGlyphMask(const bmp: TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
var
size,j: integer;
color: TRGB32;
shadow_i: byte;
begin
if shadow then
shadow_i := 0
else
shadow_i := 255;
size:= bmp.Width * bmp.Height;
SetLength(result.mask,size);
for j := 0 to size-1 do
begin
color := bmp.FData[j];
{ if (color.r = 255) and (color.g = 255 and not shadow_i) and
(color.b = 255 and not shadow_i) then}
if (color.r = 255) and (color.g = shadow_i) and (color.b = shadow_i) then
result.mask[j]:= 1
else
result.mask[j]:= 0;
end;
result.width:= bmp.width;
result.height:= bmp.height;
result.ascii:= ascii;
end;
{This Loads the actual data from the .bmp, but does not init all fields}
function LoadGlyphMasks(path: string; shadow: boolean): TocrGlyphMaskArray;
function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
var
strs: array of string;
bmp: array of Tbmp; {-> TMufasaBitmap, and why use an array? }
len,size,i,j: integer;
color: tRGB;
shadow_i: byte;
strs: array of string;
bmp : TMufasaBitmap;
len,i: integer;
begin
strs:= GetFiles(path,'bmp');
len:= length(strs);
SetLength(result,len);
SetLength(bmp,len);
if shadow then
shadow_i := 0
else
shadow_i := 255;
for i:= 0 to len-1 do
begin
bmp[i]:= ReadBmp(path + strs[i]);
size:= bmp[i].width*bmp[i].height;
SetLength(result[i].mask,size);
for j:= 0 to size-1 do
begin
color:= bmp[i].data[j];
{ if (color.r = 255) and (color.g = 255 and not shadow_i) and
(color.b = 255 and not shadow_i) then}
if (color.r = 255) and (color.g = shadow_i) and (color.b = shadow_i) then
result[i].mask[j]:= 1
else
result[i].mask[j]:= 0;
end;
result[i].width:= bmp[i].width;
result[i].height:= bmp[i].height;
SetLength(strs[i],Length(strs[i])-4);
result[i].ascii:= chr(strtoint(strs[i]));
end;
strs:= GetFiles(path,'bmp');
len:= length(strs);
SetLength(result,len);
bmp := TMufasaBitmap.Create;
for i:= 0 to len-1 do
begin
bmp.LoadFromFile(path + strs[i]);
SetLength(strs[i],Length(strs[i])-4);
Result[i] := LoadGlyphMask(bmp,shadow,chr(strtoint(strs[i])));
end;
Bmp.free;
end;
{Fully initalizes a TocrData structure, this is LoadFont or whatever, call it first}
function InitOCR(path: string; shadow: boolean): TocrData;
function InitOCR(const masks : TocrGlyphMaskArray): TocrData;
var
masks: TocrGlyphMaskArray;
t,b,l,r,w,h,mw: integer;
x,y: integer;
c,i,len,size: integer;
pos: integer;
ascii: char;
t,b,l,r,w,h,mw: integer;
x,y: integer;
c,i,len,size: integer;
pos: integer;
ascii: char;
begin
masks:= LoadGlyphMasks(path, shadow);
w:= 0;
h:= 0;
findBounds(masks,w,h);
len:= Length(masks);
result.width:= w;
result.height:= h;
result.max_width:=0;
result.max_height:=0;
size:= w * h;
SetLength(result.pos,len,size);
SetLength(result.pos_adj,len);
SetLength(result.neg,len,size);
SetLength(result.neg_adj,len);
SetLength(result.map,len);
for i:= 0 to len - 1 do
w:= 0;
h:= 0;
findBounds(masks,w,h);
len:= Length(masks);
result.width:= w;
result.height:= h;
result.max_width:=0;
result.max_height:=0;
size:= w * h;
SetLength(result.pos,len,size);
SetLength(result.pos_adj,len);
SetLength(result.neg,len,size);
SetLength(result.neg_adj,len);
SetLength(result.map,len);
for i:= 0 to len - 1 do
begin
ascii:= masks[i].ascii;
pos:= 0;
l:= masks[i].l;
r:= masks[i].r;
b:= masks[i].b;
t:= masks[i].t;
mw:= masks[i].width;
for y:= t to b do
begin
ascii:= masks[i].ascii;
pos:= 0;
l:= masks[i].l;
r:= masks[i].r;
b:= masks[i].b;
t:= masks[i].t;
mw:= masks[i].width;
for y:= t to b do
for x:= l to r do
begin
c:= (x-l) + (y-t)*w;
if masks[i].mask[x+y*mw] <> 0 then
begin
for x:= l to r do
begin
c:= (x-l) + (y-t)*w;
if masks[i].mask[x+y*mw] <> 0 then
begin
result.pos[i][c]:= 1;
inc(pos);
end else
result.pos[i][c] := 0;
end;
end;
for c:= 0 to size-1 do
result.neg[i][c]:= 1 - result.pos[i][c];
if pos = 0 then result.neg_adj[i]:= 1 else result.neg_adj[i]:= 1 / pos;
if pos = 0 then result.pos_adj[i]:= 0 else result.pos_adj[i]:= 1 / pos;
result.map[i]:= ascii;
result.ascii[ord(ascii)].index:= i;
result.ascii[ord(ascii)].xoff:= masks[i].l;
result.ascii[ord(ascii)].yoff:= masks[i].t;
result.ascii[ord(ascii)].width:= masks[i].width;
result.ascii[ord(ascii)].height:= masks[i].height;
result.max_width := max(result.max_width, masks[i].width);
result.max_height := max(result.max_height, masks[i].height);
result.pos[i][c]:= 1;
inc(pos);
end else
result.pos[i][c] := 0;
end;
end;
result.inputs:= size;
result.outputs:= len;
for c:= 0 to size-1 do
result.neg[i][c]:= 1 - result.pos[i][c];
if pos = 0 then result.neg_adj[i]:= 1 else result.neg_adj[i]:= 1 / pos;
if pos = 0 then result.pos_adj[i]:= 0 else result.pos_adj[i]:= 1 / pos;
result.map[i]:= ascii;
result.ascii[ord(ascii)].index:= i;
result.ascii[ord(ascii)].xoff:= masks[i].l;
result.ascii[ord(ascii)].yoff:= masks[i].t;
result.ascii[ord(ascii)].width:= masks[i].width;
result.ascii[ord(ascii)].height:= masks[i].height;
result.max_width := max(result.max_width, masks[i].width);
result.max_height := max(result.max_height, masks[i].height);
end;
result.inputs:= size;
result.outputs:= len;
end;
{guesses a glyph stored in glyph (which is an 1-0 image of the size specified by width and height in ocrdata}
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
var
i,c,inputs,outputs,val: integer;
pos_weights: array of real;
neg_weights: array of real;
max, weight: real;
i,c,inputs,outputs,val: integer;
pos_weights: array of real;
neg_weights: array of real;
max, weight: real;
begin
SetLength(pos_weights,ocrdata.outputs);
SetLength(neg_weights,ocrdata.outputs);
inputs:= ocrdata.inputs - 1;
outputs:= ocrdata.outputs - 1;
for i:= 0 to inputs do
SetLength(pos_weights,ocrdata.outputs);
SetLength(neg_weights,ocrdata.outputs);
inputs:= ocrdata.inputs - 1;
outputs:= ocrdata.outputs - 1;
for i:= 0 to inputs do
begin
val:= glyph[i];
for c:= 0 to outputs do
begin
val:= glyph[i];
for c:= 0 to outputs do
begin
pos_weights[c]:= pos_weights[c] + ocrdata.pos[c][i] * val;
neg_weights[c]:= neg_weights[c] + ocrdata.neg[c][i] * val;
end
end;
max:= 0;
for i:= 0 to outputs do
pos_weights[c]:= pos_weights[c] + ocrdata.pos[c][i] * val;
neg_weights[c]:= neg_weights[c] + ocrdata.neg[c][i] * val;
end
end;
max:= 0;
for i:= 0 to outputs do
begin
weight:= pos_weights[i] * ocrdata.pos_adj[i] - neg_weights[i] * ocrdata.neg_adj[i];
if (weight > max) then
begin
weight:= pos_weights[i] * ocrdata.pos_adj[i] - neg_weights[i] * ocrdata.neg_adj[i];
if (weight > max) then
begin
max:= weight;
result:= ocrdata.map[i];
end;
max:= weight;
result:= ocrdata.map[i];
end;
end;
end;
{converts a TPA into a 1-0 image of the smallest possible size}
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
var
l,r,t,b: integer;
i,len,size: integer;
norm: TNormArray;
l,r,t,b: integer;
i,len,size: integer;
norm: TNormArray;
begin
len:= length(points);
l:= points[0].x;
r:= points[0].x;
t:= points[0].y;
b:= points[0].y;
for i:= 1 to len-1 do
begin
if points[i].x < l then l:= points[i].x;
if points[i].x > r then r:= points[i].x;
if points[i].y < t then t:= points[i].y;
if points[i].y > b then b:= points[i].y;
end;
w:= r - l + 1;
h:= b - t + 1;
size:= w * h;
SetLength(norm,size);
for i:= 0 to len-1 do
norm[(points[i].x - l) + (points[i].y - t) * w]:= 1;
result:= norm;
len:= length(points);
l:= points[0].x;
r:= points[0].x;
t:= points[0].y;
b:= points[0].y;
for i:= 1 to len-1 do
begin
if points[i].x < l then l:= points[i].x;
if points[i].x > r then r:= points[i].x;
if points[i].y < t then t:= points[i].y;
if points[i].y > b then b:= points[i].y;
end;
w:= r - l + 1;
h:= b - t + 1;
size:= w * h;
SetLength(norm,size);
for i:= 0 to len-1 do
norm[(points[i].x - l) + (points[i].y - t) * w]:= 1;
result:= norm;
end;
function ImageToNorm(src: tRGBArray; w,h: integer): TNormArray;
function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
var
norm: TNormArray;
i: integer;
norm: TNormArray;
i: integer;
begin
SetLength(norm,w*h);
for i:= 0 to w*h-1 do
if (src[i].r = 255) and (src[i].g = 255) and (src[i].b = 255) then
norm[i]:= 1 else norm[i]:= 0;
result:= norm;
SetLength(norm,w*h);
for i:= 0 to w*h-1 do
if (src[i].r = 255) and (src[i].g = 255) and (src[i].b = 255) then
norm[i]:= 1 else norm[i]:= 0;
result:= norm;
end;
{takes a mask of only one line of text, a TocrData, and returns the string in it}
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
var
l,r,t,b,x,y,xx,yy: integer;
upper,left,last,spaces: integer;
glyph: TNormArray;
empty: boolean;
ascii: char;
l,r,t,b,x,y,xx,yy: integer;
upper,left,last,spaces: integer;
glyph: TNormArray;
empty: boolean;
ascii: char;
begin
result:= '';
l:= -1;
r:= -1;
upper:= -9001; //large negative
left:= -9001; //large negative
x:= 0;
while x < w do
result:= '';
l:= -1;
r:= -1;
upper:= -9001; //large negative
left:= -9001; //large negative
x:= 0;
while x < w do
begin
empty:= true;
for y:= 0 to h-1 do
begin
empty:= true;
for y:= 0 to h-1 do
begin
if txt[x+y*w] = 1 then
begin
empty:= false;
break;
end;
end;
if (l = -1) and (not empty) then
begin
l:= x
end else if (l <> -1) then
begin
if empty then
r:= x - 1
else if x = w-1 then
r:= x;
end;
if (r <> -1) and (l <> -1) then
begin
t:= -1;
b:= -1;
SetLength(glyph,0);
SetLength(glyph,ocrdata.width*ocrdata.height);
for yy:= 0 to h-1 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin t:= yy; break; end;
if t <> -1 then break;
end;
for yy:= h-1 downto 0 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin b:= yy; break; end;
if b <> -1 then break;
end;
if b - t + 1 > ocrdata.height then b:= b - (b-t+1-ocrdata.height);
if r - l + 1 > ocrdata.width then r:= r - (r-l+1-ocrdata.width);
for yy:= t to b do
for xx:= l to r do
glyph[(xx-l) + (yy-t)*ocrdata.width]:= txt[xx+yy*w];
ascii:= GuessGlyph(glyph,ocrdata);
if (upper = -9001) or (left = -9001) then
begin
upper:= t - ocrdata.ascii[ord(ascii)].yoff;
left:= l - ocrdata.ascii[ord(ascii)].xoff + ocrdata.ascii[ord(ascii)].width;
x:= left;
end else
begin
last:= left;
left:= l - ocrdata.ascii[ord(ascii)].xoff;
if last <> left then
begin
for spaces:= 1 to (left - last) div ocrdata.ascii[32].width do
result:= result + ' ';
end;
left:= left + ocrdata.ascii[ord(ascii)].width;
x:= left;
end;
result:= result + ascii;
l:= -1;
r:= -1;
end;
inc(x);
if txt[x+y*w] = 1 then
begin
empty:= false;
break;
end;
end;
if (l = -1) and (not empty) then
begin
l:= x
end else if (l <> -1) then
begin
if empty then
r:= x - 1
else if x = w-1 then
r:= x;
end;
if (r <> -1) and (l <> -1) then
begin
t:= -1;
b:= -1;
SetLength(glyph,0);
SetLength(glyph,ocrdata.width*ocrdata.height);
for yy:= 0 to h-1 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin t:= yy; break; end;
if t <> -1 then break;
end;
for yy:= h-1 downto 0 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin b:= yy; break; end;
if b <> -1 then break;
end;
if b - t + 1 > ocrdata.height then b:= b - (b-t+1-ocrdata.height);
if r - l + 1 > ocrdata.width then r:= r - (r-l+1-ocrdata.width);
for yy:= t to b do
for xx:= l to r do
glyph[(xx-l) + (yy-t)*ocrdata.width]:= txt[xx+yy*w];
ascii:= GuessGlyph(glyph,ocrdata);
if (upper = -9001) or (left = -9001) then
begin
upper:= t - ocrdata.ascii[ord(ascii)].yoff;
left:= l - ocrdata.ascii[ord(ascii)].xoff + ocrdata.ascii[ord(ascii)].width;
x:= left;
end else
begin
last:= left;
left:= l - ocrdata.ascii[ord(ascii)].xoff;
if last <> left then
begin
for spaces:= 1 to (left - last) div ocrdata.ascii[32].width do
result:= result + ' ';
end;
left:= left + ocrdata.ascii[ord(ascii)].width;
x:= left;
end;
result:= result + ascii;
l:= -1;
r:= -1;
end;
inc(x);
end;
end;
function AvgColors(color1:tRGB; weight1: integer; color2: tRGB; weight2: integer): tRGB;
function AvgColors(color1:TRGB32; weight1: integer; color2: TRGB32; weight2: integer): TRGB32;
begin
result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2);
result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2);
result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2);
result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2);
result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2);
result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2);
end;
procedure RGBtoXYZ(color: tRGB; out X, Y, Z: real); inline;
procedure RGBtoXYZ(color: TRGB32; out X, Y, Z: real); inline;
var
nr,ng,nb: real;
nr,ng,nb: real;
begin
nr:= color.r / 255.0;
ng:= color.g / 255.0;
nb:= color.b / 255.0;
if nr <= 0.04045 then nr:= nr / 12.92 else nr:= power((nr + 0.055)/1.055,2.4);
if ng <= 0.04045 then ng:= ng / 12.92 else ng:= power((ng + 0.055)/1.055,2.4);
if nb <= 0.04045 then nr:= nb / 12.92 else nb:= power((nb + 0.055)/1.055,2.4);
X:= 0.4124*nr + 0.3576*ng + 0.1805*nb;
Y:= 0.2126*nr + 0.7152*ng + 0.0722*nb;
Z:= 0.0193*nr + 0.1192*ng + 0.9505*nb;
nr:= color.r / 255.0;
ng:= color.g / 255.0;
nb:= color.b / 255.0;
if nr <= 0.04045 then nr:= nr / 12.92 else nr:= power((nr + 0.055)/1.055,2.4);
if ng <= 0.04045 then ng:= ng / 12.92 else ng:= power((ng + 0.055)/1.055,2.4);
if nb <= 0.04045 then nr:= nb / 12.92 else nb:= power((nb + 0.055)/1.055,2.4);
X:= 0.4124*nr + 0.3576*ng + 0.1805*nb;
Y:= 0.2126*nr + 0.7152*ng + 0.0722*nb;
Z:= 0.0193*nr + 0.1192*ng + 0.9505*nb;
end;
function labmod(i: real): real; inline;
begin
if i > power(0.206896552,3) then
result:= power(i,0.333333333)
else
result:= 7.787037037*i + 0.137931034;
if i > power(0.206896552,3) then
result:= power(i,0.333333333)
else
result:= 7.787037037*i + 0.137931034;
end;
function ColortoLab(c: tRGB): tLab; inline;
function ColortoLab(c: TRGB32): tLab; inline;
var
X,Y,Z,sum,Xn,Yn,Zn: real;
X,Y,Z,sum,Xn,Yn,Zn: real;
begin
RGBtoXYZ(c,X,Y,Z);
sum:= X + Y + Z;
if(sum = 0) then
begin
result.l := 0.0;
result.a := 0.0;
result.b := 0.0;
end;
Xn:= X / sum;
Yn:= Y / sum;
Zn:= Z / sum;
result.L:= 116.0*labmod(y/yn) - 16.0;
result.a:= 500.0*(labmod(x/xn)-labmod(y/yn));
result.b:= 500.0*(labmod(y/yn)-labmod(z/zn));
RGBtoXYZ(c,X,Y,Z);
sum:= X + Y + Z;
if(sum = 0) then
begin
result.l := 0.0;
result.a := 0.0;
result.b := 0.0;
end;
Xn:= X / sum;
Yn:= Y / sum;
Zn:= Z / sum;
result.L:= 116.0*labmod(y/yn) - 16.0;
result.a:= 500.0*(labmod(x/xn)-labmod(y/yn));
result.b:= 500.0*(labmod(y/yn)-labmod(z/zn));
end;
function colorDistSqr(a,b:tRGB): integer; inline;
function colorDistSqr(a,b:TRGB32): integer; inline;
begin
result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g);
result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g);
end;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
const
GradientMax = 2.0;
white: tRGB = ( b: $FF; g: $FF; r: $FF; a: $00 );
cyan: tRGB = ( b: $FF; g: $FF; r: $00; a: $00 );
yellow: tRGB = ( b: $00; g: $EF; r: $FF; a: $00 );
red: tRGB = ( b: $00; g: $00; r: $FF; a: $00 );
green: tRGB = ( b: $00; g: $FF; r: $00; a: $00 );
white: TRGB32= ( b: $FF; g: $FF; r: $FF; a: $00 );
cyan: TRGB32= ( b: $FF; g: $FF; r: $00; a: $00 );
yellow: TRGB32= ( b: $00; g: $EF; r: $FF; a: $00 );
red: TRGB32= ( b: $00; g: $00; r: $FF; a: $00 );
green: TRGB32= ( b: $00; g: $FF; r: $00; a: $00 );
var
up, left: boolean;
len,numblobs,thisblob,lastblob,i,j,used: integer;
blobbed,blobcount,stack: array of integer;
labs: array of tLab;
a,b: tLab;
blobcolor: tRGBArray;
blobcolor: TRGB32Array;
newcolors: array of integer;
c: tRGB;
c: TRGB32;
norm: TNormArray;
begin
len:= w*h;
@ -498,7 +463,7 @@ begin
SetLength(stack,len);
SetLength(labs,len);
for i:= 0 to len-1 do
labs[i]:= ColorToLab(tRGB(colors[i]));
labs[i]:= ColorToLab( TRGB32(colors[i]));
numblobs:= 0;
for i:= 0 to len-1 do
begin
@ -519,7 +484,7 @@ begin
begin
thisblob:= blobbed[i-w];
blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1);
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1;
lastblob:= blobbed[i-1];
if lastblob <> thisblob then
@ -547,19 +512,19 @@ begin
begin
thisblob:= blobbed[i-1];
blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1);
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1;
end else if up then
begin
thisblob:= blobbed[i-w];
blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1);
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1;
end else
begin
blobbed[i]:= numblobs;
blobcount[numblobs]:= 1;
blobcolor[numblobs]:= tRGB(colors[i]);
blobcolor[numblobs]:= tRGB32(colors[i]);
numblobs:= numblobs + 1;
end;
end;
@ -595,32 +560,5 @@ begin
result:= norm;
end;
function MakeTPAString(str: string): TpointArray;
var
i,j,c,off: integer;
bmp: array of Tbmp;
begin
raise Exception.Create('MakeTPAString sucks ass, don''t use it.');
c:= 0;
off:= 0;
SetLength(bmp,length(str));
for i:= 0 to length(str)-1 do
begin
bmp[i]:= ReadBmp('/home/merlijn/Programs/mufasa/Fonts/StatChars/' + inttostr(ord(str[i+1])) + '.bmp');
SetLength(result,c+bmp[i].width*bmp[i].height);
for j:= 0 to bmp[i].width*bmp[i].height - 1 do
begin
if bmp[i].data[j].g = 255 then
begin
result[c].x:= j mod bmp[i].width + off;
result[c].y:= j div bmp[i].width;
inc(c);
end;
end;
off:= off + bmp[i].width;
SetLength(result,c);
end;
end;
end.

View File

@ -69,13 +69,23 @@ interface
function GetNativeWindow: TNativeWindow;
private
{ display is the connection to the X server }
display: PDisplay;
{ screen-number and selected window }
screennum: integer;
window: x.TWindow;
{ Reference to the XImage }
buffer: PXImage;
{ For memory-leak checks }
dirty: Boolean; //true if image loaded
{ KeyInput class }
keyinput: TKeyInput;
{ X Error Handler }
oldXHandler: TXErrorHandler;
end;
@ -101,27 +111,32 @@ implementation
uses GraphType, interfacebase, lcltype;
{ PROBLEM: .Create is called on the main thread. ErrorCS etc aren't
created on other threads. We will create them on the fly... }
created on other threads. We will create them on the fly...
More info below...}
threadvar
xerror: string;
threadvar
ErrorCS: syncobjs.TCriticalSection;
{
This is extremely hacky, but also very useful.
We have to install a X error handler, because otherwise X
will terminate out entire app on error.
//***implementation*** TKeyInput
Since we want the right thread to recieve the right error, we have to
fiddle a bit with threadvars, mutexes / semaphores.
procedure TKeyInput.Down(Key: Word);
begin
DoDown(Key);
end;
Another problem is that the script thread is initialised on the main thread.
This means that all (threadvar!) semaphores initialised on the mainthread
are NOT initialised on the script thread, which has yet to be started.
Therefore, we check if it hasn't been created yet.
procedure TKeyInput.Up(Key: Word);
begin
DoUp(Key);
end;
** Horrible solution, but WFM **
//***implementation*** TWindow
This is the Handler function.
}
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
@ -158,6 +173,20 @@ implementation
mDebugLn('Type: ' + inttostr(para2^._type));
end;
{ TKeyInput }
procedure TKeyInput.Down(Key: Word);
begin
DoDown(Key);
end;
procedure TKeyInput.Up(Key: Word);
begin
DoUp(Key);
end;
{ TWindow }
function TWindow.GetError: String;
begin
exit(xerror);
@ -173,6 +202,7 @@ implementation
xerror := '';
end;
{ See if the semaphores / CS are initialised }
constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow);
begin
inherited Create;

View File

@ -35,7 +35,7 @@ type
{$IFDEF ccFORMCAPTION}
procedure DoSelectionChange(User: Boolean); override;
{$ENDIF}
procedure DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
{$IFDEF FPC}
procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL;
@ -99,6 +99,7 @@ type
procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean);
function PrepareParamString(out Str : string; out MustHide : boolean) : integer;
public
destructor Destroy; override;
constructor Create(TheOwner: TComponent); override;
procedure CalculateBounds;
procedure UpdateHint;
@ -319,7 +320,7 @@ begin
end;
{$ENDIF}
procedure TAutoCompleteListBox.DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
procedure TAutoCompleteListBox.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
p1, p2, p3, tl, col: Integer;
s, c: string;
@ -417,7 +418,6 @@ begin
ControlStyle := ControlStyle + [csOpaque];
BorderStyle := bsNone;
Style := lbOwnerDrawFixed;
OnDrawItem := {$IFDEF FPC}@{$ENDIF}DrawItem;
IntegralHeight := True;
{$IFDEF FPC}
@ -707,6 +707,12 @@ begin
Parser.Free;
end;
destructor TParamHint.Destroy;
begin
Application.RemoveOnIdleHandler(@ApplicationIdle);
inherited Destroy;
end;
constructor TParamHint.Create(TheOwner: TComponent);
begin

View File

@ -548,7 +548,7 @@ begin
end;
end;
function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount,CommaCount: Integer; out sp: Integer; IgnoreBrackets: Boolean): string;
function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; out sp: Integer; IgnoreBrackets: Boolean): string;
var
i, StartPos, EndPos: Integer;
s: string;
@ -662,14 +662,14 @@ end;
function TCodeInsight.FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration;
function PartOfWith(s: string; out Decl: TDeclaration; Return: TVarBase; CheckClass: Boolean): Boolean;
function PartOfWith(s: string; out Decl: TDeclaration; Return: TVarBase; CheckClass: Boolean; var ArrayCount: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := High(InWith) downto Low(InWith) do
if CheckClass xor (i <> InClassFunction) then
if TciStruct(InWith[i]).HasField(s, Decl, Return) then
if TciStruct(InWith[i]).HasField(s, Decl, Return, ArrayCount) then
begin
Result := True;
Break;
@ -823,10 +823,10 @@ begin
VarBase := vbType;
if (InStruct <> nil) then
Found := InStruct.HasField(f, Result, VarBase)
Found := InStruct.HasField(f, Result, VarBase, NeedArrayCount)
else
begin
Found := CheckVar and PartOfWith(f, Result, VarBase, False);
Found := CheckVar and PartOfWith(f, Result, VarBase, False, NeedArrayCount);
if (not Found) and (i = Low(sa)) then
begin
Found :=
@ -835,7 +835,7 @@ begin
DoFindStruct(f, Result, VarBase, NeedArrayCount);
end;
if (not Found) and CheckVar then
Found := PartOfWith(f, Result, VarBase, True);
Found := PartOfWith(f, Result, VarBase, True, NeedArrayCount);
end;
if Found and (Result is TciTypeKind) then
@ -888,7 +888,7 @@ begin
inherited Create;
Proposal_InsertList := TStringList.Create;
//TStringList(Proposal_InsertList).Sorted := True;
TStringList(Proposal_InsertList).Sorted := True;
Proposal_ItemList := TStringList.Create;
fOnFindInclude := nil;
@ -985,9 +985,12 @@ procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, Ins
begin
Result := 'Enumeration';
if (Item.Items.Count > 0) then
begin
Result := Result + '(' + Item.Items[0].ShortText;
if (Item.Items.Count > 1) then
Result := Result + '..' + Item.Items[Item.Items.Count - 1].ShortText + ')';
if (Item.Items.Count > 1) then
Result := Result + '..' + Item.Items[Item.Items.Count - 1].ShortText;
Result := Result + ')';
end;
end;
procedure AddEnums(Item: {TCodeInsight}TDeclaration; ItemList, InsertList: TStrings); overload;
@ -1015,6 +1018,11 @@ procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, Ins
else if a[ii].HasOwnerClass(TciProcedureDeclaration, d, True) and (d.Owner <> nil) then
Continue;}
{$IFDEF ciCHECKDUPLICATES}
if (InsertList.IndexOf(a[ii].ShortText) > -1) then
Continue;
{$ENDIF}
s := FormatFirstColumn('enum') + FormatMainName(a[ii].ShortText);
if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then
begin
@ -1047,6 +1055,11 @@ procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, Ins
Exit;
n := d.ShortText;
{$IFDEF ciCHECKDUPLICATES}
if (InsertList.IndexOf(n) > -1) then
Exit;
{$ENDIF}
s := s + FormatMainName(n);
if (Item.Params <> '') then
begin
@ -1065,6 +1078,38 @@ procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, Ins
AddEnums(d, ItemList, InsertList);
end;
function PropertyIndex(Item: TciClassProperty): string;
var
i: Integer;
d: TDeclaration;
a: TDeclarationArray;
begin
d := Item.Items.GetFirstItemOfClass(TciPropertyParameterList);
Result := '';
if (d <> nil) then
begin
a := d.Items.GetItemsOfClass(TciIdentifier);
for i := Low(a) to High(a) do
begin
if (Result <> '') then
Result := Result + ', ';
Result := Result + a[i].ShortText;
end;
d := d.Items.GetFirstItemOfClass(TciTypeKind);
if (d <> nil) then
begin
if (Result <> '') then
Result := Result + ': ';
Result := Result + d.ShortText;
end;
end;
if (Result <> '') then
Result := '['+Result+']';
end;
var
i: Integer;
FirstColumn, s, n: string;
@ -1146,11 +1191,14 @@ begin
for i := Low(a) to High(a) do
begin
n := a[i].ShortText;
(*{$IFDEF ciCHECKDUPLICATES}
{$IFDEF ciCHECKDUPLICATES}
if (InsertList.IndexOf(n) > -1) then
Continue;
{$ENDIF}*)
{$ENDIF}
s := FirstColumn + FormatMainName(n);
if (Item is TciClassProperty) then
s := s + FormatMainExtra(PropertyIndex(TciClassProperty(Item)));
if (b[1] <> nil) then
s := s + FormatMainExtra(' = ' + b[1].ShortText);
if (b[2] <> nil) then

View File

@ -92,7 +92,8 @@ type
private
function GetShortText: string; override;
public
function HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean;
function HasField(Name: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; overload;
function HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean; overload;
function GetDefault(Return: TVarBase = vbName): TDeclaration;
end;
@ -119,7 +120,6 @@ type
function GetName: TciProcedureName;
function GetProcType: string;
function GetParams: string;
function GetSynParams: string;
function GetShortText: string; override;
public
@ -129,7 +129,6 @@ type
property Name : TciProcedureName read GetName;
property ProcType: string read GetProcType;
property Params: string read GetParams;
property SynParams: string read GetSynParams;
end;
TciUsedUnit = class(TDeclaration); //Included Units
@ -185,6 +184,8 @@ type
TciClassMethodHeading = class(TciProcedureDeclaration); //Record + Class
TciClassProperty = class(TDeclaration); //Record + Class
TciPropertyDefault = class(TDeclaration); //Record + Class
TciIdentifier = class(TDeclaration); //Record + Class
TciPropertyParameterList = class(TDeclaration); //Record + Class
TciSetType = class(TDeclaration); //Set
TciOrdinalType = class(TDeclaration); //Set
@ -263,6 +264,8 @@ type
procedure PropertyName; override; //Record + Class
procedure TypeId; override; //Record + Class
procedure PropertyDefault; override; //Record + Class
procedure Identifier; override; //Record + Class
procedure PropertyParameterList; override; //Record + Class
procedure SetType; override; //Set
procedure OrdinalType; override; //Set + Array Range
@ -630,10 +633,11 @@ begin
Result := fShortText;
end;
function TciStruct.HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean;
function TciStruct.HasField(Name: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean;
var
a, b: TDeclarationArray;
i, ii: Integer;
t: TDeclaration;
begin
Result := False;
Name := PrepareString(Name);
@ -665,6 +669,12 @@ begin
if (PrepareString(b[ii].CleanText) = Name) then
begin
Result := True;
t := a[i].Items.GetFirstItemOfClass(TciPropertyParameterList);
if (t <> nil) then
//ArrayCount := ArrayCount + t.Items.Count; [a, b] Indices count as 1
Inc(ArrayCount);
if (Return = vbType) then
Decl := b[ii].Owner.Items.GetFirstItemOfClass(TciTypeKind)
else
@ -683,7 +693,11 @@ begin
begin
Result := True;
if (Return = vbType) then
Decl := b[ii].Owner
//Decl := b[ii].Owner
if (a[ii] is TciProcedureDeclaration) and (LowerCase(TciProcedureDeclaration(a[i]).ProcType) = 'constructor') then
Decl := Self
else
Decl := b[ii].Owner.Items.GetFirstItemOfClass(TciTypeKind)
else
Decl := b[ii];
Exit;
@ -691,6 +705,13 @@ begin
end;
end;
function TciStruct.HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean;
var
a: Integer;
begin
Result := HasField(Name, Decl, Return, a);
end;
function TciStruct.GetDefault(Return: TVarBase = vbName): TDeclaration;
var
d: TDeclaration;
@ -849,51 +870,6 @@ begin
end;
end;
function TciProcedureDeclaration.GetSynParams: string;
var
i, ii: Integer;
a, b: TDeclarationArray;
d: TDeclaration;
s, t: string;
begin
Result := '';
if (fSynParams <> '') then
Result := fSynParams
else if (fItems.Count > 0) then
begin
a := GetParamDeclarations;
for i := Low(a) to High(a) do
begin
if (a[i] is TciConstParameter) then
s := 'const '
else if (a[i] is TciOutParameter) then
s := 'out '
else if (a[i] is TciInParameter) then
s := 'in '
else if (a[i] is TciVarParameter) then
s := 'var '
else
s := '';
d := a[i].Items.GetFirstItemOfClass(TciParameterType);
if (d <> nil) then
t := ': ' + d.ShortText
else
t := '';
b := a[i].Items.GetItemsOfClass(TciParameterName);
for ii := Low(b) to High(b) do
begin
if (fSynParams <> '') then
fSynParams := fSynParams + ';","' + s + b[ii].ShortText + t
else
fSynParams := '"' + s + b[ii].ShortText + t;
end;
end;
if (fSynParams <> '') then
fSynParams := fSynParams + '"';
Result := fSynParams;
end;
end;
function TciProcedureDeclaration.GetShortText: string;
begin
if (fShortText = '') then
@ -1662,7 +1638,7 @@ end;
procedure TCodeParser.TypeId;
begin
if (not InDeclaration(TciClassProperty)) then
if (not InDeclarations([TciClassProperty, TciPropertyParameterList])) then
begin
inherited;
Exit;
@ -1686,6 +1662,32 @@ begin
PopStack;
end;
procedure TCodeParser.Identifier;
begin
if (not InDeclaration(TciPropertyParameterList)) then
begin
inherited;
Exit;
end;
PushStack(TciIdentifier);
inherited;
PopStack;
end;
procedure TCodeParser.PropertyParameterList;
begin
if (not InDeclaration(TciClassProperty)) then
begin
inherited;
Exit;
end;
PushStack(TciPropertyParameterList);
inherited;
PopStack;
end;
procedure TCodeParser.SetType;
begin
PushStack(TciSetType);

10
todo.txt Normal file
View File

@ -0,0 +1,10 @@
- DTM Editor
- BMP Editor
- DTM Features
- SRL Installer
- Extra GUI icons
- Installer
- Test scripts
- DWS
- OCR exceptions + proper implementation of len
- Documentation + wiki