MaratBest

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 все работает !!! вопрос у меня был "не является ли это большим костылем " может кто подскажет поизящнее код

виртуальное устройство создаю

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

Делаю свою клавиатуру. не знаю правильно ли делаю, но выбрал такой путь. на форме допустим 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'; буду отсылать своей процедуре код нажатой клавиши

InputQuery подразумевает всегда какой-то диалог , мне нужно без него

огромное спасибо !!! именно то что нужно !!!!

Добрый день !!! может у кого есть пример как проиграть буфер на 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;

На форме сеть куча ListBox, ListView, Memo,ItemListBox они все до безобразия белые как поменять их цвет допустим на черный?

Задача получить нажатый символ (или код символа) на виртуальной клавиатуре! D10, android. Для примера. есть форма, есть кнопка , при нажатии выводим виртуальную клавиатуру, указываем вывод на form1 (или edit, memo) Keyboard.ShowVirtualKeyboard(memo1); как получить нажатый символ ? или я туплю..... или ...хз всю голову сломал думал через Edit сделать Edit1KeyDown, но там Key всегда 0 если цифры, коды если только служебные клавиши, на символы вообще не реагирует думаю сеть простой способ ?

Спасибо за ответ. вынес все вроде как нужно 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 в половинчатом состоянии ... печалька попробую

Всем большое спасибо за ответы !!! 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;

СПАСИБО ОГРОМНОЕ ! действительно не стояло разрешения read phone state

Добрый день !!! столкнулся с такой проблемой. 10.1 Berlin, приложение под Android в качестве девайса для проверки использовал эмулятор BlueStacks, все прекрасно работало... вот решил проверить свое творение на реальном устройстве, телефоне Philips, при запуске выходит ошибка приложения, хотя на BlueStacks все работает далее меняю Release на Debug и о чудо, на телефоне Philips все запускается ... каким образом можно отловить ошибку которая мешает запускаться в режиме release ?

Brovin Yaroslav Спасибо большое !!!! разобрался !