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

Sashar333

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

  • Постов

    108

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

  • Посещение

 Тип контента 

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

    Как масштабировать Bitmap на смартфоне?

    в Доступ к пикселям

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

    3 часа назад, MAD_EVAL сказал:

    Смею предположить что всему виной DPI, скорее всего надо узнать его значение и учесть в расчёте

    На новой форме с такой же процедурой рисует так как надо!?

    Уже и все остальные картинки удалил, которые были загружены, логотипы и т.д

    такое ощущение что где-то какие-то настройки сохранились... 

    Как масштабировать Bitmap на смартфоне?

    в Доступ к пикселям

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

    Здравствуйте! Подскажите пожалуйста почему такая в масштабе разница отрисовки в Bitmap.Canvas в Windows и Android, и как ее настроить?

    Windows: image.png.617875e950c8485106f481632242f940.png 

    Android: image.png.d1e3e1d148d4f38c88c06ba8ff219a2d.png 

     

    Дано:

    1. Массив с координатами прямоугольников и их габаритами (миллиметры)

    2. Поле для расположения этих прямоугольников ширина 2000мм длина 6000мм (ширину и длину может менять пользователь но не более этих размеров)

    Задача:

    Вывести в Bitmap на экран это поле с расположенными прямоугольниками

    на картинках "Лист" - это Image

     

    Не могу понять как подогнать Bitmap.size под все экраны

    вот мой код:

    image.png.51ce60538f66dcc6130dd1fb1a47536a.png

    Спасибо за внимание!

    image.png

    image.png

    Требуется приложение на на все смартфоны

    в Ищу подрядчика

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

    Спойлер

     

    procedure bar.Execute;
    var net:TNetHTTPClient;
        tm:string;
    begin
     soed:=1;
     mm:=TStringList.Create;
     mmc:=TStringList.Create;
     mml:=TStringList.Create;
     net:=tnethttpclient.Create(nil);
     mm.LoadFromStream(net.Get('https://www.gector-spb.ru/catalog/').ContentStream,TEncoding.UTF8);
     pbmax:=mm.Count;
     soed:=2;
    while (mm.Count<>0) do
    begin
    if pos('class="catalog"',mm[0])>0 then
     begin
      while (mm.Count<>0) do
       begin
        if pos('div class="header"',mm[0])>0 then
         begin
          mm.Delete(0);
          s:=mm[0];
          delete(s,1,pos('>',s));
          s:=copy(s,0,pos('<',s)-1);
    mmc.Add(s);
    mml.Add('---');
          while (mm.Count<>0)and(pos('</table>',mm[0])=0) do
           begin
            if pos('tr class="cell item',mm[0])>0 then
             begin
              Form1.pb.Value:=100-(round(mm.Count*100/pbmax));

              mm.Delete(0);
              s:=mm[0];
              delete(s,1,pos('a name=',s));
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</a>',s)-1);
              if s=' ' then
               begin
                mm.Delete(0);
                s:=mm[0];
                delete(s,1,pos('</a>',s)+3);
                s:=copy(s,1,pos('</td>',s)-1);
               end;

    mml.Add(s);
              mm.Delete(0);
              s:=mm[0];
              delete(s,1,pos('<strong>',s)+7);
              s:=copy(s,1,pos('</strong>',s)-1);

                tm:='остаток: '+s+'тн';
              mm.Delete(0);
              s:=mm[0];
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</td>',s)-1);

    mml.Add(tm+'   цена: '+s+'руб\тн');

             end;
            mm.Delete(0);
           end;


         end;
        mm.Delete(0);
       end;
     end;
    if mm.Count<>0 then mm.Delete(0);
    end;
     Synchronize(syn);
     soed:=0;
     mm.Free;
     mmc.Free;
     mml.Free;
     terminate;
    end;


    procedure bar.syn;
    var item:TListBoxItem;
        tm:string;
        i,i2:integer;
    begin
    Form1.ListBox1.BeginUpdate;
    for I := 0 to mmc.Count-1 do
    begin
     tm:=mmc;
     Form1.ComboBox1.Items.Add(tm);
    end;

    i:=0;
    i2:=-1;
    while i<(mml.Count-1) do
    begin
     Item:=TListBoxItem.Create(Form1.ListBox1);
     Item.StyleLookup:='listboxitembottomdetail';
     Item.Height:=40;
     if mml='---' then
      begin
      i2:=i2+1;
      i:=i+1;
      end;
     item.TagString:=mmc[i2];
     Item.TextSettings.WordWrap:=true;
     Item.Text:=mml;
     item.ItemData.Detail:=mml[i+1];
     Form1.ListBox1.AddObject(item);
    i:=i+2;
    end;

    Form1.ListBox1.EndUpdate;

    end;

     

     

    Требуется приложение на на все смартфоны

    в Ищу подрядчика

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

    Спойлер

     

    procedure bar.Execute;
    var net:TNetHTTPClient;
    begin
     soed:=1;
     mm:=tmemo.Create(nil);
     net:=tnethttpclient.Create(nil);
     mm.Lines.LoadFromStream(net.Get('https://www.gector-spb.ru/catalog/').ContentStream,TEncoding.UTF8);
     pbmax:=mm.Lines.Count;
     soed:=2;

      while (mm.Lines.Count<>0) do
    begin
    if pos('class="catalog"',mm.Lines[0])>0 then
     begin
      while (mm.Lines.Count<>0) do
       begin
        if pos('div class="header"',mm.Lines[0])>0 then
         begin
          mm.Lines.Delete(0);
          s:=mm.Lines[0];
          delete(s,1,pos('>',s));
          s:=copy(s,0,pos('<',s)-1);
          tgs:=s;

              Synchronize(syn);

         end;
        mm.Lines.Delete(0);
       end;
     end;
    if mm.Lines.Count<>0 then mm.Lines.Delete(0);
    end;
     soed:=0;
     terminate;
    end;


    procedure bar.syn;
    var item:TListBoxItem;
    begin
          Form1.ComboBox1.Items.Add(s);
          Form1.ComboBox1.ListItems[0].TextSettings.FontColor := TAlphaColorRec.White;
          while (mm.Lines.Count<>0)and(pos('</table>',mm.Lines[0])=0) do
           begin
            if pos('tr class="cell item',mm.Lines[0])>0 then
             begin
              Form1.pb.Value:=100-(round(mm.Lines.Count*100/pbmax));
              Form1.ListBox1.BeginUpdate;
              Item:=TListBoxItem.Create(Form1.ListBox1);
              Item.StyleLookup:='listboxitembottomdetail';
              Item.Height:=40;
              item.TagString:=tgs;
              Item.TextSettings.WordWrap:=true;
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('a name=',s));
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</a>',s)-1);
              if s=' ' then
               begin
                mm.Lines.Delete(0);
                s:=mm.Lines[0];
                delete(s,1,pos('</a>',s)+3);
                s:=copy(s,1,pos('</td>',s)-1);
               end;
              Item.Text:=s;
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('<strong>',s)+7);
              s:=copy(s,1,pos('</strong>',s)-1);
              item.ItemData.Detail:='остаток: '+s+'тн';
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</td>',s)-1);
              item.ItemData.Detail:=item.ItemData.Detail+'   цена: '+s+'руб\тн';
              Form1.ListBox1.AddObject(item);
              Form1.ListBox1.EndUpdate;
             end;
            mm.Lines.Delete(0);
           end;
    end;

     

     

    Требуется приложение на на все смартфоны

    в Ищу подрядчика

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

    пример кода:

    Спойлер

     

    unit Unit1;

    interface

    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
      FMX.Layouts, System.ImageList, FMX.ImgList, FMX.Controls.Presentation,
      FMX.StdCtrls, FMX.TabControl, FMX.Edit, FMX.ScrollBox, FMX.Memo, FMX.Ani,
      FMX.DateTimeCtrls, FMX.ListBox, FireDAC.Stan.Intf, FireDAC.Comp.BatchMove,
      FireDAC.Comp.BatchMove.Text, System.Net.URLClient, System.Net.HttpClient,
      System.Net.HttpClientComponent;

    type
      TForm1 = class(TForm)
        Layout1: TLayout;
        GridPanelLayout1: TGridPanelLayout;
        TabControl1: TTabControl;
        TabItem1: TTabItem;
        TabItem2: TTabItem;
        TabItem3: TTabItem;
        TabItem5: TTabItem;
        TabItem6: TTabItem;
        GridPanelLayout2: TGridPanelLayout;
        ImageList1: TImageList;
        GridPanelLayout3: TGridPanelLayout;
        CornerButton2: TCornerButton;
        CornerButton3: TCornerButton;
        CornerButton4: TCornerButton;
        CornerButton5: TCornerButton;
        CornerButton6: TCornerButton;
        GridPanelLayout5: TGridPanelLayout;
        GridPanelLayout6: TGridPanelLayout;
        CornerButton7: TCornerButton;
        GridPanelLayout7: TGridPanelLayout;
        GridPanelLayout8: TGridPanelLayout;
        Text2: TText;
        StyleBook1: TStyleBook;
        CornerButton1: TCornerButton;
        Text4: TText;
        GridPanelLayout9: TGridPanelLayout;
        GridPanelLayout10: TGridPanelLayout;
        CornerButton8: TCornerButton;
        CornerButton9: TCornerButton;
        GridPanelLayout11: TGridPanelLayout;
        GridPanelLayout12: TGridPanelLayout;
        Text3: TText;
        GridPanelLayout15: TGridPanelLayout;
        GridPanelLayout16: TGridPanelLayout;
        CornerButton10: TCornerButton;
        CornerButton11: TCornerButton;
        GridPanelLayout18: TGridPanelLayout;
        GridPanelLayout19: TGridPanelLayout;
        CornerButton12: TCornerButton;
        CornerButton13: TCornerButton;
        Memo2: TMemo;
        DateEdit2: TDateEdit;
        ComboBox1: TComboBox;
        Text8: TText;
        Edit1: TEdit;
        Glyph1: TGlyph;
        ImageList2: TImageList;
        Timer1: TTimer;
        Text6: TText;
        ListBox1: TListBox;
        indi: TAniIndicator;
        ListBox2: TListBox;
        procedure CornerButton2Click(Sender: TObject);
        procedure CornerButton3Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure CornerButton7Click(Sender: TObject);
        procedure CornerButton5Click(Sender: TObject);
        procedure CornerButton6Click(Sender: TObject);
        procedure CornerButton13Click(Sender: TObject);
        procedure CornerButton1Click(Sender: TObject);
        procedure CornerButton9Click(Sender: TObject);
        procedure Edit1Change(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
        procedure ComboBox1Change(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

      type
      bar = class(TThread)

      private
        { Private declarations }
      protected
        procedure Execute; override;
      end;


    var
      Form1: TForm1;
      cl:bar;
      proc:byte;
      ss:TStringStream;

    implementation

    {$R *.fmx}
    {$R *.LgXhdpiPh.fmx ANDROID}
    {$R *.Windows.fmx MSWINDOWS}

    procedure TForm1.ComboBox1Change(Sender: TObject);
    var
      i: Integer;
    begin
    while Listbox2.count>0 do
     ListBox2.listitems[0].Parent:=ListBox1;
    for i := 0 to ListBox1.Count-1 do
     if Listbox1.ListItems[i-ListBox2.Count].TagString=Combobox1.ListItems[Combobox1.ItemIndex].Text then
      Listbox1.ListItems[i-ListBox2.Count].Parent:=ListBox2;
    end;

    procedure TForm1.CornerButton13Click(Sender: TObject);
    begin
    if Length(Memo2.Text)>=15 then
     begin
      ShowMessage('Ваше сообщение отправлено!');
      Memo2.Lines.Clear;
      TabControl1.TabIndex:=0;
     end
    else
     begin
      ShowMessage('Сообщение не менне 15 символов.');
      Memo2.SetFocus;
     end;
    end;

    procedure TForm1.CornerButton1Click(Sender: TObject);
    begin
    if Edit1.Text='' then
     Begin
      ShowMessage('Укажите и номер счета и дату !');
      Edit1.SetFocus;
     End
    else
     Begin
     Text4.Text:='Подождите идет загрузка данных ...';

     End;
    end;

    procedure TForm1.CornerButton2Click(Sender: TObject);
    begin
    TabControl1.TabIndex:=1;
    Edit1.SetFocus;
    end;

    procedure TForm1.CornerButton3Click(Sender: TObject);
    begin
    TabControl1.TabIndex:=2;
    end;

    procedure TForm1.CornerButton5Click(Sender: TObject);
    begin
    TabControl1.TabIndex:=3;
    Memo2.SetFocus;
    end;

    procedure TForm1.CornerButton6Click(Sender: TObject);
    begin
    TabControl1.TabIndex:=4;
    end;

    procedure TForm1.CornerButton7Click(Sender: TObject);
    begin
    TabControl1.TabIndex:=0;
    end;


    procedure TForm1.Edit1Change(Sender: TObject);
    begin
    DateEdit2.SetFocus;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    ListBox1.Visible:=false;
    TabControl1.TabPosition:=ttabposition.None;
    TabControl1.TabIndex:=0;
    Text8.Text:=
    '+7 (812) 460-90-07'+#13+
    '+7 (812) 460-90-08'+#13+
    '+7 (812) 460-90-09'+#13+
    #13+
    'Офис:'+#13+
    #13+
    'Санкт-Петербург, г. Колпино, ул. Загородная, д. 44'+#13+
    #13+
    'Производство и склад:'+#13+
    #13+
    'Дорога на Петрославянку д. 3'+#13+
    #13+
    #13+
    'Режим работы: 09:00 - 17:30'+#13+
    'Обед: 13:00 - 13:40'+#13+
    #13+
    'Выходные: Суббота, Воскресенье'+#13+
    #13+
    'Тел.: 700-6024, 700-3242';
    end;

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    If (Glyph1.ImageIndex+1)<ImageList2.Count then
     Glyph1.ImageIndex:=Glyph1.ImageIndex+1
    else
     Glyph1.ImageIndex:=0;
    end;


    procedure TForm1.CornerButton9Click(Sender: TObject);
    begin
    if not(indi.Visible) then
     Begin
     Form1.indi.Visible:=true;
     Form1.indi.Enabled:=true;
     Form1.Text6.Text:='Подождите идет загрузка данных, это может занять пару минут.';
     Form1.Combobox1.Clear;
     Form1.Listbox1.Clear;
     Form1.Listbox2.Clear;
     cl:=bar.Create(false);
     end;
    end;

    { bar }

    procedure bar.Execute;
    var s,tgs:string;
        item:TListBoxItem;
        net:TNetHTTPClient;
        mm:tmemo;
    begin
     mm:=tmemo.Create(nil);
     net:=tnethttpclient.Create(nil);
     Ss:=TStringStream.Create('', TEncoding.UTF8);
     net.Get('https://www.gector-spb.ru/catalog/',ss);
     mm.text:=ss.DataString;

    while (mm.Lines.Count<>0) do
    begin
    if pos('class="catalog"',mm.Lines[0])>0 then
     begin
      while (mm.Lines.Count<>0) do
       begin
        if pos('div class="header"',mm.Lines[0])>0 then
         begin
          mm.Lines.Delete(0);
          s:=mm.Lines[0];
          delete(s,1,pos('>',s));
          s:=copy(s,0,pos('<',s)-1);
          tgs:=s;
          Form1.ComboBox1.Items.Add(s);
          while (mm.Lines.Count<>0)and(pos('</table>',mm.Lines[0])=0) do
           begin
            if pos('tr class="cell item',mm.Lines[0])>0 then
             begin
              Form1.ListBox1.BeginUpdate;
              Item:=TListBoxItem.Create(Form1.ListBox1);
              Item.StyleLookup:='listboxitembottomdetail';
              Item.Height:=40;
              item.TagString:=tgs;
              Item.TextSettings.WordWrap:=true;
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('a name=',s));
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</a>',s)-1);
              if s=' ' then
               begin
                mm.Lines.Delete(0);
                s:=mm.Lines[0];
                delete(s,1,pos('</a>',s)+3);
                s:=copy(s,1,pos('</td>',s)-1);
               end;
              Item.Text:=s;
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('<strong>',s)+7);
              s:=copy(s,1,pos('</strong>',s)-1);
              item.ItemData.Detail:='остаток: '+s+'тн';
              mm.Lines.Delete(0);
              s:=mm.Lines[0];
              delete(s,1,pos('>',s));
              s:=copy(s,1,pos('</td>',s)-1);
              item.ItemData.Detail:=item.ItemData.Detail+'   цена: '+s+'руб\тн';
              Form1.ListBox1.AddObject(item);
              Form1.ListBox1.EndUpdate;
             end;
            mm.Lines.Delete(0);
           end;
         end;
        mm.Lines.Delete(0);
       end;
     end;
    if mm.Lines.Count<>0 then mm.Lines.Delete(0);
    end;
     ss.Destroy;
     net.Destroy;
     mm.Destroy;
     Form1.indi.Visible:=false;
     Form1.indi.Enabled:=false;
     Form1.Text6.Text:='Загрузка данных завершена.';
     terminate;
     Form1.ComboBox1.ItemIndex:=0;
     cl.Free;
    end;

    end.

     

     

    Требуется приложение на на все смартфоны

    в Ищу подрядчика

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

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

    Прошу принять и расценить заказ на написание приложения для фирмы для всех смартфонов (ANDROID, IOS)

    Пример в приложении, делал сам, вышло не красиво

    Для начала две задачи:

    1. Загрузка каталога с сайта (примере в приложении работает на WINDOWS, на ANDROID один раз сработало а так зависает)

    2. Загрузка статуса заказа (в примере не реализовано) 

               на сайте это выглядит так:

    image.thumb.png.7fefd996a124ddfd435933349bfbbb32.png

     

     

    Требуется рабочее приложение (без глюков и тормозов) и сам код для моего изучения.

    89817514818 Александр (СПб)

    sashar333@mail.ru

    Заранее спасибо!

     

    ГЕКТОРсчет.7z

    На андроиде приложение вылетает при вызове IdIMAP4.Connect()

    в Проблемы запуска с устройствами

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

    в общем получилось на другом компе подключить телефон и запустить отладку через делфи

    при прохождении  пишет Project1.apk raised excepyion class EidOSSLCoulNotLoadSSLlibrary with message "Could not load SSL library"

    и останавливается в idSSLOpenSSl тут:

    constructor TIdSSLContext.Create;
    begin
      inherited Create;
      //an exception here probably means that you are using the wrong version
      //of the openssl libraries. refer to comments at the top of this file.
      if not LoadOpenSSLLibrary then begin
        raise EIdOSSLCouldNotLoadSSLLibrary.Create(RSOSSLCouldNotLoadSSLLibrary);
      end;
      fVerifyMode := [];
      fMode := sslmUnassigned;
      fSessionId := 1;
    end;
     

    я так понял проблема в файлах libcrypto.so и libssl

    может есть у кого подсказка где правильные скачать или как их подобрать?

    спасибо

    На андроиде приложение вылетает при вызове IdIMAP4.Connect()

    в Проблемы запуска с устройствами

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

    единственное что файлы libcrypto.so и libssl.so пришлось скачать с (http://indy.fulgan.com/SSL/?

     

    пробовал разные скачивать

    так как ссылка из темы ([DELPHI FMX Android] [6.0] Не удается загрузить SSL библиотеку)

    у меня не открывается

    image.png

    На андроиде приложение вылетает при вызове IdIMAP4.Connect()

    в Проблемы запуска с устройствами

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

    на сколько я понял и сделал так:

    1. добавил в Unit1.pas в USES: IdSSLOpenSSLHeaders

    2. добавил в Project1.dpr в USES самым первым: System.StartUpCopy

    3. добавил в Deployment Project1 два файла: libcrypto.so и libssl.so

    4. изменил в Deployment Project1 для фалов Remote Path: .\assets\internal

    5. добавил в FormCreate, в самом начале: IdOpenSSLSetLibPath(TPath.GetDocumentsPath);

     

    но все так же вылетает...

    На андроиде приложение вылетает при вызове IdIMAP4.Connect()

    в Проблемы запуска с устройствами

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

    1 час назад, Barbanel сказал:

    Решение для андроида - добавить в проект перекомпилированные библиотеки (libcrypto.so и libssl.so)
    После этого ssl работает.

    как это делается? перекомпилирование...

    библиотеки статические скачал с сайта indy с расширением "a"  (libcrypto.a и libssl.a)

    и, видимо не статические, библиотеки с расширение "so" (libcrypto.so и libssl.so)

    что значит перекомпилировать?

    и как их подключить к проекту?

     

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