From 492821587d1d037a81f737b3fbb31674855d8429 Mon Sep 17 00:00:00 2001 From: Raymond Date: Mon, 29 Mar 2010 23:01:54 +0200 Subject: [PATCH] Font downloading works =). --- Projects/SAMufasaGUI/debugimage.lfm | 2 +- Projects/SAMufasaGUI/debugimage.lrs | 6 +- Projects/SAMufasaGUI/debugimage.pas | 14 +- Projects/SAMufasaGUI/extensionmanager.pas | 7 + Projects/SAMufasaGUI/project1.lpr | 2 +- Projects/SAMufasaGUI/testunit.pas | 259 +++++++++++++++------- Projects/SAMufasaGUI/updateform.pas | 60 +++-- Units/MMLAddon/mmisc.pas | 1 + Units/MMLCore/client.pas | 10 +- Units/MMLCore/fontloader.pas | 14 +- Units/MMLCore/ocr.pas | 2 +- Units/MMLCore/ocrutil.pas | 7 +- 12 files changed, 253 insertions(+), 131 deletions(-) diff --git a/Projects/SAMufasaGUI/debugimage.lfm b/Projects/SAMufasaGUI/debugimage.lfm index 03dae46..c3e2b43 100644 --- a/Projects/SAMufasaGUI/debugimage.lfm +++ b/Projects/SAMufasaGUI/debugimage.lfm @@ -10,7 +10,6 @@ object DebugImgForm: TDebugImgForm ClientWidth = 400 OnCreate = FormCreate OnHide = FormHide - OnResize = FormResize LCLVersion = '0.9.29' object DrawImage: TImage Left = 0 @@ -18,5 +17,6 @@ object DebugImgForm: TDebugImgForm Top = 0 Width = 400 Align = alClient + OnResize = DrawImageResize end end diff --git a/Projects/SAMufasaGUI/debugimage.lrs b/Projects/SAMufasaGUI/debugimage.lrs index 5a4a408..b3a0f5a 100644 --- a/Projects/SAMufasaGUI/debugimage.lrs +++ b/Projects/SAMufasaGUI/debugimage.lrs @@ -5,7 +5,7 @@ LazarusResources.Add('TDebugImgForm','FORMDATA',[ +'Top'#3#10#1#5'Width'#3#144#1#11'BorderIcons'#11#12'biSystemMenu'#10'biMinim' +'ize'#0#11'BorderStyle'#7#12'bsToolWindow'#7'Caption'#6#12'DebugImgForm'#12 +'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#6 - +'OnHide'#7#8'FormHide'#8'OnResize'#7#10'FormResize'#10'LCLVersion'#6#6'0.9.2' - +'9'#0#6'TImage'#9'DrawImage'#4'Left'#2#0#6'Height'#3','#1#3'Top'#2#0#5'Width' - +#3#144#1#5'Align'#7#8'alClient'#0#0#0 + +'OnHide'#7#8'FormHide'#10'LCLVersion'#6#6'0.9.29'#0#6'TImage'#9'DrawImage'#4 + +'Left'#2#0#6'Height'#3','#1#3'Top'#2#0#5'Width'#3#144#1#5'Align'#7#8'alClien' + +'t'#8'OnResize'#7#15'DrawImageResize'#0#0#0 ]); diff --git a/Projects/SAMufasaGUI/debugimage.pas b/Projects/SAMufasaGUI/debugimage.pas index aec98d7..46dcdf1 100644 --- a/Projects/SAMufasaGUI/debugimage.pas +++ b/Projects/SAMufasaGUI/debugimage.pas @@ -36,9 +36,9 @@ type TDebugImgForm = class(TForm) DrawImage: TImage; + procedure DrawImageResize(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormHide(Sender: TObject); - procedure FormResize(Sender: TObject); private { private declarations } public @@ -67,18 +67,18 @@ begin BlackDebugImage; end; -procedure TDebugImgForm.FormHide(Sender: TObject); -begin - Form1.MenuItemDebugImage.Checked := False; -end; - -procedure TDebugImgForm.FormResize(Sender: TObject); +procedure TDebugImgForm.DrawImageResize(Sender: TObject); begin DrawImage.Picture.Graphic.Width := DrawImage.Width; DrawImage.Picture.Graphic.Height := DrawImage.Height; BlackDebugImage; end; +procedure TDebugImgForm.FormHide(Sender: TObject); +begin + Form1.MenuItemDebugImage.Checked := False; +end; + procedure TDebugImgForm.BlackDebugImage; begin DrawImage.Canvas.Brush.Color:= clBlack; diff --git a/Projects/SAMufasaGUI/extensionmanager.pas b/Projects/SAMufasaGUI/extensionmanager.pas index 631ba5e..2956e94 100644 --- a/Projects/SAMufasaGUI/extensionmanager.pas +++ b/Projects/SAMufasaGUI/extensionmanager.pas @@ -148,5 +148,12 @@ begin end; end; +initialization + ExtManager := TExtensionManager.Create; + ExtManager.StartDisabled := True; +finalization + if ExtManager <> nil then + FreeAndNil(ExtManager); + end. diff --git a/Projects/SAMufasaGUI/project1.lpr b/Projects/SAMufasaGUI/project1.lpr index 14f9369..d94613e 100644 --- a/Projects/SAMufasaGUI/project1.lpr +++ b/Projects/SAMufasaGUI/project1.lpr @@ -48,8 +48,8 @@ begin Application.CreateForm(TColourHistoryForm, ColourHistoryForm); Application.CreateForm(TAboutForm, AboutForm); Application.CreateForm(TDebugImgForm, DebugImgForm); - Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); Application.CreateForm(TExtensionsForm, ExtensionsForm); +// Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); // Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm Application.Run; end. diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 88eb80f..f494026 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -326,12 +326,17 @@ type FirstRun : boolean;//Only show the warnings the first run (path not existing one's) SearchStart : TPoint; LastTab : integer; + UpdatingFonts : boolean; + function GetFontPath: String; function GetIncludePath: String; function GetScriptState: TScriptState; + procedure SetFontPath(const AValue: String); procedure SetIncludePath(const AValue: String); 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); + procedure FontUpdate; public DebugStream: String; SearchString : string; @@ -378,8 +383,18 @@ type procedure HandleParameters; procedure OnSaveScript(const Filename : string); property IncludePath : String read GetIncludePath write SetIncludePath; + property FontPath : String read GetFontPath write SetFontPath; end; + { TProcThread } + + TProcThread = class(TThread) + public + StartWait : Cardinal; + ClassProc : procedure of object; + NormalProc : procedure; + procedure Execute; override; + end; procedure ClearDebug; procedure formWriteln( S : String); procedure formWritelnEx( S : String); @@ -595,9 +610,11 @@ var time:integer; LatestVersion : integer; begin - chk := LoadSettingDef('Settings/Updater/CheckForUpdates','True'); + UpdateTimer.Interval:= MaxInt; + FontUpdate; + chk := LowerCase(LoadSettingDef('Settings/Updater/CheckForUpdates','True')); - if chk <> 'True' then + if chk <> 'true' then Exit; LatestVersion:= SimbaUpdateForm.GetLatestSimbaVersion; @@ -958,12 +975,14 @@ end; procedure TForm1.CreateDefaultEnvironment; var - FontPath,PluginsPath,extensionsPath : string; + PluginsPath,extensionsPath : string; + FontUpdater : TProcThread; begin CreateSetting('Settings/Updater/CheckForUpdates','True'); CreateSetting('Settings/Updater/CheckEveryXMinutes','30'); CreateSetting('Settings/Interpreter/UseCPascal', 'False'); CreateSetting('Settings/Fonts/LoadOnStartUp', 'True'); + CreateSetting('Settings/Fonts/Version','-1'); CreateSetting('Settings/Tabs/OpenNextOnClose','False'); CreateSetting('Settings/Tabs/OpenScriptInNewTab','True'); CreateSetting('Settings/Tabs/CheckTabsBeforeOpen','True'); @@ -972,38 +991,12 @@ begin CreateSetting('Settings/MainForm/NormalSize','739:555'); CreateSetting('Settings/FunctionList/ShowOnStart','True'); - CreateSetting('Settings/Updater/RemoteLink', - {$IFDEF WINDOWS} - {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Windows/x86/Stable/Simba.exe' - {$ELSE} - 'http://simba.villavu.com/bin/Windows/x86_64/Stable/Simba.exe' - {$ENDIF} - {$ELSE} - {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Linux/x86/Stable/Simba' - {$ELSE} - 'http://simba.villavu.com/bin/Linux/x86_64/Stable/Simba' - {$ENDIF} - {$ENDIF} - ); - CreateSetting('Settings/Updater/RemoteVersionLink', - {$IFDEF WINDOWS} - {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Windows/x86/Stable/Version' - {$ELSE} - 'http://simba.villavu.com/bin/Windows/x86_64/Stable/Version' - {$ENDIF} - {$ELSE} - {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Linux/x86/Stable/Version' - {$ELSE} - 'http://simba.villavu.com/bin/Linux/x86_64/Stable/Version' - {$ENDIF} - {$ENDIF} - ); + 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'); + {Creates the paths and returns the path} - fontPath := CreateSetting('Settings/Fonts/Path', ExpandFileName(MainDir+DS+ 'Fonts' + DS)); PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); CreateSetting('LastConfig/MainForm/Position',''); @@ -1023,6 +1016,7 @@ begin SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false); SettingsForm.SaveCurrent; LoadFormSettings; + UpdateTimer.Interval:=25; end; procedure TForm1.LoadFormSettings; @@ -1159,7 +1153,6 @@ end; procedure TForm1.InitalizeTMThread(var Thread: TMThread); var DbgImgInfo : TDbgImgInfo; - fontPath: String; AppPath : string; pluginspath: string; ScriptPath : string; @@ -1168,7 +1161,6 @@ var loadFontsOnScriptStart: boolean; begin AppPath:= MainDir + DS; - fontPath := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+ 'Fonts' + DS))); PluginsPath := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS))); CurrScript.ScriptErrorLine:= -1; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; @@ -1668,7 +1660,7 @@ begin if MethodInfo.Filename <> nil then if MethodInfo.Filename <> '' then begin; - Writeln(MethodInfo.filename); +// Writeln(MethodInfo.filename); LoadScriptFile(MethodInfo.Filename,true,true); end; CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1; @@ -1771,51 +1763,63 @@ begin FreeAndNil(ExtManager); end; -procedure TForm1.FormCreate(Sender: TObject); - procedure CCFillCore; - var - t: TMThread; - a: TPSScriptExtension; - b: TStringList; - ms: TMemoryStream; +procedure CCFillCore; +var + t: TMThread; + a: TPSScriptExtension; + b: TStringList; + ms: TMemoryStream; +begin + if form1.UpdatingFonts then begin - InitalizeTMThread(t); - KillThread(t.ThreadID); - if (t is TPSThread) then - try - a := TPSScriptExtension.Create(Self); - b := TStringList.Create; - ms := TMemoryStream.Create; - - try - with TPSThread(t).PSScript do - begin - a.OnCompile := OnCompile; - a.OnCompImport := OnCompImport; - a.OnExecImport := OnExecImport; - end; - a.GetValueDefs(b); - - SetLength(CoreBuffer, 1); - CoreBuffer[0] := TCodeInsight.Create; - with CoreBuffer[0] do - begin - OnMessage := @OnCCMessage; - b.SaveToStream(ms); - Run(ms, nil, -1, True); - FileName := '!PSCORE!'; - end; - finally - b.Free; - a.Free; - end; - finally - //KillThread(t.ThreadID); - t.Free; + mDebugLn('Updating the fonts, thus waiting a bit till we init the OCR.'); + while form1.UpdatingFonts do + begin + if GetCurrentThreadId = MainThreadID then + Application.ProcessMessages; + sleep(25); end; end; + form1.InitalizeTMThread(t); + KillThread(t.ThreadID); + if (t is TPSThread) then + try + a := TPSScriptExtension.Create(form1); + b := TStringList.Create; + ms := TMemoryStream.Create; + try + with TPSThread(t).PSScript do + begin + a.OnCompile := OnCompile; + a.OnCompImport := OnCompImport; + a.OnExecImport := OnExecImport; + end; + a.GetValueDefs(b); + + SetLength(CoreBuffer, 1); + CoreBuffer[0] := TCodeInsight.Create; + with CoreBuffer[0] do + begin + OnMessage := @form1.OnCCMessage; + b.SaveToStream(ms); + Run(ms, nil, -1, True); + FileName := '!PSCORE!'; + end; + finally + b.Free; + a.Free; + end; + finally + //KillThread(t.ThreadID); + t.Free; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +var + FillThread : TProcThread; begin Randomize; DecimalSeparator := '.'; @@ -1837,18 +1841,22 @@ begin TT_Console.Visible:= false; {$endif} InitmDebug; - ExtManager := TExtensionManager.Create; - ExtManager.StartDisabled:= True; + FillThread := TProcThread.Create(true); + FillThread.FreeOnTerminate:= True; + FillThread.NormalProc:= @CCFillCore; + UpdateTimer.OnTimer:= @UpdateTimerCheck; + Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); if FileExists(SimbaSettingsFile) then begin Application.CreateForm(TSettingsForm,SettingsForm); Self.LoadFormSettings; - end - else begin + end else + begin Application.CreateForm(TSettingsForm,SettingsForm); Self.CreateDefaultEnvironment; + FillThread.StartWait:= 250; end; - UpdateTimer.OnTimer:= @UpdateTimerCheck; + //Show close buttons @ tabs PageControl1.Options:=PageControl1.Options+[nboShowCloseButtons]; PageControl1.OnCloseTabClicked:=ActionCloseTab.OnExecute; @@ -1877,7 +1885,8 @@ begin HandleParameters; TT_Update.Visible:= false; - CCFillCore; + //Fill the codeinsight buffer + FillThread.Resume; end; procedure TForm1.FormDestroy(Sender: TObject); @@ -2130,9 +2139,9 @@ end; function GetSimbaNews: String; var - t: TSimbaVersionThread; + t: TDownloadThread; begin - t := TSimbaVersionThread.Create(true); + t := TDownloadThread.Create(true); t.InputURL:='http://simba.villavu.com/bin/news'; t.Resume; while not t.done do @@ -2290,6 +2299,16 @@ begin result := CurrScript.FScriptState; end; +procedure TForm1.SetFontPath(const AValue: String); +begin + SetSetting('Settings/Fonts/Path',AValue); +end; + +function TForm1.GetFontPath: String; +begin + Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS))); +end; + function TForm1.GetIncludePath: String; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Includes/Path', ExpandFileName(MainDir+DS+'Includes' + DS))); @@ -2297,7 +2316,7 @@ end; procedure TForm1.SetIncludePath(const AValue: String); begin - CreateSetting('Settings/Includes/Path',AValue); + SetSetting('Settings/Includes/Path',AValue); end; procedure TForm1.SetScriptState(const State: TScriptState); @@ -2337,6 +2356,62 @@ function TForm1.CreateSetting(Key: string; Value: string): string; begin result := SettingsForm.Settings.GetSetDefaultKeyValue(Key,value); end; + +procedure TForm1.SetSetting(key: string; Value: string); +begin + //Creates the setting if needed + if CreateSetting(key,value) <> value then //The setting already occurs, and has a different value.. Lets change it + begin; + SettingsForm.Settings.SetKeyValue(key,value); + SettingsForm.Settings.SaveToXML(SimbaSettingsFile); + end; +end; + +procedure TForm1.FontUpdate; +var + CurrVersion : integer; + LatestVersion : integer; + FontDownload : TDownloadThread; + Stream : TStringStream; + Decompressed : TMemoryStream; +begin + if UpdatingFonts then + exit; + UpdatingFonts := True; + CurrVersion := StrToIntDef(LoadSettingDef('Settings/Fonts/Version','-1'),-1); + LatestVersion := SimbaUpdateForm.GetLatestFontVersion; + if LatestVersion > CurrVersion then + begin; + formWriteln(format('New fonts available. Current version: %d. Latest version: %d',[CurrVersion,LatestVersion])); + FontDownload := TDownloadThread.Create(True); + FontDownload.InputURL:= LoadSettingDef('Settings/Fonts/UpdateLink',FontURL + 'Fonts.tar.bz2'); + FontDownload.resume; + while FontDownload.Done = false do + begin + Application.ProcessMessages; + Sleep(25); + end; + Stream := TStringStream.Create(FontDownload.ResultStr); + try + Decompressed := DecompressBZip2(stream); + if UnTar(decompressed, FontPath,true) then + begin; + FormWriteln('Succesfully installed the new fonts!'); + SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion)); + if Assigned(self.OCR_Fonts) then + self.OCR_Fonts.Free; + Self.OCR_Fonts := TMOCR.Create(nil); + OCR_Fonts.InitTOCR(fontPath); + end; + Decompressed.free; + finally + Stream.Free; + FontDownload.Free; + end; + end; + UpdatingFonts := False; +end; + {$ifdef mswindows} function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; @@ -2598,6 +2673,18 @@ begin inherited Destroy; end; +{ TProcThread } + +procedure TProcThread.Execute; +begin + if startwait <> 0 then + sleep(StartWait); + if NormalProc <> nil then + NormalProc; + if ClassProc <> nil then + ClassProc; +end; + initialization {$I testunit.lrs} diff --git a/Projects/SAMufasaGUI/updateform.pas b/Projects/SAMufasaGUI/updateform.pas index b300ec9..12784a6 100644 --- a/Projects/SAMufasaGUI/updateform.pas +++ b/Projects/SAMufasaGUI/updateform.pas @@ -12,9 +12,9 @@ type { TSimbaUpdateForm } - { TSimbaVersionThread } + { TDownloadThread } - TSimbaVersionThread = class(TThread) + TDownloadThread = class(TThread) public ResultStr : string; InputURL : string; @@ -42,11 +42,14 @@ type FOldSpeed : integer; FLastUpdateSpeed : longword; FSimbaVersion: Integer; - SimbaVersionThread : TSimbaVersionThread; + FFontVersion : integer; + SimbaVersionThread : TDownloadThread; + FontVersionThread : TDownloadThread; private function OnUpdateBeat: Boolean; public function CanUpdate: Boolean; + function GetLatestFontVersion : integer; function GetLatestSimbaVersion: Integer; procedure PerformUpdate; protected @@ -56,15 +59,6 @@ type const DownloadSpeedTextRunning = 'Downloading at %d kB/s'; DownloadSpeedTextEnded = 'Downloaded at %d kB/s'; - -var - SimbaUpdateForm: TSimbaUpdateForm; - -implementation -uses - internets, TestUnit, simbasettings,lclintf; - -const SimbaURL = {$IFDEF WINDOWS} {$IFDEF CPUI386} 'http://simba.villavu.com/bin/Windows/x86/Stable/' @@ -78,8 +72,14 @@ const 'http://simba.villavu.com/bin/Linux/x86_64/Stable/' {$ENDIF} {$ENDIF}; + FontURL = 'http://simba.villavu.com/bin/Fonts/'; +var + SimbaUpdateForm: TSimbaUpdateForm; +implementation +uses + internets, TestUnit, simbasettings,lclintf; function TSimbaUpdateForm.CanUpdate: Boolean; begin @@ -89,11 +89,39 @@ begin Exit(testunit.SimbaVersion < FSimbaVersion); end; +function TSimbaUpdateForm.GetLatestFontVersion: integer; +begin + if FontVersionThread = nil then//Create thread (only if no-other one is already running) + begin + FontVersionThread := TDownloadThread.Create(true); + FontVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( + 'Settings/Fonts/VersionLink',FontURL + 'Version',SimbaSettingsFile); + FontVersionThread.Resume; + while FontVersionThread.Done = false do//Wait till thread is done + begin + Application.ProcessMessages; + Sleep(25); + end; + FFontVersion := StrToIntDef(Trim(FontVersionThread.ResultStr), -1);//Read output + FreeAndNil(FontVersionThread);//Free the thread + end else + begin + //Another thread is already running, lets wait for it! (When it's nil, it means that the result is written!) + while FontVersionThread = nil do + begin; + Application.ProcessMessages; + Sleep(50); + end; + end; + Exit(FFontVersion); + +end; + function TSimbaUpdateForm.GetLatestSimbaVersion: Integer; begin if SimbaVersionThread = nil then//Create thread (only if no-other one is already running) begin - SimbaVersionThread := TSimbaVersionThread.Create(true); + SimbaVersionThread := TDownloadThread.Create(true); SimbaVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( 'Settings/Updater/RemoteVersionLink',SimbaURL + 'Version',SimbaSettingsFile); @@ -101,7 +129,7 @@ begin while SimbaVersionThread.Done = false do//Wait till thread is done begin Application.ProcessMessages; - Sleep(50); + Sleep(25); end; FSimbaVersion := StrToIntDef(Trim(SimbaVersionThread.ResultStr), -1);//Read output FreeAndNil(SimbaVersionThread);//Free the thread @@ -235,9 +263,9 @@ begin FUpdating:= false; end; -{ TSimbaVersionThread } +{ TDownloadThread } -procedure TSimbaVersionThread.Execute; +procedure TDownloadThread.Execute; begin ResultStr:= GetPage(InputURL); done := true; diff --git a/Units/MMLAddon/mmisc.pas b/Units/MMLAddon/mmisc.pas index bf30f56..6ce81a7 100644 --- a/Units/MMLAddon/mmisc.pas +++ b/Units/MMLAddon/mmisc.pas @@ -89,6 +89,7 @@ begin; mDebugLn(format('Unknown filetype in archive. %s',[dirrec.name])); end; Tar.Free; + Result := true; end; diff --git a/Units/MMLCore/client.pas b/Units/MMLCore/client.pas index 6c48434..d478f3e 100644 --- a/Units/MMLCore/client.pas +++ b/Units/MMLCore/client.pas @@ -60,9 +60,13 @@ implementation procedure TClient.WriteLn(s: string); begin - if Assigned(WritelnProc) then - WritelnProc(s) - else + if self <> nil then + begin; + if Assigned(WritelnProc) then + WritelnProc(s) + else + mDebugLn(s); + end else mDebugLn(s); end; diff --git a/Units/MMLCore/fontloader.pas b/Units/MMLCore/fontloader.pas index 2e8cb1c..5dd2d86 100644 --- a/Units/MMLCore/fontloader.pas +++ b/Units/MMLCore/fontloader.pas @@ -29,7 +29,7 @@ interface uses Classes, SysUtils, - ocrutil; // contains the actual `loading' + ocrutil,lclintf; // contains the actual `loading' { We will not give any access to actual indices. @@ -68,7 +68,7 @@ type function LoadFont(Name: String; Shadow: Boolean): boolean; procedure SetPath(aPath: String); function GetPath: String; - function Copy: TMFonts; + function Copy(Owner : TObject): TMFonts; function Count : integer; property Font[Index : integer]: TMfont read GetFontByIndex; default; end; @@ -206,8 +206,6 @@ end; function TMFonts.LoadFont(Name: String; Shadow: Boolean): boolean; var f: TMFont; - ocrdata: TOcrData; - begin if not DirectoryExists(Path + Name) then begin @@ -215,25 +213,23 @@ begin Exit(False); end; - ocrdata := InitOCR(Path + Name + DS, Shadow); - f:=TMFont.Create; f.Name := Name; if Shadow then F.Name := F.Name + '_s'; - f.Data := ocrdata; + f.Data := InitOCR(Path + Name + DS, Shadow); Fonts.Add(f); {$IFDEF FONTDEBUG} TClient(Client).Writeln('Loaded Font ' + f.Name); {$ENDIF} end; -function TMFonts.Copy: TMFonts; +function TMFonts.Copy(Owner : TObject): TMFonts; var i:integer; begin - Result := TMFonts.Create(Client); + Result := TMFonts.Create(Owner); Result.Path := Self.GetPath(); for i := 0 to Self.Fonts.Count -1 do Result.Fonts.Add(TMFont(Self.Fonts.Items[i]).Copy()); diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index f1ba602..0b1ef32 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -164,7 +164,7 @@ end; { Set new Fonts. We set it to a Copy of NewFonts } procedure TMOCR.SetFonts(NewFonts: TMFonts); begin - Self.Fonts := NewFonts.Copy(); + Self.Fonts := NewFonts.Copy(Self.Client); end; { diff --git a/Units/MMLCore/ocrutil.pas b/Units/MMLCore/ocrutil.pas index 5ad6262..0896777 100644 --- a/Units/MMLCore/ocrutil.pas +++ b/Units/MMLCore/ocrutil.pas @@ -70,11 +70,11 @@ uses graphtype, intfgraphics,graphics; {End To-Remove unit} + function ReadBMP(path: string): Tbmp; var LazIntf : TLazIntfImage; RawImageDesc : TRawImageDescription; - data: array of tRGB; begin if FileExists(path) then begin; @@ -84,9 +84,8 @@ begin LazIntf.LoadFromFile(path); Result.width := LazIntf.Width; Result.height := LazIntf.Height; - SetLength(data,LazIntf.Width*LazIntf.Height); - Move(LazIntf.PixelData[0],data[0],LazIntf.Width*LazIntf.Height*sizeOf(tRGB)); - Result.data:= data; + SetLength(result.data,LazIntf.Width*LazIntf.Height); + Move(LazIntf.PixelData[0],result.data[0],LazIntf.Width*LazIntf.Height*sizeOf(tRGB)); LazIntf.Free; end; end;