Перейти к содержанию
Fire Monkey от А до Я

Alexey Lovchikov

Пользователи
 Профиль  Обзор контента

  • Постов

    37

  • Зарегистрирован

  • Посещение

  • Победитель дней

    6

 Тип контента 

Сообщения, опубликованные Alexey Lovchikov

    Доработка компонента для чтения штрих-кодов под RAD XE7

    в Разработка компонентов

    Опубликовано

     

    Написал небольшой класс по работе с сканером 

     

    Проверял на XE7 Update 1 под Android 4.1.2

     

    Пример

    Алексей, спасибо Вам большое!!! Но к сожелению на моём Sony Xperia Z1 Android 4.4.4 не работает, компилируется, запускается

    но висит после нажатия на кнопку,

    может у Вас есть соображения почему это может быть?

     

     

    Решение простое, проверь у себя наличия программы https://play.google.com/store/apps/details?id=com.google.zxing.client.android&hl=ru

    так как мой пример и предыдущий класс использует эту программу для считывания штрихкода

        intent := TJIntent.Create;
    intent.setAction(StringToJString('com.google.zxing.client.android.SCAN'));
    SharedActivity.startActivityForResult(intent, 0);

    Проверял у себя на Android 4.4.2, программа в начале не была установлена и симптомы были как у тебя, после установки все стало нормально, на многих устройствах эта программа уже предустановлена

    Помощь новичку

    в Прочие вопросы

    Опубликовано

    Во вложении пример скрещивания VCL и FMX 

     

    Пример работает без установки каких либо других компонентов 

     

    Источники которыми я пользовался для создания примера 

    http://parnassus.co/tfiremonkeycontainer-a-vcl-control-for-mixing-vcl-and-fmx/

    http://firemonkey-container.googlecode.com/svn/trunk/FMXContainer.pas

    https://code.google.com/p/delphisorcery/source/browse/trunk/Source/Windows/DSharp.Windows.FMXAdapter.pas

     

    Пример

    FMXandVCL.zip

    Delphi XE7: Программно проверить root права. [Android]

    в Прочие вопросы

    Опубликовано

    А почему бы просто не пробовать изменять эти некоторые файлы в try except. В случае вылета ексепшена обрабатывать его и выдавать сообщение вроде "Отсутствуют права доступа на запись в файл так как нет Root прав"

    [TEdit] [Android] Как сделать TEdit в Android полностью прозрачным?

    в TEdit

    Опубликовано

    На самом деле все просто, при Edit Default Style, на форме создается StyleBook с стилем EditStyle, который перекрывает стандартный стиль всех TEdit.

     

    post-749-0-20316700-1422762930.png

     

    Если ты его переименуешь (Свойство StyleName) например в MyStyleEdit, то этот стиль будет только на тех TEdit, где ты его сам установишь. Если ты хочешь поменять стиль конкретно одного элемента, то используй Edit Custom Style, при этом будет создан стиль с именем отличном от имени стиля по умолчанию 

     

    Для удаления элемента стиля в StyleBook используй кнопку удаления как показано на скиншоте

     

    post-749-0-63116700-1422764184.png

    Можно ли программно передать фокус на SearchBox и очистить строку?

    в TListView

    Опубликовано

    Используй Helper

    uses
  FMX.SearchBox;


type
  TListViewMyHelper = class helper for TListView
  public
    function SearshBox: TSearchBox;
  end;


{ TListViewMyHelper }


function TListViewMyHelper.SearshBox: TSearchBox;
var
  AIdx: Integer;
begin
  for AIdx := 0 to Self.ComponentCount - 1 do
    if Self.Components[AIdx] is TSearchBox then
    begin
      Result := TSearchBox(Self.Components[AIdx]);
      Break;
    end;
end;

    Или просто функцию 

    function SearshBox(AListView: TListView): TSearchBox;
var
  AIdx: Integer;
begin
  for AIdx := 0 to AListView.ComponentCount - 1 do
    if AListView.Components[AIdx] is TSearchBox then
    begin
      Result := TSearchBox(AListView.Components[AIdx]);
      Break;
    end;
