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

zairkz

Пользователи
  • Постов

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

  • Посещение

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

    12

Активность репутации

  1. Like
    zairkz отреагировална Brovin Yaroslav в [TMultiView] Как избежать задержки при первом появлении TMultiView?   
    Задержка пропадает, если использовать этот код в TForm.OnShow?
    var Buffer: TBitmap; begin // Draw to Bitmap force to load all styles, measure size, build font-glyphs etc Buffer := TBitmap.Create(1, 1); try Buffer.Canvas.BeginScene; try MultiView.PaintTo(Buffer.Canvas, Control.LocalRect); finally Buffer.Canvas.EndScene; end; finally Buffer.DisposeOf; end;
  2. Like
    zairkz отреагировална kami в [iOSSimulator] TBitmap.Resize - иногда белый прямоугольник   
    Господа, спасибо за участие!
    zairkz, упростил и немного подправил ваш код, вот что получилось:
    procedure TSiteExchangerThread.RescalePhoto(const FileName: string); const   DefaultHeight = 300; var   Bitmap: TBitmap;   Thumb: TBitmap;   BSS: TBitmapCodecSaveParams;   xScale: Double;   newWidth, newHeight: integer; begin   Bitmap := TBitmap.Create;   try     try       Bitmap.LoadFromFile(FileName);       if Bitmap.Height <> DefaultHeight then         begin           xScale := Bitmap.Height / DefaultHeight;           newHeight := DefaultHeight;           newWidth := Round(Bitmap.Width / xScale);           Thumb := Bitmap.CreateThumbnail(newWidth, newHeight); // далее работаем с Thumb, а не с Bitmap           try             BSS.Quality := 90;             Thumb.SaveToFile(FileName, @BSS); // все менеджеры и surface не нужны, они есть внутри Save-метода           finally             Thumb.Free;           end;         end;     except       DeleteFile(FileName);       raise;     end;   finally     Bitmap.Free;   end; end; Кстати, весьма удивился, что результат получился нужный: TBitmap.Resize использует тот же самый CreateThumbnail. Единственное отличие - в Resize-методе используется Assign получившегося thumb-а в себя же. А вот в самом assign какие-то непонятные манипуляции со счетчиками ссылок FImage. Имхо, именно здесь и возникает проблема с белым прямоугольником, ибо все остальное - 1:1 уже используемое в методах TBitmap
  3. Like
    zairkz отреагировална Dozent в При изменении размеров или положения компонентов на форме всё проподает   
    Знаете! Я снял галки в Multi-Device Preview с Айфон 4 и Айфон5 ни чего не закрывал и проблема пока не появляется))) Если появится я попробую ваш совет
  4. Like
    zairkz получил реакцию от Gingercat в При изменении размеров или положения компонентов на форме всё проподает   
    Если я правильно понял, то на рабочем столе еще появляется не сворачиваемая отрисовка вашей формы, которая очень напрягает память и скорость работы самой среды, такая фигня в XE8, избавляюсь от неё следующим образом:
    Открыть Delphi, перед открытием вашего проекта создать новый проект MultiDeviceProject, зайти в меню View -> Multi-Device Preview -> в нем кнопочка Select Views to Preview (hint) отключить все превьюхи и закрыть проект не сохраняя, открыть ваш проект и все ок. 
    После перезапуска повторяю данные телодвижения, хз как сохранить.
  5. Like
    zairkz отреагировална kami в Как скрыть MultiView на определенном табе или форме?   
    Ну, в качестве костыльного решения могу предложить менять MultiView.DrawerOptions.TouchAreaSize на 0.
    Это должно убрать появление MultiView при слайде пальцем от левого края экрана. А при активации другой закладки возвращать значение по умолчанию.
  6. Like
    zairkz отреагировална Gingercat в Kitchen calculator - кухонный калькулятор   
    Доброго дня. Совсем позабыл про существование данного топика, а ведь нужен - дабы видели люди, что другие люди иногда творят.
     
    Собственно - Kitchen calculator: конвертер величин и температур; таблица калорий; пересчет температур, и простенький таймер.
     
    Ссылка - Kitchen calculator
     
    Написан на с++ в Appmethod.
  7. Like
    zairkz отреагировална bigjorj в TvPro - телепрограмма   
    Добавлю и я
     
    Телепрограмма. Просмотр текста программы передач на Android.
     
     
    https://play.google.com/store/apps/details?id=com.tvday.TvProMobile
  8. Like
    zairkz отреагировална haword в PrimeMusic - Приложение для скачивания и прослушивания музыки с сайта www.primemusic.ru   
    если жить по такому правилу тогда надо и слушать музыку по одному разу. послушал песню - заплатил. послушал песню - заплатил. вот тогда будет правильно  
  9. Like
    zairkz отреагировална Евгений Корепов в Сообщения чата в виде сообщений в iphone.   
    Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под windows, при клике на сообщение, оно превращается в readonly TMemo - дабы можно было скопировать нужное из сообщения. При наличии URL в сообщении, сбоку появляется кнопка открыть - лучше ничего для открытия ссылок не придумал. Надо бы сделать диалог выбора для открытия одной из нескольких ссылок, но руки пока не доходят. Пощупать чат вживую можно в приложении https://play.google.com/store/apps/details?id=ru.flintnet.InternetAgent , для активации и загрузки примера чата отсканируйте  приложением qr-код с страницы  http://internetagent.flintnet.ru/
     

    unit ChatBox; interface uses   System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts,System.Types,   FMX.StdCtrls,FMX.Edit,FMX.Memo,FMX.TextLayout,System.UITypes,FMX.Graphics,FMX.Objects,   FMX.Effects,FMX.Styles.Objects; type   TMessagePos = (msgLeft,msgRight);   TEventText = procedure(PURL: String) of object;   TChatBox = class(TVertScrollBox)   private     FTextLyout : TTextLayout;     FLastMessageId : Integer;     FMsgWidthPercentage : Integer;     FOnURLButtonClick : TEventText;     FCalloutLength : Single;     FCalloutXRadius : Single;     FCalloutYRadius : Single;     FMessageFontSize : Single;     FMemo : TMemo;     procedure ButtonClick(Sender: TObject);     procedure MyMsgContainerOnClick(Sender: TObject);     procedure MyMsgContainerOnExit(Sender: TObject);     function FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer;       PDate, PAutor, PMessage : String; PMessagePos : TMessagePos) : TLayout;     function CalculateTextItemHeight(Sender: TObject) : Single;     procedure LayoutResize(Sender: TObject);     function ExtractURL(pString : String) : String;     procedure Memo1ApplyStyleLookup(Sender: TObject);   public     property LastMessageId : Integer read FLastMessageId;     property MsgWidthPercentage : Integer read FMsgWidthPercentage write FMsgWidthPercentage default 80;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     Procedure AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos);     procedure ClearChildren(AChatBox: TChatBox);     procedure ScrollBottomSmoothly;     procedure ScrollBottom;   published     property OnURLButtonClick : TEventText read FonURLButtonClick write FonURLButtonClick;     property CalloutLength : Single read FCalloutLength write FCalloutLength;     property CalloutXRadius : Single read FCalloutXRadius write FCalloutXRadius;     property CalloutYRadius : Single read FCalloutYRadius write FCalloutYRadius;     property MessageFontSize : Single read FMessageFontSize write FMessageFontSize;   end;   TOpenChatBox = class(TChatBox); Procedure Register; implementation procedure Register; begin   RegisterComponents('EKorepov', [TChatBox]); end; constructor TChatBox.Create(AOwner: TComponent); begin   inherited create(Aowner);   FLastMessageId:=-1;   FTextLyout := TTextLayoutManager.DefaultTextLayout.Create;   FMemo:=TMemo.Create(Aowner);   FMemo.TextSettings.WordWrap:=True;   FMemo.ReadOnly:=True;   FMemo.Align:=TAlignLayout.Client;   FMemo.OnExit:=MyMsgContainerOnExit;   FMemo.OnApplyStyleLookup:=Memo1ApplyStyleLookup;   FMemo.StyledSettings:=FMemo.StyledSettings-[TStyledSetting.Size];   With Self as TVertScrollBox do   begin     AniCalculations.Animation := True;     AniCalculations.BoundsAnimation := True;     AniCalculations.TouchTracking := [ttVertical];   end; end; destructor TChatBox.Destroy; begin   FreeAndNil(FMemo);   FreeAndNil(FTextLyout);   inherited Destroy; end; procedure TChatBox.ScrollBottomSmoothly; begin   AniCalculations.MouseWheel(0, ContentBounds.Height+5); end; procedure TChatBox.ScrollBottom; begin   ScrollBy(0, -ContentBounds.Height); end; procedure TChatBox.ButtonClick(Sender: TObject); Var URL : String; begin   URL:=TButton(Sender).HelpKeyword;   if Assigned(FonURLButtonClick) then     FonURLButtonClick(URL); end; procedure TChatBox.Memo1ApplyStyleLookup(Sender: TObject); begin end; procedure TChatBox.MyMsgContainerOnClick(Sender: TObject); begin   FMemo.TextSettings:=TLabel(Sender).TextSettings;   FMemo.Lines.Text:=TLabel(Sender).Text;   TLabel(Sender).AddObject(FMemo); end; procedure TChatBox.MyMsgContainerOnExit(Sender: TObject); begin   if (Sender is TMemo) then     if Assigned(TMemo(Sender).Parent) then       if (TMemo(Sender).Parent is TLabel) then         TLabel(TMemo(Sender).Parent).RemoveObject(TMemo(Sender)); end; procedure TChatBox.ClearChildren(AChatBox: TChatBox); begin   Assert(AChatBox <> nil);   TOpenChatBox(AChatBox).Content.DeleteChildren;   AChatBox.Repaint; end; function TChatBox.CalculateTextItemHeight(Sender: TObject) : Single; var Item: TLabel; begin   Result:=0;   if (Sender is TLabel) then   begin     Item := TLabel(Sender);     FTextLyout.BeginUpdate;     try       FTextLyout.Text := Item.Text;       FTextLyout.MaxSize := TPointF.Create(Item.Width-Item.Margins.Left-Item.Margins.Right-10, 1000);       FTextLyout.Font := Item.Font;       FTextLyout.WordWrap:= Item.WordWrap;       FTextLyout.HorizontalAlign:= Item.TextSettings.HorzAlign;       FTextLyout.VerticalAlign:= Item.TextSettings.VertAlign;     finally       FTextLyout.EndUpdate;     end;     Result:= FTextLyout.Height+10;   end; end; procedure TChatBox.LayoutResize(Sender: TObject); Var Item : TLabel;     CalloutRectangle : TCalloutRectangle;     Layout : TLayout;     I : Integer; begin   Layout:=TLayout(Sender);   for I := 0 to Layout.Children.Count-1 do   begin     If Layout.Children.Items[I] is TCalloutRectangle Then     begin       CalloutRectangle:=TCalloutRectangle(Layout.Children.Items[I]);       Item:=TLabel(CalloutRectangle.Children.Items[0]);       CalloutRectangle.Width:=(Layout.Width / 100) * FMsgWidthPercentage;       Layout.Height:=CalculateTextItemHeight(Item);     end;     If Layout.Children.Items[I] is TButton Then     begin       TButton(Layout.Children.Items[I]).Width:=(Layout.Width / 100) * (100-FMsgWidthPercentage-5);     end;   end; end; Procedure TChatBox.AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos); Var lcLayout : TLayout; begin   PDate:=Trim(PDate);   PAutor:=Trim(PAutor);   PMessage:=Trim(PMessage);   FLastMessageId:=PMessageId;   lcLayout:=FCreateMsgBlock((Self as TVertScrollBox), PMessageId, PDate, PAutor, PMessage, PMessagePos);   Self.AddObject(lcLayout); end; function TChatBox.FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer; PDate, PAutor, PMessage : String;                                   PMessagePos : TMessagePos) : TLayout; Var lcLayout,lcLayout2 : TLayout;     Item : TLabel;     Button : TButton;     CalloutRectangle : TCalloutRectangle;     lcHeight : Single;     URL : String; begin   lcLayout:=TLayout.Create(AOwner);   lcLayout.Tag:=pMessageId;   lcLayout.Align:=TAlignLayout.Top;   lcLayout.Width:=200;   lcLayout.Position.X:=0;   lcLayout.Position.Y:= ((AOwner as TVertScrollBox).ContentBounds.Height+10);   lcLayout.Margins.Bottom:=10;   CalloutRectangle:=TCalloutRectangle.Create(lcLayout);   CalloutRectangle.XRadius:=FCalloutXRadius;   CalloutRectangle.YRadius:=FCalloutYRadius;   CalloutRectangle.CalloutWidth:=10;   CalloutRectangle.CalloutOffset:=-3-FCalloutYRadius-CalloutRectangle.CalloutWidth;   CalloutRectangle.Width:=((AOwner as TVertScrollBox).Width / 100) * FMsgWidthPercentage;   CalloutRectangle.HitTest:=False;   case PMessagePos of     msgRight :     begin       CalloutRectangle.Align:=TAlignLayout.Right;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Right;       CalloutRectangle.Padding.Right:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Left:=CalloutRectangle.XRadius;     end;     msgLeft :     begin       CalloutRectangle.Align:=TAlignLayout.Left;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Left;       CalloutRectangle.Padding.Left:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Right:=CalloutRectangle.XRadius;     end;   end;   CalloutRectangle.Padding.Top:=1;   CalloutRectangle.Padding.Bottom:=1;   lcLayout.AddObject(CalloutRectangle);   Item:=TLabel.Create(CalloutRectangle);   Item.TextSettings.Font.Size:=MessageFontSize;   CalloutRectangle.AddObject(Item);   Item.Align:=TAlignLayout.Client; {$IFDEF MSWINDOWS}   Item.OnClick:=MyMsgContainerOnClick; {$ENDIF MSWINDOWS}   Item.Text:=PDate+' '+PAutor+#10+PMessage;   Item.HitTest:=True;   Item.WordWrap:=True;   lcHeight:=CalculateTextItemHeight(Item);   lcLayout.Height:=lcHeight;   URL:=ExtractURL(pMessage);   Item.StyledSettings:=Item.StyledSettings- [TStyledSetting.Size,TStyledSetting.Style];   if Not URL.IsEmpty then   begin     lcLayout2:=TLayout.Create(lcLayout);     lcLayout2.Align:=TAlignLayout.Client;     lcLayout2.Margins.Left:=5;     lcLayout2.Margins.Right:=5;     lcLayout.AddObject(lcLayout2);     Button:=TButton.Create(lcLayout2);     Button.Text:='Открыть';     Button.Align:=TAlignLayout.Center;     Button.HelpKeyword:=URL;     Button.OnClick:=ButtonClick;     lcLayout2.AddObject(Button);   end;   lcLayout.OnResize:=LayoutResize;   Result:=lcLayout; end; function TChatBox.ExtractURL(pString : String) : String; Var S : String; begin   Result:='';   if Not pString.Contains('http') then     Exit;   S:=pString.Substring(Pos('http',pString)-1);   S:=S.Remove(S.IndexOfAny([' ',',']));   Result:=S.TrimRight(['.']); end; end.
  10. Like
    zairkz отреагировална Равиль Зарипов (ZuBy) в Проектирование интерфейса   
    Для анимации переходов точно TTabControl, но не лепить все на одной форме
  11. Like
    zairkz получил реакцию от Alex7wrt в Более быстрая альтернатива DrawBitmap   
    Попробуй движок Shadow Engine для Firemonkey, FPS впечатляет.
    https://www.youtube.com/watch?v=w6lGasU61HQ
     
    Gihub: https://github.com/dimsa/ShadowEngine
  12. Like
    zairkz получил реакцию от dnekrasov в Более быстрая альтернатива DrawBitmap   
    Попробуй движок Shadow Engine для Firemonkey, FPS впечатляет.
    https://www.youtube.com/watch?v=w6lGasU61HQ
     
    Gihub: https://github.com/dimsa/ShadowEngine
  13. Like
    zairkz получил реакцию от Kitty в Более быстрая альтернатива DrawBitmap   
    Попробуй движок Shadow Engine для Firemonkey, FPS впечатляет.
    https://www.youtube.com/watch?v=w6lGasU61HQ
     
    Gihub: https://github.com/dimsa/ShadowEngine
  14. Like
    zairkz отреагировална Brovin Yaroslav в Обо мне, как о педагоге   
    Меня зовут Бровин Ярослав Дмитриевич. Я работаю разработчиком в компании Embarcadero в команде FireMonkey. Поэтому в совершенстве знаю язык Delphi и FireMonkey.
     
    Несколько фактов:
    Педагогический опыт: Лауреат конкурса "Сердце отдаю детям" в рамках конкурса "Учитель года". Имею первую категорию по должности педагога дополнительного образования. Стаж работы педагогом 6 лет. Награжден нагрудным знаком правительством Санкт-Петербурга "За гуманизацию школы Санкт-Петербурга" Образование: Закончил с отличием Ленинградский Электротехнический институт им У. Ленина по специальности Технологии Разработки Программного Обеспечения. Увлечения помимо работы: В свободное время занимаюсь авиамоделированием, игрой на музыкальном инструменте и созданием и администрированием Web-ресурсов
  15. Like
    zairkz отреагировална enatechno в Как задать внутренний отступ padding для контента TScrollBox?   
    Перефразирую Ярослава: "Все контролы, которые вы кидаете в TCustomScrollBox находятся в дополнительном промежуточном контроле TScrollContent."
     
    т.е. Padding для VerticalScrollBox можно задать так:
    VertScrollBox1.Content.Padding.Top := 5;
  16. Like
    zairkz получил реакцию от Kitty в argument out of range   
    Что то я по описанию не увидел проблему, сделал проект такой же все работает TestLV
     
    Вызываю очищение и добавления ListView по нажатию ListBoxItem'a.
    while ListView1.ItemCount>0 do ListView1.Items.Delete(0);
     
    ListView1.BeginUpdate;
       for i := 0 to 50 do ListView1.Items.Insert(0).Text:='Text - '+i.ToString;
    ListView1.EndUpdate;
     
    На счет удаления из ListView компонента по нажатию, то есть из самого себя, есть проблемка, не сбрасывается ссылка на Item, пришлось обходить её через таймер (1 мс)
    Сохраняю Aitem.index в глобальную переменную и по таймеру удаляю Итем по индексу, потом выключаем таймер. Незнаю на сколько это правильно, но все работает и меня устраивает. В проекте выше есть
  17. Like
    zairkz отреагировална Brovin Yaroslav в Разработка настольной версии клиента для форума по FireMonkey с использованием FireMonkey   
    Приступил к разработке клиента с использованием FireMonkey для форума. В будущем код будет открытым и каждый сможет посмотреть, как реализованы те или иные вещи.
    А пока пара скриншотов:

  18. Like
    zairkz отреагировална Brovin Yaroslav в лицензионное соглашение для компонентов?   
    Модифицируйте на здоровье. Мне не жалко :-)
  19. Like
    zairkz отреагировална Равиль Зарипов (ZuBy) в [Android] TreeView XE8   
    procedure TFormFM.NavigationTreeView(aTree: TTreeView; const aData: string); var Root, Child, SubChild, Item: TTreeViewItem; StrList: TStringList; i, c: integer; Str, ParseStr: string; begin StrList := TStringList.Create; StrList.Text := aData; aTree.BeginUpdate; aTree.Clear; for i := 0 to StrList.Count - 1 do begin Str := StrList.Strings[i]; ParseStr := Parse('">', '</option>', Str); if Pos('a', ParseStr) > 0 then ParseStr := StringReplace(ParseStr, 'a', 'a', [rfReplaceAll]); Item := TTreeViewItem.Create(nil); Item.StyleLookup := 'treeviewitemstyle'; Item.Text := trim(StringReplace(ParseStr, '-', '', [rfReplaceAll])); Item.HelpKeyword := Parse('<option value="', '">', Str); Item.ClipChildren := false; if Pos('-', ParseStr) = 0 then begin aTree.AddObject(Item); Root := Item; end else if ParseStr.StartsWith('-- ') then begin Root.AddObject(Item); Child := Item; end else if ParseStr.StartsWith('---- ') then begin Child.AddObject(Item); SubChild := Item; end else if ParseStr.StartsWith('------ ') then begin SubChild.AddObject(Item); end; end; aTree.EndUpdate; aTree.RealignContent; FreeAndNil(StrList); end; вот решение если кто столкнется с таким же багом
    спасибо Ярославу!
  20. Like
    zairkz отреагировална Martifan в [Android] Как свернуть приложение?   
    первым способом переводить тебя сразу на рабочем столе то есть тебя выкидывает из меню и на главном форме переключается о твоя приложения сворачивается а вторым способом тебя не выкидывает никуда проста сворачивает приложения
  21. Like
    zairkz отреагировална estra в MultiView   
    Кстати, в вышеозначенном примере тоже есть ошибка, приводящая к Access Violation. Как воспроизвести:
     
    1. Запускаем пример под Windows;
    2. В выпадающем списке (Multi View Mode) выбираем Custom;
    3. Открываем MultiView (нажатием кнопки в левом верхнем углу формы);
    4. Не закрывая MultiView закрываем приложение. Получаем Access Violation.
     
    Попробуйте исправить сами, а если не получится, можете подсмотреть решение:
     
     
  22. Like
    zairkz отреагировална xenon54 в Как работает TImageList c TButton ?   
    Все разработчики Embarcadero живут в Питере?
  23. Like
    zairkz отреагировална haword в [Android] Можно ли создать динамическую заставку загрузки данных?   
    Между заставкой картинкой и показом моей программы проходит порядка 3 секунд и в этот момент чёрный экран. Картинка пропадает а форма еще не нарисована. Видно много компонентов накидал на табы поэтому долго грузится.
  24. Like
    zairkz отреагировална haword в TLocationSensor   
    ну вот, прыгая с бубном вокруг программы и напевая хэя хэя хэя достучался то решения проблемы. вернее даже не решения а костыля для моих нужд. 
     
    Нафига так делать не понятно но программисты обезьяны сделали. При активации любого сенсора, в менеджере сенсоров происходит активация и создание классов для ВСЕХ имеющихся сенсоров. И некоторые сенсоры уводят процессор в 100%. 
     
    так вот на моем телефоне + эмуляторе достаточно отключить создание сенсоров 
     
    TAndroidNativeLightSensor
    TAndroidNativeMagneticSensor
    TAndroidNativeProximitySensor
     
    в процедуре Activate класса TAndroidSensorManager в файле System.Android.Sensors.pas и закинуть к себе в проект и вуаля, нагрузки на процессоре нет. 
  25. Like
    zairkz отреагировална xenon54 в Работа сервиса при закрытом приложении   
    Ну тут все просто. Remote Push Notification.
    Вот, хороший видос на эту тему для ведра тынц
    И сервис никакой не нужен.
    Для ведра это называется  "Google Cloud Messaging"
×
×
  • Создать...