mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-22 09:12:19 -05:00
Merge?
This commit is contained in:
commit
fac150bfa9
@ -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
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -6,4 +6,4 @@ class POINT(Structure):
|
||||
|
||||
PPOINT = POINTER(POINT)
|
||||
|
||||
|
||||
isiterable = lambda x: hasattr(x, '__iter__')
|
||||
|
@ -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;
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit extensionmanagergui;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
]);
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
]);
|
||||
|
@ -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;
|
||||
|
@ -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
@ -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);
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit virtualextension;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
14
Tests/PS/loadsystemfont.simb
Normal file
14
Tests/PS/loadsystemfont.simb
Normal 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.
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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;');
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit scriptproperties;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit stringutil;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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]);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit libloader;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
unit mufasabase;
|
||||
|
||||
{$mode objfpc}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
{$undefine mDebug}
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user