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

slav_z

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

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

  • Посещение

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

    33

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

  1. Like
    slav_z получил реакцию от Евгений Корепов в Проверить существование TJSONObject   
    Да нормально работает на XE8 и 10.3
    procedure TForm6.Button1Click(Sender: TObject); var A: TJSONObject; begin A := TJSONObject(TJSONObject.ParseJSONValue('здесь неправильный json')); if Assigned(A) then A.ToString; end;
  2. Like
    slav_z получил реакцию от Ingalime в Не отображается текст   
    попробуйте указать цвет и вид заполнения...  Canvas.Fill.Color и Canvas.Fill.Kind  (текст - это заливка... поэтому Fill)
  3. Thanks
    slav_z получил реакцию от Владимир Б. в TMemo для вывода лога тормозит   
    выделение только построчное (одна строка или несколько). Выделение по символам - это сложнее. тоже можно, но в 100$ не влезет. посмотрите во вложении EXE. если устроит, то выложу исходники (лично или прям сюда) и только потом 100$ если все устроит. если не устроит - тогда все отдам бесплатно (сюда).
     
    Использование:
     
    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.Controls.Presentation, FMX.StdCtrls, Frame.Log; type TForm5 = class(TForm) LogFrame1: TLogFrame; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form5: TForm5; implementation {$R *.fmx} procedure TForm5.FormCreate(Sender: TObject); begin LogFrame1.ReleasedItems:=False; // не удалять "старые" строки end; procedure TForm5.Button2Click(Sender: TObject); begin LogFrame1.Add('One item'); LogFrame1.ScrollTo(MaxInt); end; procedure TForm5.Button3Click(Sender: TObject); begin LogFrame1.Clear; end; procedure TForm5.Button4Click(Sender: TObject); begin LogFrame1.CopyToClipboard; end; procedure TForm5.Button1Click(Sender: TObject); var I: Integer; begin LogFrame1.BeginUpdate; try for I:=0 to 100000 do LogFrame1.Add('Item '+I.ToString); finally LogFrame1.EndUpdate; end; LogFrame1.ScrollTo(MaxInt); end; end.  
    LogViewExe.zip
  4. Like
    slav_z получил реакцию от Ingalime в Ошибка при выводе на печать   
    вылет с ошибкой? какой? или вылет по return ?
    ActivePrinter   не  nil (null) ?
  5. Haha
    slav_z получил реакцию от Yarpda в Как убить кнопку кликнув на нее саму   
    теперь все понятно. спасибо.
  6. Haha
    slav_z получил реакцию от #WAMACO в Как убить кнопку кликнув на нее саму   
    замени TFrame13.Create(nil) на TFrame13.Create(Self) только ради бога не спрашивай зачем... проверка на дублирование имени выполняется родителем... а он у тебя nil.
  7. Like
    slav_z отреагировална dnekrasov в [Windows] Запретить окну переход в прозрачный режим   
    Недавно решил одну проблемку, которая долго мучала - решил поделиться, может кому ещё пригодится.
    При работе с двумя мониторами или с монитором и проектором часто возникает необходимость запретить окну "исчезать" при наведении курсора мыши на миниатюру другого приложения в панели задач. Чтобы это сделать надо:
    uses ... Winapi.DwmApi ... TMainForm = class(TForm) ... protected procedure CreateHandle; override; ... end; ... procedure TMainForm.CreateHandle; var Val, Res: Integer; begin inherited CreateHandle; Val := 1; Res := DwmSetWindowAttribute(FormToHWND(Self), DWMWA_EXCLUDED_FROM_PEEK, @Val, SizeOf(Val)); {$IFDEF DEBUG} if Res <> S_OK then ShowMessage(SysErrorMessage(Res)); {$ENDIF} end; Спасибо @Alex7wrt за наводку
  8. Haha
    slav_z получил реакцию от Barbanel в Как убить кнопку кликнув на нее саму   
    теперь все понятно. спасибо.
  9. Like
    slav_z получил реакцию от Ingalime в Как убить кнопку кликнув на нее саму   
    Намного проще оставить в покое метод Release.
  10. Thanks
    slav_z получил реакцию от Шамсуддин в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  11. Like
    slav_z получил реакцию от Mars M в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  12. Like
    slav_z получил реакцию от Barbanel в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  13. Thanks
    slav_z получил реакцию от Дмитрий Ш. в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  14. Like
    slav_z получил реакцию от sinuke в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  15. Thanks
    slav_z получил реакцию от Tumaso в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  16. Like
    slav_z получил реакцию от Евгений Корепов в Как сделать буквы разного цвета?   
    http://fire-monkey.ru/topic/5437-работа-с-атрибутами-текста/
  17. Like
    slav_z получил реакцию от Yarpda в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  18. Like
    slav_z получил реакцию от Alex7wrt в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  19. Like
    slav_z получил реакцию от Barbanel в TMemo для вывода лога тормозит   
    да не...  я лучше выложу так..  пилите сами... там не долго все это добавить...
    класс от TFrame. там не TLayout а TText чтобы можно было настраивать шрифт в designtime.
    короче ничего сложного.
    LogViewSource.zip
  20. Like
    slav_z получил реакцию от Ingalime в Как убить кнопку кликнув на нее саму   
    в XE8 как раз и было реализовано через помещение в объект TPurgatory. (удален из 10)
    он как раз и помещал объект к себе в список и удалял "чуть позже" по таймеру (через 10 мс).
    unit FMX.Types; type TPurgatory = class (TComponent) public const TimerInterval: Integer = 10; private FInstanceList: TList<Pointer>; FTimerHandle: TFMXHandle; FPlatformTimer: IFMXTimerService; procedure StartTimer; procedure StopTimer; procedure TimerProc; procedure UpdateTimer; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; procedure Add(const Instance: TFmxObject); procedure Remove(const Instance: TFmxObject); function Contains(const Instance: TFmxObject): Boolean; end;  
  21. Like
    slav_z получил реакцию от dnekrasov в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  22. Thanks
    slav_z получил реакцию от Nick Peterson в TMemo для вывода лога тормозит   
    да не...  я лучше выложу так..  пилите сами... там не долго все это добавить...
    класс от TFrame. там не TLayout а TText чтобы можно было настраивать шрифт в designtime.
    короче ничего сложного.
    LogViewSource.zip
  23. Thanks
    slav_z получил реакцию от Евгений Корепов в Работа с атрибутами текста   
    Как сделать текст с подобными атрибутами? Очень просто!
    (Цвет текста не работает в XE8) Вот весь код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout; type TForm1 = class(TForm) Button1: TButton; Text1: TText; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} type TTextAccess = class(TText); procedure ClearTextAttribute(Text: TText); begin TTextAccess(Text).Layout.ClearAttributes; end; procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor); var Font: TFont; begin Font:=TFont.Create; Font.Assign(Text.Font); Font.Style:=FontStyles; TTextAccess(Text).Layout.AddAttribute( TTextRange.Create(Pos,Length), TTextAttribute.Create(Font,FontColor)); end; procedure TForm1.Button1Click(Sender: TObject); begin AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed); AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue); AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen); Text1.Repaint; end; end.  
  24. Thanks
    slav_z получил реакцию от #WAMACO в TMemo для вывода лога тормозит   
    возьмите TVertScrollBox, положите в него TLayout (align=top) храните строки в TStringList, вычисляйте высоту TLayout при добавлении строк. на событие TLayout.OnPaint рисуйте нужный диапазон строк (Canvas.FillText) опираясь на позицию Viewport скроллбокса. все будет летать.
×
×
  • Создать...