{
MainWindow используется для создания главного окна Малик Эмулятора.
Этот исходный текст является частью Малик Эмулятора.
Следующие файлы используются этим исходным текстом:
mainwindow.lfm
На них так же распространяются те же права, как и на этот исходный текст.
Copyright © 2016–2017, 2019–2023 Малик Разработчик
Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Малик Эмулятор распространяется в надежде, что он может быть полезен,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit MainWindow;
{$MODE DELPHI}
interface
uses
Classes,
SysUtils,
Forms,
Graphics,
Dialogs,
Controls,
StdCtrls,
ComCtrls,
ExtCtrls,
Menus,
Lang,
IOStreams,
FileIO,
SettingFiles,
Manifests,
EmulConstants,
EmulProgrammes,
StaticRecompilers,
EmulatorInterfaces,
EmulationWindow,
ProgrammePropertiesWindow,
InstallWindow,
InstallProcessWindow,
UninstallProcessWindow,
RunningListWindow,
SettingsWindow,
AboutWindow,
ProgrammesListFrame;
{%region public }
const
MAX_RUNNING_PROGRAMMES = int(4);
MAX_RECENT_PROGRAMMES = int(10);
type
ProgrammeInfoWithID = class;
TMainForm = class;
ProgrammeInfoWithID_Array1d = packed array of ProgrammeInfoWithID;
ProgrammeInfoWithID = class(ProgrammeInfo)
strict private
id: AnsiString;
public
constructor create(const id, directory: AnsiString);
function getID(): AnsiString;
end;
TMainForm = class(TEmulatorFormWithDialog, _Interface, MainWindowInterface)
infoAgeCatBack: TImage;
infoAgeCat: TLabel;
mainMenu: TMainMenu;
programmeMenu: TMenuItem;
programmeLaunch: TMenuItem;
programmeDebug: TMenuItem;
programmeProperties: TMenuItem;
_001: TMenuItem;
programmeInstall: TMenuItem;
programmeUninstall: TMenuItem;
programmeMove: TMenuItem;
_002: TMenuItem;
programmeRunningList: TMenuItem;
_003: TMenuItem;
programmeEmulatorSettings: TMenuItem;
_004: TMenuItem;
programmeCloseWindow: TMenuItem;
viewMenu: TMenuItem;
viewRecent: TMenuItem;
viewGames: TMenuItem;
viewApps: TMenuItem;
helpMenu: TMenuItem;
helpAbout: TMenuItem;
menuBevel: TBevel;
programmesTabs: TPageControl;
recentTab: TTabSheet;
recentList: TProgrammesList;
gamesTab: TTabSheet;
gamesList: TProgrammesList;
appsTab: TTabSheet;
appsList: TProgrammesList;
infoPanel: TPanel;
infoIcon: TImage;
infoName: TMemo;
infoDescription: TMemo;
infoLaunch: TButton;
runningList: TRunningListForm;
procedure formShow(sender: TObject);
procedure formClose(sender: TObject; var action: TCloseAction);
procedure programmeLaunchClick(sender: TObject);
procedure programmeDebugClick(sender: TObject);
procedure programmePropertiesClick(sender: TObject);
procedure programmeInstallClick(sender: TObject);
procedure programmeUninstallClick(sender: TObject);
procedure programmeMoveClick(sender: TObject);
procedure programmeRunningListClick(sender: TObject);
procedure programmeEmulatorSettingsClick(sender: TObject);
procedure programmeCloseWindowClick(sender: TObject);
procedure viewPageClick(sender: TObject);
procedure helpAboutClick(sender: TObject);
procedure programmesTabsChange(sender: TObject);
procedure programmesListSelectionChange(sender: TObject; user: boolean);
private
emulatorDirectory: AnsiString;
settings: AbstractInitializationFile;
programmes: ProgrammeInfoWithID_Array1d;
{
Некоторые ячейки массива programmes могут быть равны нулевой ссылке из-за несуществования некоторых папок или файлов манифеста.
Это может случиться из-за того, что в списке установленных программ могут оказаться несуществующие папки.
}
runningProgrammes: EmulationWindowInterface_Array1d;
runningProgrammesCount: int;
procedure clearInfoBox();
procedure fillProgrammesLists();
procedure fillProgrammesRecent();
procedure launchSelectedProgramme(debug: boolean);
procedure registerProgramme(const programmeDirectory: AnsiString);
procedure unregisterProgramme(const id: AnsiString);
procedure makeRecentProgramme(const id: AnsiString);
function getProgrammeInfo(const id: AnsiString): ProgrammeInfoWithID;
function getSelectedProgrammeInfo(): ProgrammeInfo;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
{ _Interface }
function getClass(): _Class;
function asObject(): TObject;
{ MainWindowInterface }
procedure showMainWindow();
procedure notifyTerminated(window: EmulationWindowInterface);
procedure saveSettings();
procedure removeSetting(const section, key: AnsiString);
procedure setSetting(const section, key, value: AnsiString);
function isSectionExists(const section: AnsiString): boolean;
function isKeyExists(const section, key: AnsiString): boolean;
function getSetting(const section, key, defaultValue: AnsiString): AnsiString;
function getSections(): AnsiString_Array1d;
function getKeys(const section: AnsiString): AnsiString_Array1d;
function getEmulatorsCount(): int;
function getEmulator(index: int): EmulationWindowInterface;
strict private
INSTANCE: TMainForm; static;
public
class procedure createInstance();
end;
{%endregion}
implementation
{$R *.LFM}
{%region routine }
function ProgrammeInfoWithID_Array1d_create(length: int): ProgrammeInfoWithID_Array1d;
begin
setLength(result, length);
end;
{%endregion}
{%region ProgrammeInfoWithID }
constructor ProgrammeInfoWithID.create(const id, directory: AnsiString);
begin
inherited create(directory);
self.id := id;
end;
function ProgrammeInfoWithID.getID(): AnsiString;
begin
result := id;
end;
{%endregion}
{%region TMainForm }
class procedure TMainForm.createInstance();
begin
if INSTANCE = nil then begin
application.createForm(self, INSTANCE);
end;
end;
constructor TMainForm.create(theOwner: TComponent);
var
i: int;
j: int;
s: AnsiString;
r: StaticRecompiler;
a: AdjustableRecompiler;
begin
inherited create(theOwner);
settings := NormalInitializationFile.create(emulatorDirectory + 'emulator.ini');
emulatorDirectory := getEmulatorDirectory();
runningList := TRunningListForm.create(self);
runningProgrammes := EmulationWindowInterface_Array1d_create(MAX_RUNNING_PROGRAMMES);
for i := getRecompilersCount() - 1 downto 0 do begin
r := getRecompiler(i);
r.getInterface(stringToGUID(ADJUSTABLE_RECOMPILER_GUID), a);
if a = nil then begin
continue;
end;
s := 'platform: ' + a.getPlatformName();
if not settings.isSectionExists(s) then begin
a.setDefaults();
continue;
end;
a.setAlignment(getSetting(s, KEY_ALIGNMENT, '1') = '1');
a.setCompressionLevel(parseDecInt(getSetting(s, KEY_COMPRESSION, ''), 0));
a.setStackSize(parseDecInt(getSetting(s, KEY_STACK, ''), 1));
j := parseDecInt(getSetting(s, KEY_HEAP, ''), 4);
a.setHeapSize(j shl 10);
a.setDescriptorsSize(j shl 5);
a.setOutputExecutableFileName(getSetting(s, KEY_EXECUTABLE, '/executable'));
end;
end;
destructor TMainForm.destroy;
begin
runningList.free();
saveSettings();
settings.free();
inherited destroy;
end;
procedure TMainForm.formShow(sender: TObject);
begin
TProgrammesList(programmesTabs.activePage.controls[0]).programmesList.setFocus();
end;
procedure TMainForm.formClose(sender: TObject; var action: TCloseAction);
begin
if (runningProgrammesCount = 0) and (runningList.visible = false) then begin
action := caFree;
application.terminate();
end else begin
action := caHide;
end;
end;
procedure TMainForm.programmeLaunchClick(sender: TObject);
begin
launchSelectedProgramme(false);
end;
procedure TMainForm.programmeDebugClick(sender: TObject);
begin
launchSelectedProgramme(true);
end;
procedure TMainForm.programmePropertiesClick(sender: TObject);
var
propertiesDialog: TProgrammePropertiesForm;
info: ProgrammeInfo;
pman: ProgrammeManifest;
sizes: AnsiString_Array1d;
screenWidth: int;
screenHeight: int;
begin
info := getSelectedProgrammeInfo();
if info = nil then begin
exit;
end;
propertiesDialog := TProgrammePropertiesForm.create(self);
try
pman := ProgrammeManifest.create();
try
info.loadManifest(pman);
sizes := getComponents(pman.getValue(MANIFEST_PROPERTY_MALIK_SCREEN_SIZE));
if length(sizes) >= 2 then begin
screenWidth := parseDecInt(sizes[0], DEFAULT_SCREEN_WIDTH);
screenHeight := parseDecInt(sizes[1], DEFAULT_SCREEN_HEIGHT);
end else begin
screenWidth := DEFAULT_SCREEN_WIDTH;
screenHeight := DEFAULT_SCREEN_HEIGHT;
end;
propertiesDialog.setProperties(info.getProgrammeDirectory(), pman.getValue(MANIFEST_PROPERTY_PROGRAMME_DESCRIPTION), screenWidth, screenHeight);
if openDialog(propertiesDialog) = mrOK then begin
pman.setValue(MANIFEST_PROPERTY_PROGRAMME_DESCRIPTION, trim(propertiesDialog.getDescription()));
screenWidth := propertiesDialog.getScreenWidth();
screenHeight := propertiesDialog.getScreenHeight();
if (screenWidth = DEFAULT_SCREEN_WIDTH) and (screenHeight = DEFAULT_SCREEN_HEIGHT) then begin
pman.setValue(MANIFEST_PROPERTY_MALIK_SCREEN_SIZE, '');
end else begin
pman.setValue(MANIFEST_PROPERTY_MALIK_SCREEN_SIZE, makeStringOf(toStringArray1d([
toDecString(screenWidth), toDecString(screenHeight)
])));
end;
info.saveManifest(pman);
programmesListSelectionChange(TProgrammesList(programmesTabs.activePage.controls[0]).programmesList, false);
end;
finally
pman.free();
end;
finally
propertiesDialog.free();
end;
end;
procedure TMainForm.programmeInstallClick(sender: TObject);
var
installDialog: TInstallForm;
progressDialog: TInstallProcessForm;
recompiler: StaticRecompiler;
archive: AnsiString;
destinationDirectory: AnsiString;
programmeDirectory: AnsiString;
begin
installDialog := TInstallForm.create(self);
try
if openDialog(installDialog) <> mrOK then begin
exit;
end;
recompiler := installDialog.getRecompiler();
archive := installDialog.getArchive();
destinationDirectory := installDialog.getDestinationDirectory();
finally
installDialog.free();
end;
progressDialog := TInstallProcessForm.create(self);
try
progressDialog.setInstallParameters(recompiler, archive, destinationDirectory);
openDialog(progressDialog);
programmeDirectory := progressDialog.getProgrammeDirectory();
finally
progressDialog.free();
end;
if programmeDirectory = '' then begin
exit;
end;
registerProgramme(programmeDirectory);
fillProgrammesLists();
end;
procedure TMainForm.programmeUninstallClick(sender: TObject);
var
i: int;
running: EmulationWindowInterface_Array1d;
uninstallingProgramme: ProgrammeInfoWithID;
processDialog: TUninstallProcessForm;
uninstalled: boolean;
dir: AnsiString;
id: AnsiString;
begin
uninstallingProgramme := ProgrammeInfoWithID(getSelectedProgrammeInfo());
dir := uninstallingProgramme.getProgrammeDirectory();
running := runningProgrammes;
for i := runningProgrammesCount - 1 downto 0 do begin
if running[i].getProgrammeDirectory() = dir then begin
openDialog('Ошибка', 'Нельзя удалить программу, если она выполняется.', mtError, [mbClose]);
exit;
end;
end;
id := uninstallingProgramme.getID();
processDialog := TUninstallProcessForm.create(self);
try
processDialog.setUninstallID(id);
openDialog(processDialog);
uninstalled := processDialog.isUninstalled();
finally
processDialog.free();
end;
if uninstalled then begin
unregisterProgramme(id);
fillProgrammesLists();
end;
end;
procedure TMainForm.programmeMoveClick(sender: TObject);
var
info: ProgrammeInfoWithID;
oldDirectory: AnsiString;
newDirectory: AnsiString;
edir: AnsiString;
len: int;
begin
info := ProgrammeInfoWithID(getSelectedProgrammeInfo());
if info = nil then begin
exit;
end;
edir := emulatorDirectory;
oldDirectory := info.getProgrammeDirectory();
if startsWith(edir + DIRECTORY_APPS, oldDirectory) then begin
len := length(edir) + length(DIRECTORY_APPS);
newDirectory := edir + DIRECTORY_GAMES + copy(oldDirectory, len + 1, length(oldDirectory) - len);
end else
if startsWith(edir + DIRECTORY_GAMES, oldDirectory) then begin
len := length(edir) + length(DIRECTORY_GAMES);
newDirectory := edir + DIRECTORY_APPS + copy(oldDirectory, len + 1, length(oldDirectory) - len);
end else begin
exit;
end;
delete(oldDirectory, length(oldDirectory), 1);
delete(newDirectory, length(newDirectory), 1);
try
if not move(oldDirectory, newDirectory) then begin
raise IOException.create('Не удалось переместить папку ' + oldDirectory + ' на новое место под новым именем ' + newDirectory);
end;
len := length(edir);
setSetting(SECTION_PROGRAMMES, info.getID(), copy(newDirectory, len + 1, length(newDirectory) - len));
saveSettings();
fillProgrammesLists();
except
on e: Lang.Exception do begin
openDialog('Ошибка',
'При выполнении команды произошла ошибка.' + (LINE_ENDING +
'Класс: ') + e.getClass().getName() + (LINE_ENDING +
'Сообщение: ') + e.getMessage(), mtError, [mbClose]
);
end;
on e: SysUtils.Exception do begin
openDialog('Ошибка',
'При выполнении команды произошла ошибка.' + (LINE_ENDING +
'Класс: ') + (e.unitName() + '.' + e.className()) + (LINE_ENDING +
'Сообщение: ') + e.message, mtError, [mbClose]
);
end;
end;
end;
procedure TMainForm.programmeRunningListClick(sender: TObject);
begin
runningList.showOnTop();
end;
procedure TMainForm.programmeEmulatorSettingsClick(sender: TObject);
var
dialog: TForm;
begin
dialog := TSettingsForm.create(self);
try
openDialog(dialog);
finally
dialog.free();
end;
end;
procedure TMainForm.programmeCloseWindowClick(sender: TObject);
begin
close();
end;
procedure TMainForm.viewPageClick(sender: TObject);
begin
programmesTabs.pages[TMenuItem(sender).tag].show();
end;
procedure TMainForm.helpAboutClick(sender: TObject);
var
dialog: TForm;
begin
dialog := TAboutForm.create(self);
try
openDialog(dialog);
finally
dialog.free();
end;
end;
procedure TMainForm.programmesTabsChange(sender: TObject);
var
list: TListBox;
begin
viewMenu.items[programmesTabs.activePageIndex].checked := true;
list := TProgrammesList(programmesTabs.activePage.controls[0]).programmesList;
list.setFocus();
programmesListSelectionChange(list, false);
end;
procedure TMainForm.programmesListSelectionChange(sender: TObject; user: boolean);
var
len: int;
icon: TIcon;
info: ProgrammeInfo;
pman: ProgrammeManifest;
s: AnsiString;
t: AnsiString;
begin
if sender <> TProgrammesList(programmesTabs.activePage.controls[0]).programmesList then begin
exit;
end;
info := TProgrammesList(TControl(sender).parent).getSelectedProgrammeInfo();
if info = nil then begin
clearInfoBox();
exit;
end;
try
pman := ProgrammeManifest.create();
try
icon := infoIcon.picture.icon;
info.loadManifest(pman);
info.loadIcon(icon);
findBestIconSize(icon, 128);
s := trim(pman.getValue(MANIFEST_PROPERTY_AGE_CATEGORY));
len := length(s);
if ((len = 3) and (s[1] = '1') and (s[2] in ['0'..'9']) and (s[3] = '+')) or ((len = 2) and (s[1] in ['0'..'9']) and (s[2] = '+')) then begin
infoAgeCatBack.visible := true;
infoAgeCat.visible := true;
infoAgeCat.caption := s;
end else begin
infoAgeCatBack.visible := false;
infoAgeCat.visible := false;
infoAgeCat.caption := '';
end;
infoName.text := trim(pman.getValue(MANIFEST_PROPERTY_PROGRAMME_NAME));
s := trim(pman.getValue(MANIFEST_PROPERTY_PROGRAMME_DESCRIPTION));
if s = '' then begin
s := 'Описание отсутствует. Если хотите самостоятельно добавить описание к программе, нажмите пункт меню Программа → Свойства.';
end;
s := s + (LINE_ENDING + LINE_ENDING +
'Версия: ') + trim(pman.getValue(MANIFEST_PROPERTY_PROGRAMME_VERSION)) + (LINE_ENDING + LINE_ENDING +
'Разработчик: ') + trim(pman.getValue(MANIFEST_PROPERTY_PROGRAMME_VENDOR))
;
t := trim(pman.getValue(MANIFEST_PROPERTY_PROGRAMME_SITE));
if t <> '' then begin
s := s + (LINE_ENDING + LINE_ENDING + 'Интернет: ') + t;
end;
t := trim(pman.getValue(MANIFEST_PROPERTY_SOURCE_PLATFORM));
if t <> '' then begin
s := s + (LINE_ENDING + LINE_ENDING + 'Исходная платформа: ') + t;
end;
infoDescription.text := s;
infoLaunch.enabled := true;
programmeLaunch.enabled := true;
programmeDebug.enabled := true;
programmeProperties.enabled := true;
programmeUninstall.enabled := true;
s := info.getProgrammeDirectory();
if startsWith(emulatorDirectory + DIRECTORY_GAMES, s) then begin
programmeMove.caption := 'Переместить &в Приложения';
programmeMove.enabled := true;
end else
if startsWith(emulatorDirectory + DIRECTORY_APPS, s) then begin
programmeMove.caption := 'Переместить &в Игры';
programmeMove.enabled := true;
end else begin
programmeMove.caption := 'Переместить';
programmeMove.enabled := false;
end;
finally
pman.free();
end;
except
clearInfoBox();
end;
end;
procedure TMainForm.clearInfoBox();
begin
infoIcon.picture.graphic := nil;
infoAgeCat.caption := '';
infoAgeCat.visible := false;
infoAgeCatBack.visible := false;
infoName.text := '';
infoDescription.text := '';
infoLaunch.enabled := false;
programmeLaunch.enabled := false;
programmeDebug.enabled := false;
programmeProperties.enabled := false;
programmeUninstall.enabled := false;
programmeMove.enabled := false;
programmeMove.caption := 'Переместить';
end;
procedure TMainForm.fillProgrammesLists();
var
i: int;
count: int;
recentCount: int;
gamesCount: int;
appsCount: int;
otherCount: int;
all: ProgrammeInfoWithID_Array1d;
recent: ProgrammeInfo_Array1d;
games: ProgrammeInfo_Array1d;
apps: ProgrammeInfo_Array1d;
other: ProgrammeInfo_Array1d;
info: ProgrammeInfoWithID;
otherTab: TTabSheet;
otherList: TProgrammesList;
viewOther: TMenuItem;
ids: AnsiString_Array1d;
id: AnsiString;
edir: AnsiString;
directory: AnsiString;
recentIDs: AnsiString_Array1d;
begin
all := programmes;
for i := 0 to length(all) - 1 do begin
all[i].free();
all[i] := nil;
end;
ids := getKeys(SECTION_PROGRAMMES);
count := length(ids);
for i := 0 to count - 1 do begin
if ids[i] = KEY_RECENT then begin
arraycopy(ids, i + 1, ids, i, count - i - 1);
dec(count);
break;
end;
end;
recentCount := 0;
gamesCount := 0;
appsCount := 0;
otherCount := 0;
all := ProgrammeInfoWithID_Array1d_create(count);
recent := ProgrammeInfo_Array1d_create(count);
games := ProgrammeInfo_Array1d_create(count);
apps := ProgrammeInfo_Array1d_create(count);
other := ProgrammeInfo_Array1d_create(count);
edir := emulatorDirectory;
programmes := all;
{ Формируем список всех программ }
for i := 0 to count - 1 do begin
id := ids[i];
directory := trim(getSetting(SECTION_PROGRAMMES, id, ''));
if not endsWith(DIRECTORY_SEPARATOR, directory) then begin
directory := directory + DIRECTORY_SEPARATOR;
end;
if (length(directory) < 2) or (not (directory[1] in ['A'..'Z', 'a'..'z'])) or (directory[2] <> ':') then begin
directory := edir + directory;
end;
if not fileExists(directory + ProgrammeInfo.MANIFEST_FILE_NAME) then begin
continue;
end;
info := ProgrammeInfoWithID.create(id, directory);
all[i] := info;
if startsWith(edir + DIRECTORY_GAMES, directory) then begin
games[gamesCount] := info;
inc(gamesCount);
end else
if startsWith(edir + DIRECTORY_APPS, directory) then begin
apps[appsCount] := info;
inc(appsCount);
end else begin
other[otherCount] := info;
inc(otherCount);
end;
end;
recentIDs := getComponents(getSetting(SECTION_PROGRAMMES, KEY_RECENT, ''));
for i := 0 to length(recentIDs) - 1 do begin
info := getProgrammeInfo(recentIDs[i]);
if info = nil then begin
continue;
end;
recent[recentCount] := info;
inc(recentCount);
end;
{ Заполняем списки }
recentList.setProgrammesInfo(recent, recentCount);
gamesList.setProgrammesInfo(games, gamesCount);
appsList.setProgrammesInfo(apps, appsCount);
if (programmesTabs.pageCount = 4) and (otherCount = 0) then begin
recentTab.show();
otherTab := programmesTabs.pages[3];
otherList := otherTab.controls[0] as TProgrammesList;
otherList.free();
otherTab.free();
viewMenu.items[3].free();
exit;
end;
if otherCount = 0 then begin
exit;
end;
if programmesTabs.pageCount = 3 then begin
otherTab := programmesTabs.addTabSheet();
otherList := TProgrammesList.create(otherTab);
viewOther := TMenuItem.create(self);
otherTab.caption := 'Прочие';
otherTab.insertControl(otherList);
otherList.align := alClient;
otherList.programmesList.onSelectionChange := programmesListSelectionChange;
viewMenu.insert(3, viewOther);
viewOther.autoCheck := true;
viewOther.caption := 'П&рочие';
viewOther.groupIndex := 1;
viewOther.radioItem := true;
viewOther.shortCut := 16436;
viewOther.tag := 3;
viewOther.onClick := viewPageClick;
end else begin
otherTab := programmesTabs.pages[3];
otherList := otherTab.controls[0] as TProgrammesList;
end;
otherList.setProgrammesInfo(other, otherCount);
end;
procedure TMainForm.fillProgrammesRecent();
var
i: int;
len: int;
recentCount: int;
info: ProgrammeInfoWithID;
recent: ProgrammeInfo_Array1d;
recentIDs: AnsiString_Array1d;
begin
recentIDs := getComponents(getSetting(SECTION_PROGRAMMES, KEY_RECENT, ''));
len := length(recentIDs);
recent := ProgrammeInfo_Array1d_create(len);
recentCount := 0;
for i := 0 to len - 1 do begin
info := getProgrammeInfo(recentIDs[i]);
if info = nil then begin
continue;
end;
recent[recentCount] := info;
inc(recentCount);
end;
recentList.setProgrammesInfo(recent, recentCount);
end;
procedure TMainForm.launchSelectedProgramme(debug: boolean);
var
id: AnsiString;
dir: AnsiString;
info: ProgrammeInfoWithID;
emulator: TEmulationForm;
f: EmulationWindowInterface;
e: EmulationWindowInterface_Array1d;
c: int;
i: int;
begin
info := ProgrammeInfoWithID(getSelectedProgrammeInfo());
if info = nil then begin
exit;
end;
e := runningProgrammes;
c := runningProgrammesCount;
dir := info.getProgrammeDirectory();
for i := c - 1 downto 0 do begin
f := e[i];
if f.getProgrammeDirectory() = dir then begin
f.showEmulationWindow();
if debug then begin
f.showDisassemblerWindow();
end;
exit;
end;
end;
if c = length(e) then begin
openDialog('Слишком много запущенных программ',
'Чтобы не перегружать процессор и память компьютера, максимальное количество одновременно выполняющихся программ ограничено ' + toDecString(c) +
'. Закройте окно любой программы и повторите попытку.', mtError, [mbClose]
);
exit;
end;
emulator := TEmulationForm.create(self);
try
id := info.getID();
e[c] := emulator;
runningProgrammesCount := c + 1;
emulator.setProgramme(id, info);
emulator.setDebug(debug);
emulator.show();
emulator.runProgramme();
makeRecentProgramme(id);
fillProgrammesRecent();
saveSettings();
runningList.updateList();
except
on e: Lang.Exception do begin
emulator.enabled := false;
openDialog('Ошибка',
'При выполнении команды произошла ошибка.' + (LINE_ENDING +
'Класс: ') + e.getClass().getName() + (LINE_ENDING +
'Сообщение: ') + e.getMessage(), mtError, [mbClose]
);
emulator.free();
end;
on e: SysUtils.Exception do begin
emulator.enabled := false;
openDialog('Ошибка',
'При выполнении команды произошла ошибка.' + (LINE_ENDING +
'Класс: ') + (e.unitName() + '.' + e.className()) + (LINE_ENDING +
'Сообщение: ') + e.message, mtError, [mbClose]
);
emulator.free();
end;
else begin
emulator.free();
end;
end;
end;
procedure TMainForm.registerProgramme(const programmeDirectory: AnsiString);
var
len: int;
edir: AnsiString;
wdir: AnsiString;
id: AnsiString;
begin
edir := emulatorDirectory;
len := length(edir);
if startsWith(edir, programmeDirectory) then begin
wdir := copy(programmeDirectory, len + 1, length(programmeDirectory) - len);
end else begin
wdir := programmeDirectory;
end;
repeat
id := toHexString(random($100000000), 8);
until not isKeyExists(SECTION_PROGRAMMES, id);
setSetting(SECTION_PROGRAMMES, id, wdir);
makeRecentProgramme(id);
saveSettings();
fillProgrammesLists();
end;
procedure TMainForm.unregisterProgramme(const id: AnsiString);
var
i: int;
len: int;
ids: AnsiString_Array1d;
newIds: AnsiString_Array1d;
begin
removeSetting(SECTION_PROGRAMMES, id);
removeSetting(SECTION_WINDOWS, id);
ids := getComponents(getSetting(SECTION_PROGRAMMES, KEY_RECENT, ''));
len := length(ids);
for i := len - 1 downto 0 do begin
if ids[i] <> id then begin
continue;
end;
newIds := String_Array1d_create(len - 1);
arraycopy(ids, 0, newIds, 0, i);
arraycopy(ids, i + 1, newIds, i, len - i - 1);
setSetting(SECTION_PROGRAMMES, KEY_RECENT, makeStringOf(newIds));
end;
saveSettings();
fillProgrammesLists();
end;
procedure TMainForm.makeRecentProgramme(const id: AnsiString);
var
i: int;
j: int;
len: int;
ids: AnsiString_Array1d;
newIds: AnsiString_Array1d;
begin
ids := getComponents(getSetting(SECTION_PROGRAMMES, KEY_RECENT, ''));
len := length(ids);
for i := 0 to len - 1 do begin
if ids[i] <> id then begin
continue;
end;
if i = 0 then begin
exit;
end;
for j := i downto 1 do begin
ids[j] := ids[j - 1];
end;
ids[0] := id;
setSetting(SECTION_PROGRAMMES, KEY_RECENT, makeStringOf(ids));
exit;
end;
if len < MAX_RECENT_PROGRAMMES then begin
newIds := ids;
ids := String_Array1d_create(len + 1);
arraycopy(newIds, 0, ids, 0, len);
inc(len);
end;
for i := len - 1 downto 1 do begin
ids[i] := ids[i - 1];
end;
ids[0] := id;
setSetting(SECTION_PROGRAMMES, KEY_RECENT, makeStringOf(ids));
end;
function TMainForm.getProgrammeInfo(const id: AnsiString): ProgrammeInfoWithID;
var
i: int;
p: ProgrammeInfoWithID_Array1d;
info: ProgrammeInfoWithID;
begin
result := nil;
p := programmes;
for i := 0 to length(p) - 1 do begin
info := p[i];
if (info = nil) or (info.getID() <> id) then begin
continue;
end;
result := info;
exit;
end;
end;
function TMainForm.getSelectedProgrammeInfo(): ProgrammeInfo;
begin
result := TProgrammesList(programmesTabs.activePage.controls[0]).getSelectedProgrammeInfo();
end;
procedure TMainForm.afterConstruction();
var
x: int;
y: int;
c: AnsiString_Array1d;
begin
inherited afterConstruction();
x := (screen.width - self.width) div 2;
y := (screen.height - self.height) div 2;
c := getComponents(getSetting(SECTION_WINDOWS, KEY_MAIN, toDecString(x) + ',' + toDecString(y)));
if length(c) >= 2 then begin
left := parseDecInt(c[0], x);
top := parseDecInt(c[1], y);
end else begin
left := x;
top := y;
end;
fillProgrammesLists();
end;
procedure TMainForm.beforeDestruction();
var
i: int;
p: ProgrammeInfoWithID_Array1d;
begin
setSetting(SECTION_WINDOWS, KEY_MAIN, toDecString(left) + ',' + toDecString(top));
p := programmes;
for i := 0 to length(p) - 1 do begin
p[i].free();
end;
inherited beforeDestruction();
end;
function TMainForm.getClass(): _Class;
begin
result := ClassData.create(classType());
end;
function TMainForm.asObject(): TObject;
begin
result := self;
end;
procedure TMainForm.showMainWindow();
var
dialog: TForm;
begin
dialog := getOpenedDialog();
if dialog <> nil then begin
dialog.showOnTop();
end else begin
self.showOnTop();
end;
end;
procedure TMainForm.notifyTerminated(window: EmulationWindowInterface);
var
e: EmulationWindowInterface_Array1d;
c: int;
i: int;
begin
e := runningProgrammes;
c := runningProgrammesCount - 1;
for i := c downto 0 do begin
if e[i] <> window then begin
continue;
end;
if c <> i then begin
arraycopy(e, i + 1, e, i, c - i);
end;
e[c] := nil;
runningProgrammesCount := c;
break;
end;
runningList.updateList();
if (runningProgrammesCount = 0) and (self.visible = false) and (runningList.visible = false) then begin
application.terminate();
end;
end;
procedure TMainForm.saveSettings();
begin
settings.updateFile();
end;
procedure TMainForm.removeSetting(const section, key: AnsiString);
begin
settings.deleteIdent(section, key);
end;
procedure TMainForm.setSetting(const section, key, value: AnsiString);
begin
settings.writeString(section, key, value);
end;
function TMainForm.isSectionExists(const section: AnsiString): boolean;
begin
result := settings.isSectionExists(section);
end;
function TMainForm.isKeyExists(const section, key: AnsiString): boolean;
begin
result := settings.isIdentExists(section, key);
end;
function TMainForm.getSetting(const section, key, defaultValue: AnsiString): AnsiString;
begin
result := settings.readString(section, key, defaultValue);
end;
function TMainForm.getSections(): AnsiString_Array1d;
begin
result := settings.readSections();
end;
function TMainForm.getKeys(const section: AnsiString): AnsiString_Array1d;
begin
result := settings.readSection(section);
end;
function TMainForm.getEmulatorsCount(): int;
begin
result := runningProgrammesCount;
end;
function TMainForm.getEmulator(index: int): EmulationWindowInterface;
begin
if (index < 0) or (index >= runningProgrammesCount) then begin
raise ArrayIndexOutOfBoundsException.create(index);
end;
result := runningProgrammes[index];
end;
{%endregion}
end.