end;

     

    Primer.zip

    [Android] [TFrame] Ошибка при динамическом удалении/создании фреймов

    в Консультации

    Опубликовано

    Мне по любому нужно эту ошибку обойти каким нибудь способом. Если я решу эту проблему сразу отпишусь

    Проверь у себя

    я определил константу FrameOrder которая отвечает за порядок переключения фреймов

    const
  FrameOrder: array[0..2] of TFrameClass = (TframeRegUser, TframeSetUser, TframeAuthUser);

    На кнопки далее и назад 

    procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
  SetFrame(IfThen(fCurrentFrameIndex = 0, 2, fCurrentFrameIndex - 1));
end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
begin
  SetFrame(IfThen(fCurrentFrameIndex = 2, 0, fCurrentFrameIndex + 1));
end;

    Изменил SetFrame, добавил пример получения данных с фрейм по одному имени стиля, то есть в хедер main формы передаю значение с lable фрейма

    procedure TfrmMain.SetFrame(AFrameIndex: Integer);
var
  ALbl: TLabel;
begin
  fCurrentFrameIndex := AFrameIndex;

  ALbl := TLabel(ActiveFrame(FrameOrder[fCurrentFrameIndex], true).FindStyleResource('description'));

  if ALbl <> nil then
    lbHeaderText.Text := ALbl.Text;
end;

    изменил ControlsResetFocus, убрал скрытие клавиатуры

    procedure ControlsResetFocus(Control: TControl);

  procedure ResetFocus(SubControl: TControl);
  var
    AIdx: Integer;
    AControl: TControl;
  begin
    for AIdx := 0 to SubControl.ChildrenCount - 1 do
      if SubControl.Children.Items[AIdx] is TControl then
      begin
        AControl := SubControl.Children.Items[AIdx] as TControl;
        AControl.ResetFocus;

        if AControl.ChildrenCount > 0 then
           ResetFocus(AControl);
      end;

    SubControl.ResetFocus;
  end;

begin
  ResetFocus(Control);
end;

    AndroidFramesTest.zip

    [Android] [TFrame] Ошибка при динамическом удалении/создании фреймов

    в Консультации

    Опубликовано

    Подправил твою программу

     procedure ControlsResetFocus(Control: TControl); procedure ResetFocus(SubControl: TControl); var AIdx: Integer; AControl: TControl; begin for AIdx := 0 to SubControl.ChildrenCount - 1 do if SubControl.Children.Items[AIdx] is TControl then begin AControl := SubControl.Children.Items[AIdx] as TControl; AControl.ResetFocus; if AControl.ChildrenCount > 0 then ResetFocus(AControl); end; SubControl.ResetFocus; end; begin KeyboardHide; if Control <> nil then ResetFocus(Control); end;

    добавил проверку на nil в процедуре ControlsResetFocus

     if Control <> nil then ResetFocus(Control);

    Хотя, все равно через раз появляется ошибка

    Нужно ждать фикс

    [TWebBrowser] Как отловить событие выполнения JavaScript?

    в Javascript

    Опубликовано

    Как отловить событие выполнения JavaScript, например событие console.log, чтоб инициировать выполнение delphi логики

    Задача заключается в организации взаимодействия delphi кода с TWebBrowser и обратно. Необходимо при нажатии кнопки html страницы выполнять код delphi

    [Android] [TFrame] Ошибка при динамическом удалении/создании фреймов

    в Консультации

    Опубликовано

    Как я понял проблема возникает если при удалении фрейма когда у одного из элементов ввода данных стоит фокус. 

    Я решил эту проблему следующим способом.

     

    Моя функция может переключать на следующий фрейм двумя способами. Первый с очищением из памяти старого фрейм, второй без очистки, это удобно когда необходимо вызвать какой нибудь маленький фрейм и при этом, чтоб данные предыдущего фрейм не потерялись. Я например использую вызов фрейм настройки и обновление конфигурации вторым способом

     

    При переключении на новый фрейм я вначале делаю очистку активного фокуса текущего фрейм (необходимо если используется переключение без очистки предыдущего фрейм) и очистку фокуса старого фрейм при помощи процедуры ControlsResetFocus, ее тело описано ниже

    function TfmMain.ActiveFrame(AFrameClass: TFrameClass; ADisposePrevFrame: Boolean): TFrame;
