mmover

Пользователи
  • Публикаций

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

  • Посещение

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

    4

Весь контент mmover

  1. mmover

    HueTrackBar

    procedure TForm2.HueTrackBar1Change(Sender: TObject); begin Rectangle1.Fill.Color := HSLtoRGB(HueTrackBar1.Value,1,0.5); end;
  2. В стиле подправить координаты для SourceLink (уменьшить прямоугольник, что бы в него не попадала рамка)
  3. mmover

    Свои кнопки в заголовке окна

    Примерно так : MyCaptionButton.StylesData['ButtonStyle.OnClick'] := TValue.From<TNotifyEvent>(ButtonClick);
  4. mmover

    ListBox1.ScrollToItem(Item);

    Попробуйте так : procedure TForm1.Process; Const N=100; var I,Index:Integer; Item:TListBoxItem; begin for I := 1 to N do begin Item:=TListBoxItem.Create(ListBox1); Item.Text:=IntToStr(I); ListBox1.AddObject(Item); end; ListBox1.ApplyStyleLookup; // (создаст ContentLayout) ListBox1.ScrollToItem(Item); end;
  5. Меняется с помощью стиля. Например: procedure TForm2.Button1Click(Sender: TObject); begin ComboBox1.ListBox.DefaultItemStyles.ItemStyle := 'ListBoxItemMyStyle' ; ComboBox1.NeedStyleLookup; end;
  6. У TMS есть компонент с похожим функционалом - TTMSFMXHotSpotImage. На картинку накладываются произвольные регионы с возможностью обработки событий.
  7. type THackCustomComboBox = class(TCustomComboBox) public property Popup; end; ...... begin THackCustomComboBox(ComboBox1).Popup.IsOpen := False; end;
  8. Может быть эта информация поможет : http://riversoftavg.com/blogs/index.php/2016/01/17/colorful-text-with-fmx/
  9. mmover

    Ручная анимация прокрутки списка

    Вот, накидал класс который может помочь. unit UAnimHelper; interface uses System.Classes, System.SysUtils, FMX.Types; type TAnimateStep = reference to procedure(Value : Single); TAnimateHelper = class private type TAniInst = class(TFmxObject) private FValue : Single; FStepProc : TAnimateStep; FStopProc : TProc; procedure SetValue(Value : Single); procedure DoAniFinished(Sender: TObject); public constructor Create(AStepProc : TAnimateStep; AStopProc : TProc); published property Value : Single read FValue write SetValue; end; public class procedure DoAnimate(Root : IRoot; // без указания формы анимация работать не будет Duration, FromValue, ToValue : Single; AType: TAnimationType; AInterpolation: TInterpolationType; StepProc : TAnimateStep; StopProc : TProc = nil); end; implementation uses FMX.Ani; constructor TAnimateHelper.TAniInst.Create(AStepProc : TAnimateStep; AStopProc : TProc); begin inherited Create(nil); FStepProc := AStepProc; FStopProc := AStopProc; end; procedure TAnimateHelper.TAniInst.SetValue(Value : Single); begin if Assigned(FStepProc) then FStepProc(Value); end; procedure TAnimateHelper.TAniInst.DoAniFinished(Sender: TObject); begin if Assigned(FStopProc) then FStopProc(); TThread.ForceQueue(nil, procedure begin TAnimation(Sender).TagObject.DisposeOf; end); end; class procedure TAnimateHelper.DoAnimate(Root : IRoot; Duration, FromValue, ToValue : Single; AType: TAnimationType; AInterpolation: TInterpolationType; StepProc : TAnimateStep; StopProc : TProc = nil); var AniInst : TAniInst; Animation: TFloatAnimation; begin AniInst := TAniInst.Create(StepProc,StopProc); AniInst.FValue := FromValue; Animation := TFloatAnimation.Create(nil); Animation.TagObject := AniInst; Animation.Parent := AniInst; Animation.SetRoot(Root); Animation.AnimationType := AType; Animation.Interpolation := AInterpolation; Animation.OnFinish := AniInst.DoAniFinished; Animation.Duration := Duration; Animation.PropertyName := 'Value'; Animation.StartFromCurrent := True; Animation.StopValue := ToValue; Animation.Start; end; end. Пример использования : procedure TForm1.Button3Click(Sender: TObject); begin TAnimateHelper.DoAnimate(Self, 1.2, ListBox1.ViewportPosition.Y , 400, TAnimationType.&In, TInterpolationType.Circular, procedure(Value : Single) begin ListBox1.ViewportPosition := PointF(0,Value); end); end;
  10. mmover

    Окончание скроллинга в ListBox

    Стандартным способом никак (или я плохо искал) Получилось не очень, но работает. (на форме только два ListBox-а) ......... type THackListBox = class(TListBox) public property VScrollBar; end; THackScrollBar = class(TScrollBar) public property Track; end; procedure TForm1.FormShow(Sender: TObject); var i : Integer ; begin for i := 0 to 50 do ListBox1.Items.Add('Item '+ IntToStr(i)); for i := 0 to 50 do ListBox2.Items.Add('Item '+ IntToStr(i)); ListBox1.OnVScrollChange := ListBoxVScrollChange; ListBox2.OnVScrollChange := ListBoxVScrollChange; end; procedure TForm1.EndScrollListBox(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); var ListB : TCustomListBox; C : TFmxObject; begin if Sender is TThumb then if TThumb(Sender).IsPressed then begin ListB := nil; C := TFmxObject(Sender); while C <> nil do begin C := C.Parent; if (C <> nil) and (C is TCustomListBox) then begin ListB := C as TCustomListBox; break; end; end; if ListB <> nil then ShowMessage('End tracking scroll Listbox. Name : '+ ListB.Name); end; end; procedure TForm1.ListBoxVScrollChange(Sender: TObject); begin if Sender is TListBox then if not Assigned(THackScrollBar(THackListBox(Sender).VScrollBar).Track.Thumb.OnMouseUp) then THackScrollBar(THackListBox(Sender).VScrollBar).Track.Thumb.OnMouseUp := EndScrollListBox; end;
  11. mmover

    Узнать дату Android приложения

    Как то так : .... var PackageInfo: JPackageInfo; PackageManager: JPackageManager; Activity: JActivity; begin Activity := TJNativeActivity.Wrap(PANativeActivity(System.DelphiActivity)^.clazz); PackageManager := Activity.getPackageManager; PackageInfo := PackageManager.getPackageInfo(Activity.getPackageName, TJPackageManager.JavaClass.GET_CONFIGURATIONS); Result := PackageInfo.lastUpdateTime; end;
  12. mmover

    Memory TreeView

    Самое простое : https://github.com/davidberneda/GenericTree Сам не пробовал, но давно использую похожую конструкцию.
  13. Примерно так: interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics; type TMyLabel = class(TControl) private FFontTextSettingInfo: TTextSettingsInfo; function GetTextSettings: TTextSettings; procedure SetTextSettings(const Value: TTextSettings); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property LabelFont: TTextSettings read GetTextSettings write SetTextSettings; end; implementation type TMyTextSettings = class (TTextSettingsInfo.TCustomTextSettings) public constructor Create(const AOwner: TPersistent); override; published property Font; property FontColor; property HorzAlign; property VertAlign; // можно убрать ненужные свойства // property WordWrap default True; // property Trimming default TTextTrimming.Character; end; constructor TMyTextSettings.Create(const AOwner: TPersistent); begin inherited; WordWrap := False; Trimming := TTextTrimming.Character; end; constructor TMyLabel.Create(AOwner: TComponent); begin inherited Create(AOwner); FFontTextSettingInfo := TTextSettingsInfo.Create(Self,TMyTextSettings); // FFontTextSettingInfo.TextSettings.FontColor := TAlphaColors.Black; // FFontTextSettingInfo.TextSettings.OnChanged := FontChanged; end; destructor TMyLabel.Destroy; begin FFontTextSettingInfo.Free; inherited Destroy; end; function TMyLabel.GetTextSettings: TTextSettings; begin Result := FFontTextSettingInfo.TextSettings; end; procedure TMyLabel.SetTextSettings(const Value: TTextSettings); begin FFontTextSettingInfo.TextSettings.Assign(Value); end; end.
  14. Я делал так : ... Filt := TBitmapCodecManager.GetFileTypes; FiltExt := TDictionary<string,boolean>.Create; A := Filt.Split([';']); for i := 0 to High(A) do FiltExt.AddOrSetValue(String.LowerCase(A[i].Remove(0,1)),False); ... Files := TDirectory.GetFiles(IncludeTrailingPathDelimiter(DirName),'*.*', function(const Path: string; const SearchRec: TSearchRec): Boolean var SR: TSearchRec; S : String; begin S := String.LowerCase(TPath.GetExtension(SearchRec.Name)); Result := FiltExt.ContainsKey(S); if Result then begin SR := SearchRec; SR.Name := Path + SR.Name; FCurrentDirectoryFiles.Add(SR); end; end); ...