programmepropertieswindow.pas

Переключить прокрутку окна
Загрузить этот исходный код

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

    Следующие файлы используются этим исходным текстом:
        programmepropertieswindow.lfm
    На них так же распространяются те же права, как и на этот исходный текст.

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

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

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

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

unit ProgrammePropertiesWindow;

{$MODE DELPHI}

interface

uses
    Classes,
    Forms,
    StdCtrls,
    ComCtrls,
    LCLType,
    Lang,
    EmulConstants;

{%region public }
type
    TProgrammePropertiesForm = class(TForm)
        placeLabel: TLabel;
        place: TEdit;
        descriptionLabel: TLabel;
        descriptionRemaining: TLabel;
        description: TMemo;
        screenWidthLabel: TLabel;
        screenWidth: TEdit;
        screenWidthCounter: TUpDown;
        screenHeightLabel: TLabel;
        screenHeight: TEdit;
        screenHeightCounter: TUpDown;
        defaultsButton: TButton;
        saveButton: TButton;
        cancelButton: TButton;
        procedure descriptionChange(sender: TObject);
        procedure screenSizeChange(sender: TObject);
        procedure screenWidthKeyDown(sender: TObject; var key: Word; shift: TShiftState);
        procedure screenHeightKeyDown(sender: TObject; var key: Word; shift: TShiftState);
        procedure defaultsButtonClick(Sender: TObject);
    public
        procedure setProperties(const place: AnsiString; const description: AnsiString; screenWidth, screenHeight: int);
        function getDescription(): AnsiString;
        function getScreenWidth(): int;
        function getScreenHeight(): int;
    end;
{%endregion}

implementation

{$R *.LFM}

{%region TProgrammePropertiesForm }
    procedure TProgrammePropertiesForm.descriptionChange(sender: TObject);
    var
        s: UnicodeString;
        i: int;
    begin
        s := toUTF16String(description.text);
        for i := length(s) downto 1 do begin
            if s[i] < #$0020 then begin
                delete(s, i, 1);
            end;
        end;
        description.text := toUTF8String(s);
        descriptionRemaining.caption := 'Осталось символов: ' + toDecString(long(description.maxLength) - long(length(s)));
    end;

    procedure TProgrammePropertiesForm.screenSizeChange(sender: TObject);
    var
        s: AnsiString;
        i: int;
    begin
        s := TEdit(sender).text;
        for i := length(s) downto 1 do begin
            if not (s[i] in ['0'..'9']) then begin
                delete(s, i, 1);
            end;
        end;
        TEdit(sender).text := s;
    end;

    procedure TProgrammePropertiesForm.screenWidthKeyDown(sender: TObject; var key: Word; shift: TShiftState);
    begin
        if (key = VK_UP) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
            with screenWidthCounter do begin
                if position < max then begin
                    position := short(position + 1);
                end;
            end;
            key := 0;
            exit;
        end;
        if (key = VK_DOWN) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
            with screenWidthCounter do begin
                if position > min then begin
                    position := short(position - 1);
                end;
            end;
            key := 0;
            exit;
        end;
    end;

    procedure TProgrammePropertiesForm.screenHeightKeyDown(sender: TObject; var key: Word; shift: TShiftState);
    begin
        if (key = VK_UP) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
            with screenHeightCounter do begin
                if position < max then begin
                    position := short(position + 1);
                end;
            end;
            key := 0;
            exit;
        end;
        if (key = VK_DOWN) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
            with screenHeightCounter do begin
                if position > min then begin
                    position := short(position - 1);
                end;
            end;
            key := 0;
            exit;
        end;
    end;

    procedure TProgrammePropertiesForm.defaultsButtonClick(Sender: TObject);
    begin
        screenWidthCounter.position := DEFAULT_SCREEN_WIDTH;
        screenHeightCounter.position := DEFAULT_SCREEN_HEIGHT;
    end;

    procedure TProgrammePropertiesForm.setProperties(const place: AnsiString; const description: AnsiString; screenWidth, screenHeight: int);
    begin
        self.place.text := place;
        self.description.text := description;
        self.screenWidthCounter.position := screenWidth;
        self.screenHeightCounter.position := screenHeight;
        descriptionChange(self.description);
    end;

    function TProgrammePropertiesForm.getDescription(): AnsiString;
    begin
        result := description.text;
    end;

    function TProgrammePropertiesForm.getScreenWidth(): int;
    begin
        result := screenWidthCounter.position;
    end;

    function TProgrammePropertiesForm.getScreenHeight(): int;
    begin
        result := screenHeightCounter.position;
    end;
{%endregion}

end.