var
  AFrame: TFrame;
  AIdx: Integer;
begin

  if FFrame <> nil then
  begin
    //Сбрасываем форкус элементов текущего активного фрейма
    ControlsResetFocus(FFrame);

    //Если новый фрейм отличается от текущего
    if FFrame.ClassType <> AFrameClass then
      //Ишем старые фреймы созданные от этого класса для очистки
      for AIdx := 0 to ComponentCount - 1 do
      begin
        if Components[AIdx].ClassType = AFrameClass then
        begin
          AFrame := TFrame(Components[AIdx]);

          //Сбрасываем форкус элементов старого фрейма
          ControlsResetFocus(AFrame);

          //Освобождаем старый фрейм из памяти
          AFrame.Parent := nil;
          AFrame.DisposeOf;
          AFrame := nil;

          Break;
        end;
      end;
  end;

  if ADisposePrevFrame then
  begin
    if FFrame <> nil then
    begin
      FFrame.DisposeOf;
      FFrame := nil;
    end;

    FFrame := AFrameClass.Create(Self);
    FFrame.Parent := Self;
    FFrame.Align := TAlignLayout.Client;

    Result := FFrame;
  end
  else
  begin
    Result := AFrameClass.Create(Self);
    Result.Parent := Self;
    Result.Align := TAlignLayout.Client;
  end;

  mvMenu.HideMaster;

  Application.ProcessMessages;
end;

    unit uFunctions;

interface

uses
  FMX.Controls, FMX.Edit;

  procedure KeyboardHide;
  procedure KeyboardShow(AEdit: TEdit);

  procedure ControlsResetFocus(Control: TControl);

implementation

uses
  FMX.Platform, FMX.VirtualKeyboard;

procedure KeyboardHide;
var
  KeyboardService: IFMXVirtualKeyboardService;
begin
  // Запрашиваем сервис виртуальной клавиатуры
  if TPlatformServices.Current.SupportsPlatformService(IFMXVirtualKeyboardService, IInterface(KeyboardService)) then
    KeyboardService.HideVirtualKeyboard;
end;

procedure KeyboardShow(AEdit: TEdit);
var
  KeyboardService: IFMXVirtualKeyboardService;
begin
  // Запрашиваем сервис виртуальной клавиатуры
  if TPlatformServices.Current.SupportsPlatformService(IFMXVirtualKeyboardService, IInterface(KeyboardService)) then
    KeyboardService.ShowVirtualKeyboard(AEdit);
end;

procedure ControlsResetFocus(Control: TControl);

  procedure ResetFocus(SubControl: TControl);
  var
    AIdx: Integer;
    AControl: TControl;
  begin
    for AIdx := 0 to SubControl.ChildrenCount - 1 do
      if SubControl.Children.Items[AIdx] is TControl then
      begin
        AControl := SubControl.Children.Items[AIdx] as TControl;
        AControl.ResetFocus;

        if AControl.ChildrenCount > 0 then
           ResetFocus(AControl);
      end;

    SubControl.ResetFocus;
  end;

begin
  KeyboardHide;
  ResetFocus(Control);
end;

end.

    Ниже приведен код очистки фреймов "Настройка" и "Обновление конфигурации" из памяти 

     

    Настройка

    procedure TfrOptions.SaveClick(Sender: TObject);
begin
  with fmMain do
  begin
    Options.UrlServer := edUrlServer.Text;
    Options.Save;

    ControlsResetFocus(Self);
    Self.Parent := nil;
    Self.DisposeOf;
  end;
end;

    Обновление конфигурации 

    procedure TfrLogin.StartUpdateCfgClick(Sender: TObject);
var
  AFrame: TfrUpdateCfg;
  AStatus: TfrUpdateCfgStatus;
