gonzales

Хороший набор компонентов, спасибо OnePeople, один трабл с TabControl, нет возможности использовать loop, прокрутить с последнего таба на первый. OnePeople, не сталкивались случайно, как исправить?

Спасибо, буду пробовать

Заинтересовал этот компонент. Пытаюсь доделать его для использования в 10.4.1. Осталась одна проблема, не видно анимации при отпускании пальца, то есть веду палец по экрану - вижу смену табов, но при отпускании пальца активный таб просто перерисовывается. Думаю проблема вот в этой процедуре procedure TUITabControl.EndSlide; procedure LocalAnimateInt(AParent : TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); var A: TIntAnimation; begin TAnimator.StopPropertyAnimation(Self, APropertyName); A := TIntAnimation.Create(AParent); A.Parent := AParent; A.AnimationType := AType; A.Interpolation := AInterpolation; A.OnFinish := AnimationFinished; A.Duration := Duration; A.PropertyName := APropertyName; A.StartFromCurrent := True; A.StopValue := NewValue; A.Start; end; procedure LocalAnimateIntWait(AParent : TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); var A: TIntAnimation; begin TAnimator.StopPropertyAnimation(Self, APropertyName); A := TIntAnimation.Create(AParent); try A.Parent := AParent; A.AnimationType := AType; A.Interpolation := AInterpolation; A.Duration := Duration; A.PropertyName := APropertyName; A.StartFromCurrent := True; A.StopValue := NewValue; A.Start; while A.Running do begin Application.ProcessMessages; Sleep(0); end; finally A.DisposeOf; end; end; const Duration = 0.2; begin if not FSlide then Exit; { if SlideVolume>0.5 then begin LocalAnimateInt(Layout1, 'Position.X', Round(-Layout1.Width)); LocalAnimateIntWait(Layout2, 'Position.X', 0); ActiveTab := Tab2; end else begin LocalAnimateInt(Layout1, 'Position.X', 0); LocalAnimateIntWait(Layout2, 'Position.X', Round(Layout1.Width)); ActiveTab := Tab1; end;} if (SlideVolume<0.5) and not IsSpeedUp then begin if SlideDirection=TSlideDirection.sdNext then begin P := Tab1.AbsoluteToLocal(LayoutPos); LocalAnimateInt(internalLayout1, 'Position.X', Round(P.X), Duration, TAnimationType.Out, TInterpolationType.Exponential); P := Tab2.AbsoluteToLocal(LayoutPos); LocalAnimateIntWait(internalLayout2, 'Position.X', Round(P.X + LayoutRect.Width), Duration, TAnimationType.Out, TInterpolationType.Exponential); end else begin P := Tab1.AbsoluteToLocal(LayoutPos); LocalAnimateInt(internalLayout1, 'Position.X', Round(P.X), Duration, TAnimationType.Out, TInterpolationType.Exponential); P := Tab2.AbsoluteToLocal(LayoutPos); LocalAnimateIntWait(internalLayout2, 'Position.X', Round(P.X - LayoutRect.Width), Duration, TAnimationType.Out, TInterpolationType.Exponential); end; ActiveTab := Tab1; end else begin if SlideDirection=TSlideDirection.sdNext then begin P := Tab1.AbsoluteToLocal(LayoutPos); LocalAnimateInt(internalLayout1, 'Position.X', Round(P.X - LayoutRect.Width), Duration, TAnimationType.Out, TInterpolationType.Exponential); P := Tab2.AbsoluteToLocal(LayoutPos); LocalAnimateIntWait(internalLayout2, 'Position.X', Round(P.X), Duration, TAnimationType.Out, TInterpolationType.Exponential); end else begin P := Tab1.AbsoluteToLocal(LayoutPos); LocalAnimateInt(internalLayout1, 'Position.X', Round(P.X+ + LayoutRect.Width), Duration, TAnimationType.Out, TInterpolationType.Exponential); P := Tab2.AbsoluteToLocal(LayoutPos); LocalAnimateIntWait(internalLayout2, 'Position.X', Round(P.X), Duration, TAnimationType.Out, TInterpolationType.Exponential); end; ActiveTab := Tab2; end; SetLength(TransitionTabs,0); // ClipChildren := False; SlideDirection := TSlideDirection.sdNone; FSlide := False; end; а конкретно тут while A.Running do begin Application.ProcessMessages; Sleep(0); end; но как исправить, пока не пойму. Нашел оригинальную функцию в FMX.TabControl, выглядит она вот так procedure TTabControl.SetActiveTabWithTransition(const ATab: TTabItem; const ATransition: TTabTransition; const ADirection: TTabTransitionDirection = TTabTransitionDirection.Normal); procedure AnimateControlPositionX(AParent: TFmxObject; const NewValue: Integer); var A: TIntAnimation; begin TAnimator.StopPropertyAnimation(AParent, 'Position.X'); A := TIntAnimation.Create(AParent); A.Parent := AParent; A.AnimationType := DefaultSlidingAnimationType; A.Interpolation := DefaultSlidingInterpoation; A.OnFinish := AnimationFinished; A.OnProcess := WebBrowserRealign; A.Duration := DefaultSlidingDuration; A.PropertyName := 'Position.X'; A.StartFromCurrent := True; A.StopValue := NewValue; A.Start; end; procedure AnimateControlPositionXWait(AParent: TFmxObject; const NewValue: Integer); var A: TIntAnimation; begin TAnimator.StopPropertyAnimation(AParent, 'Position.X'); A := TIntAnimation.Create(AParent); try A.Parent := AParent; A.AnimationType := DefaultSlidingAnimationType; A.Interpolation := DefaultSlidingInterpoation; A.Duration := DefaultSlidingDuration; A.PropertyName := 'Position.X'; A.StartFromCurrent := True; A.StopValue := NewValue; A.Start; while A.Running do begin Application.ProcessMessages; Sleep(0); end; finally A.DisposeOf; end; end; var Tab1, Tab2: TTabItem; Layout1, Layout2: TControl; LayoutRect: TRectF; P, LayoutPos: TPointF; begin if ATab = ActiveTab then Exit; FinishCurrentTabTransition; case ATransition of TTabTransition.Slide: begin FTransitionRunning := True; ClipChildren := True; try LayoutPos := ActiveTab.Content.LocalToAbsolute(TPointF.Zero); LayoutRect := ActiveTab.Content.BoundsRect; Tab1 := ActiveTab; Layout1 := ActiveTab.Content; ActiveTab := ATab; Tab2 := ActiveTab; Layout2 := ActiveTab.Content; FTransitionTabs := [Tab1, Tab2]; DisableDisappear(Tab1); Layout1.Visible := True; Layout2.Visible := True; if not Tab2.DisableDisappear then begin DisableDisappear(Tab2); PreloadContent(Layout2); end; if ADirection = TTabTransitionDirection.Normal then begin P := Tab1.AbsoluteToLocal(LayoutPos); Layout1.SetBounds(P.X, P.Y, LayoutRect.Width, LayoutRect.Height); AnimateControlPositionX(Layout1, Round(P.X - LayoutRect.Width)); P := Tab2.AbsoluteToLocal(LayoutPos); Layout2.SetBounds(P.X + LayoutRect.Width, P.Y, LayoutRect.Width, LayoutRect.Height); AnimateControlPositionXWait(Layout2, Round(P.X)); end else begin P := Tab1.AbsoluteToLocal(LayoutPos); Layout1.SetBounds(P.X, P.Y, LayoutRect.Width, LayoutRect.Height); AnimateControlPositionX(Layout1, Round(P.X + LayoutRect.Width)); P := Tab2.AbsoluteToLocal(LayoutPos); Layout2.SetBounds(P.X - LayoutRect.Width, P.Y, LayoutRect.Width, LayoutRect.Height); AnimateControlPositionXWait(Layout2, Round(P.X)); end; finally SetLength(FTransitionTabs, 0); ClipChildren := False; FTransitionRunning := False; Realign; end; // Force repaint Application.ProcessMessages; end; else ActiveTab := ATab; end; end; Работает вроде правильно, только нет анимации при движении пальца. Как бы теперь получить то, что нужно. PS. На всякий случай, хочу получить эффект прокрутки рабочих столов на андроиде. Когда смахиваю пальцем, рабочий стол следует за ним и показывается новый. Когда палец отпускаю - вижу анимацию смены рабочих столов. Надеюсь понятно объяснил))

