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

MaratBest

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

  • Постов

    23

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

  • Посещение

 Тип контента 

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

    Регистрация в системе и открытие своего произвольного файла. FMX Android

    в Работа с файловой системой

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

    23 часа назад, OnePeople сказал:
    Цитата

    Для начала доступ к памяти проверьте

     доступ вроде есть, у меня там встроенный opendialog есть, он работает 

    Ну и android 13 поддерживает только Rad studio 11.3

    у меня , просто delphi 11.3 а не Rad Studio -(

    где можно раздобыть TJEnvironment и TJSettings из Rad Studio?

    Регистрация в системе и открытие своего произвольного файла. FMX Android

    в Работа с файловой системой

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

    Добрый день.

    чуть-чуть поторопился...

    Вначале промучился с ошибкой  I/O Error 13 при попытке чтения файла

    оказалось insPath содержит полный путь "root/storage/emulated/0/файл" системе в итоге зашло без рут "/storage/emulated/0/файл"

     это все зработало на планшете , где андроид 8.0

    на телефоне где android 13 , 

    procedure TMainForm.FormCreate(Sender: TObject);
var
...
begin
IMessageSubscriptionID := TMessageManager.DefaultManager.SubscribeToMessage(TMessageReceivedNotification, HandleIntentMessage);
logSave('IMessageSubscriptionID :='+inttostr(IMessageSubscriptionID));

    тут выходит значение IMessageSubscriptionID =327

    и тишина, в логе нет  ни единого сообщения , в какую сторону копать ?

    Регистрация в системе и открытие своего произвольного файла. FMX Android

    в Работа с файловой системой

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

    Спаcибо за ответ.

    поменял манифест, приложение попадает выбор открыть с помощью в андроид !

    а вот в приложениее не перехватывает сообщение

    подставил в свой код 

    procedure TMainForm.FormCreate(Sender: TObject);
var
...
begin
IMessageSubscriptionID := TMessageManager.DefaultManager.SubscribeToMessage(TMessageReceivedNotification, HandleIntentMessage);
logSave('IMessageSubscriptionID :='+inttostr(IMessageSubscriptionID));

    тут выходит значение IMessageSubscriptionID =327 

    procedure TMainForm.HandleIntentMessage(const Sender: TObject;  const M: TMessage);
begin
 try
  logSave('HandleIntentMessage');
  if M is TMessageReceivedNotification then
      begin
           logSave('HandleIntentMessage');
           OnNewIntent(TMessageReceivedNotification(M).Value);
      end;
 except
    logSave('HandleIntentMessage except');
 end;
end;

function TMainForm.OnNewIntent(Intent: JIntent): Boolean;
var
  insPath: String;
  uri: Jnet_Uri;
begin
  Result := False;
  try
    if Intent <> nil then
    begin
      uri := Intent.getData;
      if uri <> nil then
        begin
          insPath:= JStringToString( uri.getEncodedPath);
          logSave('Работаем с файлом:'+insPath);
          if (ExtractFileExt(insPath)='.x10') then
             begin
               logSave('Работаем с файлом:'+insPath);
               // работаете с файлом
             end;
        end;
    end;
  except
    logSave('OnNewIntent except');
  end;
end;

    в логе нет  ни единого сообщения

    Регистрация в системе и открытие своего произвольного файла. FMX Android

    в Работа с файловой системой

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

    Доброго времени суток.

    Написано приложение Delphi 11 для Android. На данный момент появилась необходимость открывать файлы формата *.х10

    как зарегистрировать на андроид при установке приложения, что с помощью него можно отрывать файлы *.х10

    (аналог,например при открытии *.pdf давал на выбор acrobat, chrome и т.д)

    и второй вопрос ,как понять что приложению передан файл на открытие ? типа paramstr или как ?

     

    Программное нажатие кнопки пока не отпущен палец.

    в TButton

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

    53 минуты назад, Rusland сказал:

    У меня этот ^^^ код ругается. При старте выдает Project raised exception class EReadError with message 'Invalid property value'.
      

    type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure ButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
      procedure KeyDown(NUM: Byte);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.ButtonMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
KeyDown(TControl(Sender).Tag);
timer1.Tag:=TControl(Sender).Tag;
Timer1.Enabled:=true;
end;

procedure TForm1.ButtonMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
Timer1.Enabled:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
KeyDown(Timer1.tag);
end;

procedure TForm1.KeyDown(NUM: Byte);
begin
case NUM  of
  1: label1.text:=label1.text+'нажата 1';
  2: label1.text:=label1.text+'нажата 2';
  3: label1.text:=label1.text+'нажата 3';
end;
end;

end.

    на форме 3 TButton. свойство  tag от 1 до 3 соотвественно
     всем 3 кнопкам устанавливаю OnMouseDown =ButtonMouseDown

    OnMouseUp =ButtonMouseUp

    все работает !!!

    вопрос у меня был  "не является ли это большим костылем "

    может кто подскажет поизящнее код 

    Программное нажатие кнопки пока не отпущен палец.

    в TButton

    Опубликовано · Изменено пользователем MaratBest

    Делаю свою клавиатуру. 
    не знаю правильно ли делаю, но выбрал такой путь.
    на форме допустим 10 TButton. tag от 1 до 10 соотвественно
    создаю процедуру , всем 10 кнопкам устанавливаю ее на OnMouseDown 

    ButtonMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single); 