begin
  with dmMainModule, fmMain do
  begin
    AStatus := ucsEndNormal;

    if InetConnectState then
    begin
      AFrame := TfrUpdateCfg(ActiveFrame(TfrUpdateCfg, False));
      AStatus := AFrame.Start;

      ControlsResetFocus(AFrame);
      AFrame.Parent := nil;
      AFrame.DisposeOf;
      AFrame := nil;
    end;

....

    Как получить доступ к наследнику TListBoxItem при вызове события из стиля

    в StylesData

    Опубликовано

    Ну вот, отвечаю опять на свой вопрос сам.

    procedure TfrJournalQuestionnaire.ClickQuestionnaireEdit(Sender: TObject);

  function GetItem(AControl: TControl): TQuestionnaireItem;
  begin
    while not (AControl.Parent is TQuestionnaireItem) do
      AControl := TControl(AControl.Parent);

    Result := TQuestionnaireItem(AControl.Parent);
  end;

begin
  ShowMessage(
    GetItem(TControl(Sender)).QuestionnaireId.ToString
  );
end;

    Как получить доступ к наследнику TListBoxItem при вызове события из стиля

    в StylesData

    Опубликовано

    Здравствуйте,

     

    Есть следующий класс, наследник от TListBoxItem и свой стиль questionnaireitem

    TQuestionnaireItem = class(TListBoxItem)
  private
    FQuestionnaireId: Integer;
    procedure SetDozsait(const Value: string);
    procedure SetOnEditClick(const Value: TNotifyEvent);
    procedure SetOnDeleteClick(const Value: TNotifyEvent);
  public
    constructor Create(AOwner: TComponent); override;
    property QuestionnaireId: Integer read FQuestionnaireId write FQuestionnaireId;
    property Dozsait: string write SetDozsait;
    property OnEditClick: TNotifyEvent write SetOnEditClick;
    property OnDeleteClick: TNotifyEvent write SetOnDeleteClick;
  end;

{ TQuestionnaireItem }

constructor TQuestionnaireItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StyleLookup := 'questionnaireitem';
  Height := 220;
end;

procedure TQuestionnaireItem.SetDozsait(const Value: string);
begin
  Self.StylesData['lbdozsait.Text'] := Value;
end;

procedure TQuestionnaireItem.SetOnDeleteClick(const Value: TNotifyEvent);
begin
  Self.StylesData['btdelete.OnClick'] := TValue.From<TNotifyEvent>(Value);
end;

procedure TQuestionnaireItem.SetOnEditClick(const Value: TNotifyEvent);
begin
  Self.StylesData['btedit.OnClick'] := TValue.From<TNotifyEvent>(Value);
end;

    В стиле questionnaireitem есть две кнопки событие которых присваивается через OnDeleteClick и OnEditClick

     

    Ниже пример построения элементов 

    procedure TfrJournalQuestionnaire.InitList;
var
  Index: Integer;
  AItem: TQuestionnaireItem;
begin
  lbJournalQuestionnaire.Items.Clear;

  for Index := 1 to 5 do
  begin
    AItem := TQuestionnaireItem.Create(lbJournalQuestionnaire);
    AItem.QuestionnaireId := Index;
    AItem.Dozsait := 'Дозорый сайт '+ Index.ToString;
    AItem.OnEditClick := ClickQuestionnaireEdit;
    AItem.OnDeleteClick := ClickQuestionnaireDelete;

    lbJournalQuestionnaire.AddObject(AItem);
  end;
end;

    Визуально выглядит так

     

     post-749-0-09248400-1420649642.png

     
    На событие клика кнопки присваиваются процедуры  ClickQuestionnaireEdit и ClickQuestionnaireDelete
     
    Теперь вопрос, как получить из процедур ClickQuestionnaireEdit и ClickQuestionnaireDelete объект TQuestionnaireItem, необходимо получить значение свойств QuestionnaireId и Dozsait
    У процедур есть Sender но это ссылка на кнопку стиля
×
×
  • Создать...