Это инструкция для делфи 10.4.1 1. Копируем ttf или otf файл шрифта в папку с проектом. Например у меня comic.ttf. Открыв шрифт стандартным виндовым просмотровщиком смотрим, чтобы шрифт содержал необходимый нам набор символов и заодно фиксируем Имя шрифта. В данном случае это будет Comic Sans MS. Если шрифт имеет расширение TTF (капсом), то меняем его на ttf, это важно ибо капсом файл шрифта не находится. для Android 2. Деплоим файл шрифта. Remote Path указываем .\assets\internal\ 3. Для контролов, к которым хотим применить шрифт пишем Font.Family := 'название файла шрифта без расширения'; в моем примере Font.Family :='comic'; 4. Не забываем снять у контрола зависимость от стиля, например так StyledSettings := []; Или так StyledSettings := StyledSettings - [TStyledSetting.Family]; для iOS 2. Деплоим файл шрифта. Remote Path указываем .\ 3. Редактируем info.plist.TemplateiOS.xml, чтобы при сборке информация о шрифте попала в plist. <%ExtraInfoPListKeys%> <key>UIAppFonts</key> <array> <string>comic.ttf</string> <string>другие шрифты.ttf</string> </array> 3. Для контролов, к которым хотим применить шрифт пишем Font.Family := 'Имя шрифта'; в моем примере Font.Family :='Comic Sans MS'; 4. Не забываем снять у контрола зависимость от стиля, например так StyledSettings := []; Или так StyledSettings := StyledSettings - [TStyledSetting.Family]; 4. Пересобираем приложение (Build) и ставим на телефон