begin

KeyDown(TControl(Sender).Tag);
timer1.Tag:=TControl(Sender).Tag;
Timer1.Enabled:=true; 
end;

    на OnMouseUp  такой код(всем кнопкам) 

    ButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
 Timer1.Enabled:=false;
end;


    обработка таймера (interval 500) 

    procedure TForm1.Timer1Timer(Sender: TObject);
begin
KeyDown(Timer1.tag);
end;
    procedure TForm1.KeyDown(NUM: Byte);
begin
case NUM  of
  1: label1.text:=label1.text+'нажата 1';
  2: label1.text:=label1.text+'нажата 2';
  3: label1.text:=label1.text+'нажата 3';
   ...
end;

    не является ли это большим костылем ? там где label1.text:=label1.text+'нажата 1'; буду отсылать своей процедуре код нажатой клавиши

    Проиграть данные с буфера. Аналог WaveOutWrite для Android

    в Работа с медиа файлами (аудио, видео)

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

    Добрый день !!!

    может у кого есть пример как проиграть буфер на android устройстве ?  

    на windows делал через 

    procedure TMainFormEmu.PlayBuffer(Buffer: array of byte);  //процедура проигрывает буфер

begin
 with header do
   begin
     wFormatTag := WAVE_FORMAT_PCM;  // формат РСМ
     nChannels := 1;    // моно
     nSamplesPerSec := 44100;  // частота дискретитатции 44.1 Кгц
     wBitsPerSample := 8; // выборка 8 бит
     nBlockAlign := nChannels * (wBitsPerSample div 8);
     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
     cbSize := 0;
   end;
// if Opened = true then stopPlay;
   hEvent:=CreateEvent(nil,false,false,nil);
   if WaveOutOpen(addr(waveOut), 0, @header, hEvent, 0, CALLBACK_WINDOW) <> MMSYSERR_NOERROR then
      begin
        CloseHandle(hEvent);
        Exit;
      end;
   pBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, length(Buffer));
   pBuffer := GlobalLock(pBuf);
   with outHdr do
     begin
      lpData := PBuffer;
      dwBufferLength := length(Buffer);
      dwUser := 0;
      dwFlags := 0;
      dwLoops := 0
     end;
   err:= WaveOutPrepareHeader(waveOut, @outHdr, sizeof(outHdr));
   if Err <> 0 then Exit;
   copyMemory(pBuffer, @Buffer, length(Buffer));

   err:= WaveOutWrite(waveOut, @outHdr, sizeof(outHdr));
   if Err <> 0 then Exit;

   waveOutReset(waveOut);
   waveOutUnprepareHeader(waveOut,@outHdr,sizeof(wavehdr));
   waveOutClose(waveOut); 
