source: trunk/Core.pas

unit Core;

interface

uses
  Classes, SysUtils, FileUtil, Acronym, Translator, PersistentForm,
  ScaleDPI, Forms, Controls, ExtCtrls, Menus, LazFileUtils,
  RegistryEx, ApplicationInfo, Registry, Theme, FormMain;

type

  { TCore }

  TCore = class(TDataModule)
    ApplicationInfo1: TApplicationInfo;
    ThemeManager: TThemeManager;
    Translator: TTranslator;
    ImageListSmall: TImageList;
    ImageListLarge: TImageList;
    MenuItem1: TMenuItem;
    MenuItem19: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem26: TMenuItem;
    MenuItem27: TMenuItem;
    MenuItem28: TMenuItem;
    MenuItem3: TMenuItem;
    PersistentForm1: TPersistentForm;
    PopupMenuTrayIcon: TPopupMenu;
    ScaleDPI1: TScaleDPI;
    TrayIcon1: TTrayIcon;
    procedure TranslatorTranslate(Sender: TObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
  private
    FAlwaysOnTop: Boolean;
    StoredDimension: TControlDimension;
    procedure SetAlwaysOnTop(AValue: Boolean);
    function FindFirstNonOption: string;
    procedure WriteLnConsole(Text: string);
  public
    FormMain: TFormMain;
    AcronymDb: TAcronymDb;
    StartOnLogon: Boolean;
    StartMinimizedToTray: Boolean;
    ReopenLastFileOnStart: Boolean;
    InitializeStarted: Boolean;
    InitializeFinished: Boolean;
    function GetAppShareDir(Dir: string): string;
    procedure Initialize;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure ScaleDPI;
    property AlwaysOnTop: Boolean read FAlwaysOnTop write SetAlwaysOnTop;
  end;

var
  Core: TCore;


implementation

uses
  FormEx;

const
  ExampleFile = 'Example acronyms.adp';
  DefaultOverrideFile = 'Default.txt';

resourcestring
  SStartMinimizedInTray = 'Start minimized in system tray';
  SShowThisHelp = 'Show this help';
  SOptions = 'options';
  SProjectFile = 'project file';


{$R *.lfm}

procedure TCore.DataModuleCreate(Sender: TObject);
begin
  Translator.POFilesFolder := GetAppShareDir('Languages');

  AcronymDb := nil;
  InitializeStarted := False;
  InitializeFinished := False;
  StoredDimension := TControlDimension.Create;

  TFormEx.ScaleDPI := ScaleDPI1;
  TFormEx.Translator := Translator;
  TFormEx.ThemeManager := ThemeManager;
  TFormEx.PersistentForm := PersistentForm1;

  Application.CreateForm(TFormMain, FormMain);
end;

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  FreeAndNil(StoredDimension);
  FreeAndNil(AcronymDb);
end;

procedure TCore.TrayIcon1Click(Sender: TObject);
begin
  if not FormMain.Visible then FormMain.AShow.Execute
    else FormMain.Hide;
end;

procedure TCore.TranslatorTranslate(Sender: TObject);
begin
  Acronym.Translate;
end;

procedure TCore.SetAlwaysOnTop(AValue: Boolean);
begin
  if FAlwaysOnTop = AValue then Exit;
  FAlwaysOnTop := AValue;
  if FAlwaysOnTop then FormMain.FormStyle := fsSystemStayOnTop
    else FormMain.FormStyle := fsNormal;
end;

procedure TCore.WriteLnConsole(Text: string);
begin
  {$IFDEF WINDOWS}
  if not IsConsole then begin
    IsConsole := True;
    SysInitStdIO;
  end;
  {$ENDIF}
  WriteLn(Text);
end;

function TCore.GetAppShareDir(Dir: string): string;
{$IFDEF UNIX}
var
  NewDir: string;
{$ENDIF}
begin
  Result := ExtractFileDir(Application.ExeName) + DirectorySeparator + Dir;
  {$IFDEF UNIX}
  // If installed in Linux system then try to use different installation directory
  if not DirectoryExists(Result) then begin
    NewDir := ExtractFileDir(Application.ExeName) + DirectorySeparator + '..' +
      DirectorySeparator + 'share' + DirectorySeparator +
      ExtractFileNameOnly(Application.ExeName) + DirectorySeparator + Dir;
    if DirectoryExists(NewDir) then Result := NewDir;
  end;
  {$ENDIF}
end;

procedure TCore.Initialize;
var
  FileNameOption: string;
  ExampleFileName: string;
  DefaultOverrideFileName: string;
  ExamplesDir: string;
  Lines: TStringList;
  Output: string;
begin
  if not InitializeStarted then begin
    InitializeStarted := True;
    LoadConfig;

    if Application.HasOption('h', 'help') then begin
      Output := 'AcronymDecoder [' + SOptions + '] <' + SProjectFile + '>' + LineEnding;
      Output := Output + '  -t    --tray   ' + SStartMinimizedInTray + LineEnding;
      Output := Output + '  -h    --help   ' + SShowThisHelp + LineEnding;
      WriteLnConsole(Output);
      Application.Terminate;
      Exit;
    end;

    if Application.HasOption('t', 'tray') then begin
      FormMain.Visible := False;
    end;

    ExamplesDir := GetAppShareDir('Examples');
    ExampleFileName := ExamplesDir + DirectorySeparator + ExampleFile;

    // To override default project file put new project name to default file
    DefaultOverrideFileName := ExamplesDir + DirectorySeparator + DefaultOverrideFile;
    if FileExists(DefaultOverrideFileName) then begin
      Lines := TStringList.Create;
      Lines.LoadFromFile(DefaultOverrideFileName);
      if Lines.Count > 0 then
        ExampleFileName := ExamplesDir + DirectorySeparator + Lines[0];
      Lines.Free;
    end;

    FileNameOption := FindFirstNonOption;
    if FileNameOption <> '' then begin
      // Open file specified as command line parameter
      FormMain.ProjectOpen(FileNameOption);
    end else
    if ReopenLastFileOnStart and (FormMain.LastOpenedList1.Items.Count > 0) and
      FileExists(FormMain.LastOpenedList1.Items[0]) then begin
      // Open last opened file
      FormMain.ProjectOpen(FormMain.LastOpenedList1.Items[0])
    end else
    if FileExists(ExampleFileName) then begin
      // Open default database with examples if no item is in recent openned history
      FormMain.ProjectOpen(ExampleFileName);
    end else begin
      // Create empty file
      FormMain.AFileNew.Execute;
    end;

    //ImageListSmall.Assign(ImageListLarge);

    ScaleDPI;
    FormMain.UpdateAcronymsList;
    FormMain.ListViewFilter1.UpdateFromListView(FormMain.ListViewAcronyms);
    InitializeFinished := True;
  end;
end;

procedure TCore.LoadConfig;
begin
  FormMain.LoadConfig;

  with TRegistryEx.Create do
  try
    RootKey := RegistryRootHKEY[ApplicationInfo1.RegistryRoot];
    OpenKey(ApplicationInfo1.RegistryKey, True);
    ScaleDPI1.DPI := Point(ReadIntegerWithDefault('DPIX', 96), ReadIntegerWithDefault('DPIY', 96));
    ScaleDPI1.AutoDetect := ReadBoolWithDefault('DPIAuto', True);
    if ValueExists('LanguageCode') then
      Translator.Language := Translator.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
      else Translator.Language := Translator.Languages.SearchByCode('');
    AlwaysOnTop := ReadBoolWithDefault('AlwaysOnTop', False);
    StartMinimizedToTray := ReadBoolWithDefault('StartMinimizedToTray', False);
    ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
    ThemeManager.Theme := ThemeManager.Themes.FindByName(ReadStringWithDefault('Theme', 'System'));
  finally
    Free;
  end;
end;

procedure TCore.SaveConfig;
begin
  FormMain.SaveConfig;

  with TRegistryEx.Create do
  try
    RootKey := RegistryRootHKEY[ApplicationInfo1.RegistryRoot];
    OpenKey(ApplicationInfo1.RegistryKey, True);
    WriteInteger('DPIX', ScaleDPI1.DPI.X);
    WriteInteger('DPIY', ScaleDPI1.DPI.Y);
    WriteBool('DPIAuto', ScaleDPI1.AutoDetect);
    if Assigned(Translator.Language) and (Translator.Language.Code <> '') then
      WriteString('LanguageCode', Translator.Language.Code)
      else DeleteValue('LanguageCode');
    WriteBool('AlwaysOnTop', AlwaysOnTop);
    WriteBool('StartMinimizedToTray', StartMinimizedToTray);
    WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
    WriteString('Theme', ThemeManager.Theme.Name);
  finally
    Free;
  end;
end;

procedure TCore.ScaleDPI;
begin
  // TODO: Transparent image scaling not working properly under linux Gtk2
  // Also screen DPI is not correctly detected under linux Gtk2
  //Core.ScaleDPI1.DPI := Point(200, 200);
  //{$IFDEF WINDOWS}
  Core.ScaleDPI1.ScaleImageList(ImageListSmall, Core.ScaleDPI1.DesignDPI);
  //{$ENDIF}
end;

function TCore.FindFirstNonOption: string;
var
  S: string;
  I: Integer;
begin
  Result := '';
  for I := 1 to Application.ParamCount do begin
    S := Application.Params[I];
    if S[1] = Application.OptionChar then Continue;
    Result := S;
    Break;
  end;
end;

end.