да, разобрался во всем. засада в том, что среда поддерживает только два начертания, Regular и Bold, приходится искать шрифты, где начертание подменено, то есть начертание Regular а по факту, например, Light. Но даже в этом случае работает не корректно, если загружаю два начертания одного шрифта как два разных шрифта. В общем удалось победить загрузку шрифтов и на андроид и на ios, если кому будет интересно, могу составить мануал.

И все таки не работает))) Не работает на мобильных платформах. Я правильно понимаю, что и не будет и надо действовать через установку своего шрифта?

Все работает, в запаре забыл галки снять с StyleSettings

подниму тему. понадобилось тоже изменять начертание текста, конкретно сейчас задача про label не применяется TFont.StyleExt, не пойму как правильно сделать var s:TFontStyleExt; begin s:=TFontStyleExt.Create(TFontWeight.Light); label1.Font.StyleExt:= s; end; подскажите, как правильно сделать

Доброго времени суток! Вроде элементарный вопрос, но не могу сообразить что не так. Хочу раскрасить текст элементов combobox в разные цвета или добавить к ним кружки с цветом. Ни то, ни то не получается. Вот процедура procedure TForm28.CreateSystemColor(Name:string; itemcolor:int64; ID:integer); var item: tlistboxitem; circle:TCircle; begin item := tlistboxitem.Create(nil); item.Parent := Combobox2; item.text := Name; item.Tag := ID; item.StyledSettings := item.StyledSettings - [TStyledSetting.FontColor]; item.TextSettings.FontColor:=itemcolor; item.FontColor := itemcolor; circle:=TCircle.Create(item); circle.Parent:=item; circle.Align:=talignlayout.Right; circle.Fill.Color:=itemcolor; circle.Stroke.Color:=talphacolorrec.White; circle.Visible:=true; end; Подскажите, где я накосорезил

тоже интересует этот вопрос. Кто-нибудь уже проверил?

Помогло вот такое, интересно, это бага или фича IdTCPClient.Disconnect; if IdTCPClient.IOHandler <> nil then IdTCPClient.IOHandler.InputBuffer.Clear;

Доброго времени суток. Увидел очень странное поведение idTCPClient Написал процедуру принудительного реконекта с сервером, но она отрабатывает не так, как ожидалось (сорри за оформление, не работает кнопка Код на сайте) procedure TForm1.Reconnect(er: String); var Size: TSizeF; B: boolean; begin Size.cx := 16; Size.cy := 16; if Client1.Connected = true then begin Client1.Disconnect; end; if Client1.Connected = false then begin try Client1.Connect; Form1.ConnectImage.Bitmap := Form1.IconList.Bitmap(Size, 15); Timer1.Enabled := true; except on E: Exception do begin InfoLabel.text := er; Form1.ConnectImage.Bitmap := Form1.IconList.Bitmap(Size, 7); end; end; end else begin Form1.ConnectImage.Bitmap := Form1.IconList.Bitmap(Size, 15); Timer1.Enabled := true; end; end; Смысл в том, что после Client1.Disconnect, Client1.Connected остается в состоянии true, хотя на сервере вижу, что соединение разорвалось. И ничего не помогает, пробовал и Client1.IOHandler.Close и Client1.Disconnect(true). Подскажите, в какую сторону копать?

Да, тоже вдоволь натрахался с ssl на андроиде, в результате попробовал THTTPClient, остался доволен как слон, работает из коробки, никакого головняка, в общем хороший компонент, рекомендую

Решил вопрос var sstream: TStringStream; begin sstream := TStringStream.Create('', TEncoding.UTF8); HTTP.Get(Url, sstream); showmessage(sstream.DataString); end; Не работает кнопка Код, поэтому выложил просто текстом

Доброго времени суток. А не подскажете, как обратную задачку решить? В ответе сервера есть русские буквы, соответственно отображается крокозябами. Как перевести в нормальный вид? Пробовал использовать Utf8ToAnsi - не помогло, кроказябы только поменялись на другие))) Подозреваю, что ответ приходит в юникоде, так как на серверной стороне отвечает микроконтроллер, но это не точно, так как идет еще редирект через какое-то облако по https.