end;

     

    Как получить от виртуальной клавиатуры символ который был введен?

    в Виртуальная клавиатура

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

    Задача получить нажатый символ (или код символа) на виртуальной клавиатуре!

    D10, android.

    Для примера. есть форма, есть кнопка , при нажатии выводим виртуальную клавиатуру, указываем вывод на form1 (или edit, memo)

    Keyboard.ShowVirtualKeyboard(memo1);

    как получить нажатый символ ? или я туплю..... или ...хз

    всю голову сломал

    думал через Edit сделать Edit1KeyDown, но там Key всегда 0 если цифры, коды если только служебные клавиши, на символы вообще не реагирует

    думаю сеть простой способ ?

     

     

     

    Надолго зависает код при загрузке из интернета

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

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

    2 часа назад, krapotkin сказал:

    действия с визуальными компонентами должны быть в Synchronize как тут и написано, а это не так

    7 часов назад, MaratBest сказал:

    image1.Bitmap.LoadFromStream(MS);

     

    7 часов назад, MaratBest сказал:

    memo1.Lines.Text:=LoadWebText('http://google/text.php');

    Спасибо за ответ.

    вынес все вроде как нужно 

    procedure TForm1.Button1Click(Sender: TObject);
var
MStext:string;
begin
AniIndicator1.Enabled:=true;
label1.Text:='Загрузка ...';
memo1.Lines.Clear;
TTask.Run(
     procedure
     function LoadWebText(const URL: string): string;
       var
       MS: TStringStream;
       Http: THTTPClient;
     begin
        Result := '';
        Http:=THTTPClient.Create;
        MS := TStringStream.Create('', TEncoding.ANSI);
        Http.Get( URL, MS);
        Result := MS.DataString;
        MS.Free;
        Http.Free;
     end;

     begin
        MStext:=LoadWebText('https://hi-tech.mail.ru/news/samsung-galaxy-s8-photo/?frommail=1');
        TThread.Synchronize(nil, procedure
           begin
              // выполняем действия связанные с визуальными компонентами
              memo1.Lines.Text:=MStext;
              AniIndicator1.Enabled:=False;
           end);
     end);
   label1.Text:='';
end;

    на win 32 код работает на ура !

    на устройствах AniIndicator сперва запускается , через секунду зависает , запрос возвращается 

    AniIndicator в половинчатом состоянии ... печалька

    попробую 

    2 часа назад, krapotkin сказал:

    Чтобы упростить отладку, я бы все-таки поступил олдскульно. Создал бы потомка TThread и там метод Execute все как положено. При выходе из потока нужно кинуть обработчик TMyThread.OnTerminate и там уже выполнять все работы с визуальными компонентами

    Для первичной отладки я обычно создаю объект этого класса , но не стартую поток. а просто выполняю Execute
    если все идет нормально, заменяю MyThread.Execute на MyThread.Start ...

     

    Надолго зависает код при загрузке из интернета

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

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

    Всем большое спасибо за ответы !!! 

    procedure TForm1.Button1Click(Sender: TObject);
begin
TTask.Run(
     procedure
     function LoadWebText(const URL: string): string;
       var
       MS: TStringStream;
       Return: IHTTPResponse;
     begin
      Result := '';
     with TNetHTTPClient.Create(nil) do
       begin
        MS := TStringStream.Create('', TEncoding.ANSI);
        Return := Get( URL, MS);
        Result := MS.DataString;
        MS.Free;
        Free;
       end;
     end;
     PROCEDURE LoadWebImage(URL: string) ;
       var
        IdHTTP: TNetHTTPClient;
        ms : TMemoryStream;
        begin
         IdHTTP := TNetHTTPClient.Create(nil);
         MS := TMemoryStream.Create;
         try
         idhttp.Get (URL, MS);
         MS.Position := 0;
         image1.Bitmap.LoadFromStream(MS);
         finally
         idhttp.Free;
         MS.FREE;
        end;
       enD;

     begin
        memo1.Lines.Text:=LoadWebText('http://google/text.php');
        LoadWebImage('http://google/screen1.png');
        // выполняем загрузку файла из интернета;

        TThread.Synchronize(nil, procedure
           begin
              // выполняем действия связанные с визуальными компонентами
              label1.Text:='Загрузка списка игр с сайта';
              label1.Repaint;
           end);
end);

   label1.Text:='';
