Лидеры

Недавно решил одну проблемку, которая долго мучала - решил поделиться, может кому ещё пригодится. При работе с двумя мониторами или с монитором и проектором часто возникает необходимость запретить окну "исчезать" при наведении курсора мыши на миниатюру другого приложения в панели задач. Чтобы это сделать надо: 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 за наводку

да не... я лучше выложу так.. пилите сами... там не долго все это добавить... класс от TFrame. там не TLayout а TText чтобы можно было настраивать шрифт в designtime. короче ничего сложного. LogViewSource.zip

Как сделать текст с подобными атрибутами? Очень просто! (Цвет текста не работает в 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.

в 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;

Добрый вечер, Такую надпись можно решить несколькими способами в зависимости от дополнительных условий: Будет ли меняться текст надписи или нет? В зависимости от этого есть четыре решения: I. Текст надписи не допускает изменений В этом случае проще всего сделать картинку с этим текстом и использовать ее в вашем приложении. Где нужно отобразить, использовать TImage. II. Текст надписи может изменяться Тут два решения: 1. Используем набор TText или TLabel. Для отображения групп последовательных символов одного цвета используем отдельный контрол TLabel или TText. Каждую группу раскрашиваем требуемым образом через настройки контролов. На скриншотах ниже, я использовал контейнер TLayout и складываю туда несколько объектов TText с выравниванием по левому краю. 2. Рисовать надпись вручную с использование TTextLayout. Этот способ сложнее, но зато универсальнее и эффективнее. Используя TTextLayout по очереди отрисовываем все буквы с нужными цветами и параметрами. 3. На основе решения 2 в этой части, сделать свой компонент.