emulthemes.pas

{
    EmulThemes содержит классы для создания тем оформления пользовательского
    интерфейса.
    Этот исходный текст является частью Малик Эмулятора.

    Copyright © 2016–2017, 2019–2023 Малик Разработчик

    Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
    изменять её на условиях Стандартной общественной лицензии GNU в том виде,
    в каком она была опубликована Фондом свободного программного обеспечения;
    либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.

    Малик Эмулятор распространяется в надежде, что он может быть полезен,
    но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
    или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
    общественной лицензии GNU.

    Вы должны были получить копию Стандартной общественной лицензии GNU
    вместе с этой программой. Если это не так, см.
    <http://www.gnu.org/licenses/>.
}

unit EmulThemes;

{$MODE DELPHI}

interface

uses
    Lang,
    Images;

{%region public }
const
    THEME_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C1514}';

type
    Theme = interface(_Interface) [THEME_GUID]
        function getName(): AnsiString;
        function getSystemColor(index: int): int;
        function getSizes(element: int): int;
        procedure drawElement(listener: GraphicListener; element, left, top, width, height: int);
    end;
{%endregion}

{%region routine }
    function getThemesCount(): int;
    function getTheme(index: int): Theme; overload;
    function getTheme(const name: AnsiString): Theme; overload;
    procedure addTheme(theme: Theme);
{%endregion}

implementation

{%region private }
type
    Theme_Array1d = packed array of Theme;

var
    THEMES_COUNT: int;
    THEMES: Theme_Array1d;
{%endregion}

{%region routine }
    function Theme_Array1d_create(length: int): Theme_Array1d;
    begin
        setLength(result, length);
    end;

    procedure arraycopy(const src: Theme_Array1d; srcOffset: int; const dst: Theme_Array1d; dstOffset: int; length: int);
    var
        lim: int;
        len: int;
        i: int;
    begin
        lim := srcOffset + length;
        len := System.length(src);
        if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
            raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
        end;
        lim := dstOffset + length;
        len := System.length(dst);
        if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
            raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
        end;
        if (src = dst) and (srcOffset < dstOffset) then begin
            for i := length - 1 downto 0 do begin
                dst[dstOffset + i] := src[srcOffset + i];
            end;
        end else begin
            for i := 0 to length - 1 do begin
                dst[dstOffset + i] := src[srcOffset + i];
            end;
        end;
    end;

    function getThemesCount(): int;
    begin
        result := THEMES_COUNT;
    end;

    function getTheme(index: int): Theme;
    begin
        if (index < 0) or (index >= THEMES_COUNT) then begin
            raise ArrayIndexOutOfBoundsException.create(index);
        end;
        result := THEMES[index];
    end;

    function getTheme(const name: AnsiString): Theme;
    var
        i: int;
        t: Theme;
    begin
        for i := THEMES_COUNT - 1 downto 0 do begin
            t := THEMES[i];
            if t.getName() = name then begin
                result := t;
                exit;
            end;
        end;
        result := nil;
    end;

    procedure addTheme(theme: Theme);
    var
        t: Theme_Array1d;
    begin
        t := THEMES;
        if THEMES_COUNT = length(t) then begin
            t := Theme_Array1d_create(THEMES_COUNT * 2);
            arraycopy(THEMES, 0, t, 0, THEMES_COUNT);
            THEMES := t;
        end;
        t[THEMES_COUNT] := theme;
        inc(THEMES_COUNT);
    end;
{%endregion}

initialization {%region}
    THEMES_COUNT := 0;
    THEMES := Theme_Array1d_create(1);
{%endregion}

end.