end;

    Заменил  TNetHTTPClient  и пробую через поток

    в итоге image1 пустой, label1 надпись просто очищается и все 

    при запуске в win32 при первом запуске в image1 какой то мусор, второй раз картинка грузится 

    что делаю не так.....

    Надолго зависает код при загрузке из интернета

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

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

    Добрый день !!!

    есть вот такой код для загрузки текста с сайта и картинок.

    Является ли это оптимальным кодом , или же есть проще код ?

    после нажатии кнопки приложение зависает, довольно на долго ,

    на реальном устройстве, иногда android выдает что программа зависла, и спрашивает зарыть приложение или нет.

    может нужно в поток сделать ? 

    procedure TForm.Button3Click(Sender: TObject);   
procedure LoadWebImage(url: string; image : TBitmap);
var
  idhttp : TIdHTTP;
  ms : TMemoryStream;
begin
  IdHTTP := TIdHTTP.Create(nil);
  ms := TMemoryStream.Create;
  try
    idhttp.Get(url, ms);
    ms.Position := 0;
    image.LoadFromStream(ms);
  finally
    ms.Free;
    idhttp.Free;
  end;
end;

procedure LoadWebText(url: string);
var
  idhttp : TIdHTTP;
  ms : TMemoryStream;
begin
  IdHTTP := TIdHTTP.Create(nil);
  ms := TMemoryStream.Create;
  try
    idhttp.Get(url, ms);
    ms.Position := 0;
    memo1.Lines.LoadFromStream(ms);
  finally
    ms.Free;
    idhttp.Free;
  end;
end;
begin
   LoadWebText('http://google/text.php');
   LoadWebImage('http://google/screen1.png', image1.Bitmap);
end;

     

    Вылетает приложение для Андроид

    в Отладка

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

    Добрый день !!!

    столкнулся с такой проблемой.

    10.1 Berlin, приложение под Android

    в качестве девайса для проверки использовал эмулятор BlueStacks, все прекрасно работало...

    вот решил проверить свое творение на реальном устройстве, телефоне Philips, при запуске выходит ошибка приложения, хотя на  BlueStacks все работает

    далее меняю Release на Debug  и о чудо, на  телефоне Philips все запускается ...

    каким образом можно отловить ошибку которая мешает запускаться в режиме release ?

    Scanline и Draw под FMX

    в Канва

    Опубликовано · Изменено пользователем MaratBest

    Равиль Зарипов  Спасибо за ответ !!!

    пробую запускать на эмуляторе и на реальном устройстве.
    на экране ничего не происходит после нажатия кнопки

    убирал try finally .... ничего не ломается

    пробовал ImageViewer1.Canvas.DrawBitmap(gamecanvas, gamecanvas.BoundsF, RectF(0, 0, 256, 256), 1);

    тоже тишина, ни каких изменений 

    ANDROID SDK 24.3.3 32BIT

    SDK 24.0.3 API 24

     

    Scanline и Draw под FMX

    в Канва

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

    Добрый день !!!

    есть такая задача перенести один проект на Android платформу.

    код для VCL  

    type
TRGB = record
   b, g, r: byte;
end;
ARGB = array[0..1] of TRGB;
PARGB = ^ARGB;

var
  gamecanvas: TBitmap;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j : word;
  p: PARGB;
  x, y: integer;
begin
  i:=0;
for I := 0 to 255 do
 begin
  p :=gamecanvas.scanline[i];
  for J := 0 to 255 do
      begin
         p[j].r := Random(255);
         p[j].g := Random(255);
         p[j].b := Random(255);
      end;
  end;
  Form1.Canvas.Draw(0,0, gamecanvas);
  end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 gamecanvas:=tbitmap.Create;
 gamecanvas.pixelformat := pf24bit;
 gamecanvas.Width:=256;
 gamecanvas.Height:=256;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
   gamecanvas.Free;
end;

    как максимально (по быстроте выполнения) перенести его на FMX firemonkey

    есть ли пример работы со scanline ?

    Form1.Canvas.Draw(0,0, gamecanvas); ?

     

×
×
  • Создать...