diff --git a/Projects/SAMufasaGUI/debugimage.pas b/Projects/SAMufasaGUI/debugimage.pas index 05da5c1..ac3bfa8 100644 --- a/Projects/SAMufasaGUI/debugimage.pas +++ b/Projects/SAMufasaGUI/debugimage.pas @@ -89,14 +89,11 @@ end; procedure TDebugImgForm.DrawBitmap; var - rawImage : TRawImage; Bitmap : Graphics.TBitmap; begin if ToDrawBmp = nil then raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil'); - ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage); - Bitmap := Graphics.TBitmap.Create; - Bitmap.LoadFromRawImage(Rawimage,false); + Bitmap := ToDrawBmp.ToTBitmap; DrawImage.Canvas.Draw(0,0,Bitmap); DrawImage.Repaint; Bitmap.Free; @@ -109,7 +106,8 @@ end; procedure TDebugImgForm.ShowDebugImgForm; begin - Show; + if not Visible then + show; if (DispSize.x <> Width) or (DispSize.y <> height) then begin; Width := DispSize.x; diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index 3f0a764..31d3c3d 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/SAMufasaGUI/framescript.pas @@ -168,6 +168,7 @@ var ms: TMemoryStream; d: TDeclaration; sp, ep: Integer; + s : string; begin mp := TCodeInsight.Create; mp.FileName := ScriptFile; @@ -179,7 +180,11 @@ begin try SynEdit.GetWordBoundsAtRowCol(SynEdit.CaretXY, sp, ep); - mp.Run(ms); + 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),false) + else + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1,false); mp.Position := SynEdit.SelStart + (ep - SynEdit.CaretX) - 1; d := mp.FindVarBase(mp.GetExpressionAtPos); diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 6da492a..3e5ed87 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -46,7 +46,7 @@ uses CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 633; + SimbaVersion = 635; type @@ -457,6 +457,7 @@ uses syncobjs, // for the critical sections debugimage, files, + InterfaceBase, extensionmanagergui, colourhistory, math; @@ -2314,7 +2315,7 @@ begin if Self.Visible = false then MenuItemShowClick(sender) else - Self.hide; + Self.Hide; end; procedure TForm1.MenuItemReportBugClick(Sender: TObject); diff --git a/Units/MMLAddon/PSInc/Wrappers/ocr.inc b/Units/MMLAddon/PSInc/Wrappers/ocr.inc index 67a801c..de943bb 100644 --- a/Units/MMLAddon/PSInc/Wrappers/ocr.inc +++ b/Units/MMLAddon/PSInc/Wrappers/ocr.inc @@ -31,12 +31,23 @@ begin Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h); end; +function ps_GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string; extdecl; +begin + result := CurrThread.Client.MOCR.GetTextATPA(ATPA,maxvspacing,font); +end; + 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_GetTextAtEx(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing, + color, tol: integer;const font: string): string; extdecl; +begin + result := CurrThread.Client.MOCR.GetTextAt(xs,ys,xe,ye,minvspacing,maxvspacing,hspacing,color,tol,font); +end; + function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;extdecl; begin result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index e6747ac..20089a6 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -244,6 +244,9 @@ AddFunction(@ps_TPAFromText, 'function TPAFromText(const text, font: String;var 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_getTextAtEx,'function GetTextAtEx(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,color, tol: integer;const font: string): string;'); +AddFunction(@ps_GetTextAtEx,'function GetTextAtExWrap(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,color, tol: integer;const font: string): string;'); +AddFunction(@ps_gettextATPA,'function GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string;'); AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;'); {Bitmaps} diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 6e78916..c898dbd 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -52,11 +52,11 @@ type 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; + procedure DefaultOperations(var xs,ys,xe,ye : integer); 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; diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index 2000819..b861ca7 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -61,7 +61,10 @@ type procedure FilterCharsBitmap(bmp: TMufasaBitmap); function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing, - color, tol, len: integer; font: string): string; + color, tol, len: integer; font: string): string;overload; + function GetTextAt(xs, ys, xe, ye, minvspacing, maxvspacing, hspacing, + color, tol: integer; font: string): string;overload; + function GetTextATPA(const ATPA: T2DPointArray; const maxvspacing: 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; @@ -697,88 +700,27 @@ begin result := GetUpTextAtEx(atX, atY, false); end; -function TMOCR.GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing, - color, tol, len: integer; font: string): string; - +function TMOCR.GetTextATPA(const ATPA : T2DPointArray;const maxvspacing : integer; font: string): string; var - b, lb: TBox; - i, j, w, h: Integer; - lbset: boolean; - n: TNormArray; - fD: TocrData; - TPA: TPointArray; - STPA: T2DPointArray; + b, lb: TBox; + i, j, w, h: Integer; + lbset: boolean; + n: TNormArray; + fD: TocrData; + TPA: TPointArray; begin Result := ''; fD := FFonts.GetFont(font); - {writeln(format('W, H: %d, %d', [fD.max_width, fd.max_height]));} - - TClient(Client).IOManager.GetDimensions(w, h); - { writeln('Dimensions: (' + inttostr(w) + ', ' + inttostr(h) + ')'); } - - { Get the text points } - SetLength(TPA, 0); - if (atY + fD.max_height -1) >= h then - raise exception.createFMT('You are trying to get text that is out of is origin y-coordinate: %d',[aty]); - - TClient(Client).MFinder.FindColorsTolerance(TPA, color, atX, atY, - min(atX + fD.max_width * len, w - 1), - atY + fD.max_height - 1, tol); -{ b := GetTPABounds(TPA); - bmp := TMufasaBitmap.Create; - bmp.SetSize(b.x2+1,b.y2+1); - bmp.DrawTPA(TPA, clRed); - bmp.SaveToFile('c:\found.bmp');} - - { Split the text points into something usable. } - { +1 because splittpa will not split well if we use 0 space ;) } - STPA := SplitTPAEx(TPA, minvspacing+1, hspacing+1); - -{ bmp.DrawATPA(STPA); - bmp.SaveToFile('c:\found2.bmp'); - bmp.Free; - - for i := 0 to high(STPA) do - begin - b := GetTPABounds(STPA[i]); - bmp := TMufasaBitmap.Create; - bmp.SetSize(b.x2+1,b.y2+1); - bmp.DrawTPA(STPA[i], clRed); - bmp.SaveToFile('c:\t_' + inttostr(i) + '.bmp'); - bmp.Free; - end; } - - SortATPAFrom(STPA, Point(0, atY)); - SortATPAFromFirstPoint(STPA, Point(0, atY)); - -{ for i := 0 to high(STPA) do - begin - b := GetTPABounds(STPA[i]); - bmp := TMufasaBitmap.Create; - bmp.SetSize(b.x2-b.x1 + 2,b.y2-b.y1 + 2); - for j := 0 to high(STPA[i]) do - bmp.FastSetPixel(stpa[i][j].x-b.x1,stpa[i][j].y-b.y1,clred); - bmp.SaveToFile('c:\s_' + inttostr(i) + '.bmp'); - bmp.Free; - end; } - - { We no longer need the points in TPA } - SetLength(TPA, 0); - - fillchar(b, sizeof(tbox), 0); - fillchar(lb, sizeof(tbox), 0); lbset := false; SetLength(Result, 0); SetLength(n, (fd.width + 1) * (fd.height + 1)); - for i := 0 to high(STPA) do + for i := 0 to high(ATPA) do begin - if length(result) >= len then - exit; for j := 0 to high(n) do n[j] := 0; - TPA := STPA[i]; + TPA := ATPA[i]; b := GetTPABounds(TPA); if not lbset then begin @@ -817,6 +759,48 @@ begin end; end; +function TMOCR.GetTextAt(xs, ys, xe,ye, minvspacing, maxvspacing, hspacing, + color, tol: integer; font: string): string; +var + TPA : TPointArray; + STPA : T2DPointArray; + B : TBox; +begin; + SetLength(TPA, 0); + TClient(Client).MFinder.FindColorsTolerance(TPA, color, xs,ys,xe,ye,tol); + b := GetTPABounds(TPA); + + { Split the text points into something usable. } + { +1 because splittpa will not split well if we use 0 space ;) } + STPA := SplitTPAEx(TPA, minvspacing+1, hspacing+1); + + SortATPAFrom(STPA, Point(0, ys)); + SortATPAFromFirstPoint(STPA, Point(0, ys)); + result := gettextatpa(STPA,maxvspacing,font); +end; + +function TMOCR.GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing, + color, tol, len: integer; font: string): string; +var + w,h : integer; + fD: TocrData; + +begin + Result := ''; + fD := FFonts.GetFont(font); + TClient(Client).IOManager.GetDimensions(w, h); + { writeln('Dimensions: (' + inttostr(w) + ', ' + inttostr(h) + ')'); } + + { Get the text points } + if (atY + fD.height -1) >= h then + raise exception.createFMT('You are trying to get text that is out of is origin y-coordinate: %d',[aty]); + result := GetTextAt(atX, atY,min(atX + fD.max_width * len, w - 1), + atY + fD.max_height - 1, minvspacing,maxvspacing,hspacing,color,tol,font); + if length(result) > len then + setlength(result,len); + +end; + function TMOCR.TextToFontTPA(Text, font: String; out w, h: integer): TPointArray; var diff --git a/Units/MMLCore/ocrutil.pas b/Units/MMLCore/ocrutil.pas index 3c702cd..0dc058f 100644 --- a/Units/MMLCore/ocrutil.pas +++ b/Units/MMLCore/ocrutil.pas @@ -38,7 +38,7 @@ type L,a,b: real; end; - procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer); + procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height,maxwidth,maxheight: 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; @@ -56,14 +56,21 @@ uses {End To-Remove unit} {initalizes the remaining fields from a TocrGlyphMask and finds the global bounds} -procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer); +procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height,maxwidth,maxheight: integer); var i,x,y,c,w,h: integer; + minx,miny,maxx,maxy : integer; l,r,t,b: integer; dat: TNormArray; begin width:= 0; height:= 0; + MaxWidth := 0; + MaxHeight := 0; + minx := 9000; + miny := 9000; + maxx := 0; + maxy := 0; for c:= 0 to length(glyphs) - 1 do begin dat:= glyphs[c].mask; @@ -79,8 +86,12 @@ begin begin x:= i mod w; y:= i div w; + if x > maxx then maxx := x; + if x < minx then minx := x; if x > r then r:= x; if x < l then l:= x; + if y > maxy then maxy := y; + if y < miny then miny := y; if y > b then b:= y; if y < t then t:= y; end; @@ -94,6 +105,8 @@ begin if (r - l + 1) > width then width:= r - l + 1; if (b - t + 1) > height then height:= b - t + 1; end; + maxwidth:= (maxx-minx) + 1; + maxheight := (maxy - miny) + 1; end; {Use whatever you want if you don't like this} @@ -166,18 +179,19 @@ function InitOCR(const masks : TocrGlyphMaskArray): TocrData; var t,b,l,r,w,h,mw: integer; x,y: integer; + maxw,maxh : integer; c,i,len,size: integer; pos: integer; ascii: char; begin w:= 0; h:= 0; - findBounds(masks,w,h); + findBounds(masks,w,h,maxw,maxh); len:= Length(masks); result.width:= w; result.height:= h; - result.max_width:=0; - result.max_height:=0; + result.max_width := maxw; + result.max_height := maxh; size:= w * h; SetLength(result.pos,len,size); SetLength(result.pos_adj,len); @@ -216,8 +230,6 @@ begin 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;