{
RunningListWindow используется для создания окна, в котором пользователь
смотрит список запущенных приложений и взаимодействует с ним.
Этот исходный текст является частью Малик Эмулятора.
Следующие файлы используются этим исходным текстом:
runninglistwindow.lfm
На них так же распространяются те же права, как и на этот исходный текст.
Copyright © 2016–2017, 2019–2023 Малик Разработчик
Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Малик Эмулятор распространяется в надежде, что он может быть полезен,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit RunningListWindow;
{$MODE DELPHI}
interface
uses
Classes,
SysUtils,
Forms,
Controls,
Graphics,
LCLType,
Lang,
Images,
Manifests,
EmulConstants,
EmulProgrammes,
EmulThemes,
EmulatorInterfaces;
{%region public }
type
TRunningListForm = class(TForm, GraphicListener)
procedure formHide(sender: TObject);
procedure formPaint(sender: TObject);
procedure formKeyDown(sender: TObject; var key: Word; shift: TShiftState);
procedure formKeyUp(sender: TObject; var key: Word; shift: TShiftState);
procedure formMouseDown(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: Integer);
procedure formMouseUp(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: Integer);
private
owner: MainWindowInterface;
manifest: ProgrammeManifest;
icon: TIcon;
selectedIndex: int;
image: TBitmap;
imageWidth: int;
imageHeight: int;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
procedure putPixel(x, y, argb: int);
procedure updateList();
function getClass(): _Class;
function asObject(): TObject;
end;
{%endregion}
implementation
{$R *.LFM}
{%region TRunningListForm }
constructor TRunningListForm.create(theOwner: TComponent);
var
width: int;
height: int;
begin
inherited create(theOwner);
theOwner.getInterface(MAIN_WINDOW_INTERFACE_GUID, owner);
width := self.clientWidth;
height := self.clientHeight;
manifest := ProgrammeManifest.create();
icon := TIcon.create();
image := TBitmap.create();
imageWidth := width;
imageHeight := height;
image.setSize(width, height);
end;
destructor TRunningListForm.destroy;
begin
icon.free();
image.free();
manifest.free();
inherited destroy;
end;
procedure TRunningListForm.formHide(sender: TObject);
begin
owner.notifyTerminated(nil);
end;
procedure TRunningListForm.formPaint(sender: TObject);
var
i: int;
w: int;
h: int;
count: int;
left: int;
top: int;
width: int;
height: int;
canvas: TCanvas;
clip: TRect;
info: ProgrammeInfo;
m: ProgrammeManifest;
n: TIcon;
s: AnsiString;
begin
width := imageWidth;
height := imageHeight;
canvas := image.canvas;
canvas.brush.color := clWhite;
canvas.clipRect := bounds(0, 0, width, height);
canvas.fillRect(bounds(0, 0, width, height));
left := 0;
top := 0;
height := 52;
m := self.manifest;
n := self.icon;
count := owner.getEmulatorsCount();
for i := 0 to count - 1 do begin
clip := bounds(left, top, width, height);
canvas.clipRect := clip;
if i = selectedIndex then begin
getTheme(0).drawElement(self, $000001, left, top, width, height);
end;
info := ProgrammeInfo.create(owner.getEmulator(i).getProgrammeDirectory());
try
info.loadManifest(m);
info.loadIcon(n);
findBestIconSize(n, 48);
clip := bounds(left + 2, top + 2, 48, 48);
canvas.clipRect := clip;
w := n.width;
h := n.height;
if (w > 48) or (h > 48) then begin
if w >= h then begin
h := int(round(48.0 * toReal(h) / toReal(w)));
w := 48;
end else begin
w := int(round(48.0 * toReal(w) / toReal(h)));
h := 48;
end;
canvas.stretchDraw(bounds(clip.left + ((48 - w) div 2), clip.top + ((48 - h) div 2), w, h), n);
end else begin
canvas.draw(clip.left + ((48 - w) div 2), clip.top + ((48 - h) div 2), n);
end;
clip := rect(left + 52, top + 2, left + width - 2, top + height - 2);
canvas.clipRect := clip;
s := trim(m.getValue(MANIFEST_PROPERTY_PROGRAMME_NAME));
canvas.brush.style := bsClear;
canvas.font.color := clBlack;
canvas.textOut(left + 52, top + 18, s);
finally
info.free();
end;
inc(top, height);
end;
self.canvas.draw(0, 0, image);
end;
procedure TRunningListForm.formKeyDown(sender: TObject; var key: Word; shift: TShiftState);
var
count: int;
begin
if (key = VK_M) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Alt+M – показать главное окно }
owner.showMainWindow();
key := 0;
exit;
end;
if (key = VK_UP) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ ↑ – переместить вверх }
count := owner.getEmulatorsCount();
if count > 0 then begin
selectedIndex := (selectedIndex + count - 1) mod count;
repaint();
end;
key := 0;
exit;
end;
if (key = VK_DOWN) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ ↓ – переместить вниз }
count := owner.getEmulatorsCount();
if count > 0 then begin
selectedIndex := (selectedIndex + 1) mod count;
repaint();
end;
key := 0;
exit;
end;
end;
procedure TRunningListForm.formKeyUp(sender: TObject; var key: Word; shift: TShiftState);
var
index: int;
begin
if (key = VK_RETURN) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ Enter – переключиться на выбранную программу }
index := selectedIndex;
if index < owner.getEmulatorsCount() then begin
owner.getEmulator(index).showEmulationWindow();
end;
key := 0;
exit;
end;
end;
procedure TRunningListForm.formMouseDown(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: Integer);
var
count: int;
index: int;
begin
if button = TMouseButton.mbLeft then begin
index := y div 52;
count := owner.getEmulatorsCount();
if (index >= 0) and (index < count) then begin
selectedIndex := index;
formPaint(self);
end;
end;
end;
procedure TRunningListForm.formMouseUp(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: Integer);
var
index: int;
left: int;
top: int;
right: int;
bottom: int;
begin
index := selectedIndex;
if index < owner.getEmulatorsCount() then begin
left := 0;
top := selectedIndex * 52;
right := imageWidth;
bottom := top + 52;
if (button = TMouseButton.mbLeft) and (x >= left) and (x < right) and (y >= top) and (y < bottom) then begin
owner.getEmulator(index).showEmulationWindow();
end;
end;
end;
procedure TRunningListForm.afterConstruction();
var
x: int;
y: int;
c: AnsiString_Array1d;
begin
inherited afterConstruction();
x := 0;
y := 0;
c := getComponents(owner.getSetting(SECTION_WINDOWS, KEY_RUNNING_PROGRAMMES, 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;
end;
procedure TRunningListForm.beforeDestruction();
begin
owner.setSetting(SECTION_WINDOWS, KEY_RUNNING_PROGRAMMES, toDecString(left) + ',' + toDecString(top));
inherited beforeDestruction();
end;
procedure TRunningListForm.putPixel(x, y, argb: int);
var
canvas: TCanvas;
begin
canvas := image.canvas;
canvas.pixels[x, y] := byteSwap(computePixel(byteSwap(canvas.pixels[x, y]) shr 8, argb, false, true)) shr 8;
end;
procedure TRunningListForm.updateList();
var
count: int;
begin
count := owner.getEmulatorsCount();
if count > 0 then begin
dec(count);
if selectedIndex > count then begin
selectedIndex := count;
end;
end;
formPaint(self);
end;
function TRunningListForm.getClass(): _Class;
begin
result := ClassData.create(classType());
end;
function TRunningListForm.asObject(): TObject;
begin
result := self;
end;
{%endregion}
end.
