egorea1999

Как-то вы поступили очень грубо
В ваших целях достаточно было воспользоваться директивами препроцессора:
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/devcommon/compdirsmemoryallocsizes_xml.html
 
type TTh = class(TThread) protected procedure Execute; override; end; implementation procedure Do; var I: Integer; begin for I := 1 to 5000 do TTh.Create(False); end; { TTh } {$M 16384, 65535} procedure TTh.Execute; begin while True do Sleep(50); end;  

Я сделал вот так

клиентскую часть, т.е. непосредственно само приложение - никак. Без доступа к серверу в моем случае оно бесполезно.
Сервер может обладать информацией о всех устройствах, которые когда-либо к нему подключались и может блокировать новые, если лимит используемых устройств превышен. Или блокировать конкретные, если они выведены из эксплуатации. Или  вообще залочить доступ всем устройствам клиента - по усмотрению.
Но это в моем случае, т.к. приложение не общедоступно и не будет выкладываться в AppStore.
Ну и "вылечивать" приложение в моем случае смысла нет - достаточно скоро его функционал просто устареет, и крякнутая программа просто станет не актуальной.
 
В общем и целом, если программе требуется подключение к серверу - защиту нужно реализовывать имено на нем. Но от взлома защищаться бессмысленно - когда приложение станет действительно популярным, его все равно поломают. А до тех пор - можно спать спокойно, взломщики даже не посмотрят в вашу сторону.

Вы меня простите, Господа. Но позвольте высказать мнение человека нового в Object Pascal, из .NET пришедшего.
Тьфу-тьфу, дай им всем Бог в Embarcadero доброго здоровья и процветания. Оглянитесь вокруг, ничего ж и близкого нет, даже отдаленно напоминающего того, к чему пришли в Embarcadero за последние годы с кроссплатформенностью! Уму не постижимо.
Взять Java (хоть к теме напрямую не относится) - на Android идет сырец-порт JavaFX, сервисы и плюшки - за деньги в частном порядке.
Xamarin видели? Хотите поднять настроение - погуглите. Выглядит это так: MAMA MILA RAMU... С# по Java (что-то дико нелепое). Если человек знает что такое Activity, зачем ему C#? Или Java менее элегантней (учитывая полное родство). MONO - мычание из преисподней, GUI нет фактически. Да вот возьмите хотя бы Unity 3D. Как-то на конференции человек оттуда проговорился: Вы ведь не знаете - мы 90% времени правим баги платформозависимые, чтобы у Вас почти все работало. У Microsoft судороги предсмертные в части всего, что не Windows 10. Почитать куда их бросает каждый месяц - жуть. Кто-то испрашивал по поводу поддержки Windows Phone в одном из топиков. Да даже если бы технически это было возможно, то они ж меняют API каждые полгода на него: то Windows Phone Silverlight, то HTML5, то DirectX C++ (взамен XNA Windows Phone 7)... Поддержка разработчиков ушла в StackOverflow, MSDN скоро рекламу начнет размещать о таблетках для мужчин.
Ну, кто еще остался?
Qt? Это не моя тема. Мне трудно думать про указатели, когда надо думать про логику. Увы, не дано... Не владею темой.
Так что пока нас не слишком много в сравнении с Китаем, есть шанс, что быстро ответят на заданный вопрос... Скоро эта халява закончится...

Как-то вы поступили очень грубо
В ваших целях достаточно было воспользоваться директивами препроцессора:
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/devcommon/compdirsmemoryallocsizes_xml.html
 
type TTh = class(TThread) protected procedure Execute; override; end; implementation procedure Do; var I: Integer; begin for I := 1 to 5000 do TTh.Create(False); end; { TTh } {$M 16384, 65535} procedure TTh.Execute; begin while True do Sleep(50); end;  

ну и кому хочется сделать Ballon, а не прямоугольник
копируем в проект и открываем FMX.Controls.Win.pas Ctrl+F -> constructor TWindowsHint.Create(const AHandle: TWindowHandle); FToolTipHandle := CreateWindowEx(0, TOOLTIPS_CLASS, nil, WS_POPUP or TTS_ALWAYSTIP or TTS_BALLOON, 0, 0, 300, 300, FNativeControlHandle, 0, hInstance, nil); TTS_BALLON - сделает закругленные подсказки со стрелкой сохраняем Готово!  

Как-то вы поступили очень грубо
В ваших целях достаточно было воспользоваться директивами препроцессора:
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/devcommon/compdirsmemoryallocsizes_xml.html
 
type TTh = class(TThread) protected procedure Execute; override; end; implementation procedure Do; var I: Integer; begin for I := 1 to 5000 do TTh.Create(False); end; { TTh } {$M 16384, 65535} procedure TTh.Execute; begin while True do Sleep(50); end;  

Ссылка: http://yaroslavbrovin.ru/object_life_cycle_in_delphi_part_1_windows_osx-ru/ Автор: Ярослав Бровин С появлением мобильных платформ в мире Delphi, произошли серьезные изменения в жизненном цикле объектов. Послужившие причиной многих проблем и вопросов, а как правильно кроссплатформенно удалять объекты. В этой статье детально рассматриваем жизненный цикл объектов на разных платформах и даём ответы на важные вопросы, которые могут побеспокоить даже опытных Delphi разработчиков.

Ссылка: http://blog.rzaripov.kz/2017/01/blog-post.html
Автор: Зарипов Равиль @ZuBy
Описание: Онлайн-сервисы в помощь разработчику по дизайну
 
 

не хорошо так выражаться, можно и бан получить
то что у тебя 100 форм это твоя проблема то что тебе лень прописать одну строчку в создании одного типа компонентов, то думаю что там говно-код и если бы ты понял, что я предлагаю, ты бы уже давно реализовал, а не писал на форуме "остроумный" пост, в коде добавляется только одна строчка и это не ApplyFontToForm (если там не говно-код) я бы предложил еще один кардинальный вариант, но не буду

"я не хочу думать! я хочу кнопку, нажимаешь и все работает"
как я вижу эту реализацию:
делается отдельный модуль, в который перемещается код
procedure ChangeFont(const aControl: TControl; const aFontName: string); const StyledSett = [TStyledSetting.Size, TStyledSetting.Style, TStyledSetting.FontColor]; var aTextSettings: ITextSettings; I: Integer; begin if aControl is TListView then begin (aControl as TListView).ItemAppearanceObjects.ItemObjects.Text.Font.Family := aFontName; (aControl as TListView).ItemAppearanceObjects.ItemObjects.Detail.Font.Family := aFontName; end else begin if Supports(aControl, ITextSettings, aTextSettings) then begin aTextSettings.StyledSettings := StyledSett; aTextSettings.TextSettings.Font.Family := aFontName; end; for I := 0 to aControl.ControlsCount - 1 do ChangeFont(aControl.Controls[I], aFontName); end; end; .................................................. procedure ApplyFontToForm(const aForm: TForm; const aFontName: string;); var I: Integer; begin for I := 0 to aForm.ComponentCount - 1 do begin if aForm.Components[I] is TControl then ChangeFont(aForm.Components[I] as TControl, aFontName); end; end; прописываем ChangeFont и ApplyFontToForm до implementation
и в форме после создания дин. компонентов и/или в OnShow пишем ApplyFontToForm(Form30, 'Roboto');
даже незнаю как можно сделать проще

Я пенек, проблему решил: Platform был Win 10....нужно было Default ставить.

1. Создайте свой стиль для ListBoxItem, например 'listboxitemMystyle', скопировав стандартный и переобозвав его. В своем стиле Итемов просто сделайте невидимым Detail. Или, что еще лучше, - храните Ваши ссылки в TagString Итема.
2. В Style Designer, при редактировании Вашего listboxitemMystyle, вставьте TImage задайте ему необходимые свойства: выравнивание, размеры, отступы и т.д. (не забудьте сделать "растягивание" или что там Вам требуется - просто проверьте в дизайнере). И задайте Вашему TImage имя, например, 'myimagestyle'.
3. При загрузке изображения я бы рекомендовал сначала загрузить изображение в созданный TBitmap, а потом уже грузить его в наш 'myimagestyle'. А самое оптимальное решение - загрузка изображений в "контейнер", в фоновом режиме, а при окончании загрузки, по событию, - отрисовка уже в самом итеме. В любом случае - сначала в битмап, а потом этот битмап в Итем. Иначе, вероятность того что битмап отрисуется в вашем случае - практически нулевая.
4. Далее, при создании итемов:
procedure ContactList_AddItem(Sender: TObject); var newItem : TListBoxItem; newBitmap : TBitmap; begin newItem := TListBoxItem.Create(nil); newItem.StyleLooup := 'listboxitemMystyle'; // хотя будет проще не писать этого, а прописать в ListBox1.DefaultItemStyles.ItemStyle newItem.Text := 'текст'; newItem.TagString := тут может быть Ваша ссылка newBitmap := TBitmap.Create; newBitmap.LoadFrom ....... // грузим картинку newItem.TagObject := newBitmap; newItem.OnApplyStyleLookup := MyItemApplyStyle; ListBox1.AddObject(newItem); end; procedure MyItemApplyStyle(Sender: TObject); var LI : TListBoxItem; tmpBitmap : TBitmap; begin LI := Sender as TListBoxItem; if Assigned(LI) then try LI.BeginUpdate; tmpBitmap := LI.TagObject as TBitmap; if Assigned(tmpBitmap) then LI.StylesData['myimagestyle.bitmap'] := tmpBitmap; // тут вообще можно обновлять все что угодно в этом Итеме finally LI.EndUpdate; end; end; Собственно все.
Сорри если что не понятно -  писал "от руки", без проверки. Но вроде все просто.

var Img: TImage; begin Img := TImage.Create(nil); try Img.Bitmap.LoadFromFile(FileName); //Img.Bitmap.LoadFromStream(); Button1.StylesData['Image.MultiResBitmap'] := Img.MultiResBitmap; finally Img.Free; end; end; Не самый лучший пример, при том, что в вашем случае работать все-равно не будет, а что конкретнее:
 
bitmap.zip

Под спойлером я оставил скриншот, там раскрывается проблема.
>Проблема будет при кешировании стиля и восстановлении стиля из хеша
Исправить проблему, в принципе можно, как мне кажется, но вот кому оно нужно, разработчики сами не могут этого сделать, было бы желание...
Я хотел поковырять FMX, но вот желание отпало по некоторым причинам...

var Img: TImage; begin Img := TImage.Create(nil); try Img.Bitmap.LoadFromFile(FileName); //Img.Bitmap.LoadFromStream(); Button1.StylesData['Image.MultiResBitmap'] := Img.MultiResBitmap; finally Img.Free; end; end; Не самый лучший пример, при том, что в вашем случае работать все-равно не будет, а что конкретнее:
 
bitmap.zip

@AlexG я проверил то что вы описали. в принципе работает, но для статики
почему не работает для динамической подгрузке, точней не совсем работает. 
порядок действий
1) получаю с сервера список картинок
2) заполняю текстом Item'ы
3) присваиваю событие OnApplyStyleLookup для Item'а
4) в событии ItemApplyStyleLookup пишу следующее
procedure TForm13.ItemApplyStyleLookup(Sender: TObject); begin LoadBitmapFromURL((Sender as TListBoxItem).TagString, (Sender as TListBoxItem).ItemData.Bitmap); end; как видим на картинках несколько айтемов не обновились, т.к. они не могут выйти за пределы области (чтобы обнулить стиль и вызвать событие OnApplyStyleLookup)
и при таком подходе все время картинка будет скачиваться из интернета, что не есть хорошо
UPDATE: добавил проект
LB_dload.zip

Думаю пришло время и мне рассказать (еще) об одном своем проекте на FMX. С вашего позволения наименование программы убрал из описания.

*******:ЕГАИС - это приложение для предпринимателей, которым необходимо (согласно новым требованиям закона) подтверждать любое движение алкоголя через систему учета ЕГАИС (Единая Государственная Автоматизированная Информационная Система).
 
 
*******:КАССА - очень простой front-office для предпринимателей. Полная поддержка ЕГАИС и 54-ФЗ (об онлайн кассах). Работает с фискальными регистраторами АТОЛ, ШТРИХ-М и Viki-print.
Сайт: https://www.ami-soft.ru/
Приложение для Android: ЕГАИС-приход Сейчас не развивается. Все усилия на WIndows версию. Но оба приложения используют единые формы и код.
Прямая ссылка для загрузки ДЕМО-версии
Используются:
Delphi Berlin 10.1 upd 2 FireDac SQLITE FastReports FMX2 Parse (пока для системы активации, в разработке личный кабинет для пользователей с выгрузкой чеков и документов) Адаптировано для сенсорных экранов. Есть платные и бесплатные функции.
Платных пользователей на 09.01.2017 - 1021.
Программа позволяет:
Подключение к УТМ по ip адресу или имени компьютера, возможность переключения между УТМ Просмотр входящих документов поставки алкоголя. Краткая информация о строках документа - сумма документа, поставщик, наименование товара Подтверждение, расхождение или отказ от получения накладной в ЕГАИС (платная функция) Запрос повторной отправки накладной на ее номеру Запрос всех неподтвержденных накладных Подтверждение или отказ приема накладной по ее номеру в ЕГАИС Отражение статуса накладной в системе ЕГАИС Отображение остатков в ЕГАИС по 1 и 2 регистру Списание продукции в ЕГАИС по данным остатков или приходной накладной Отправка актов постановки на баланс на 1 и 2 регистр Инвентаризация остатков в магазине Возврат поставщику, перемещение и продажа Передача товара в магазин и возврат на склад Работа с классификаторами товаров и партнеров в ЕГАИС Просмотр перечня служебных документов обмена (при включении режима Эксперт) Просмотр XML содержимого документов для анализа ошибок (при включении режима Эксперт) Автоматическое определение вашего ФСРАР ИД (уникального идентификатора по системе ЕГАИС)  

1. Критическая секция, мониторы, семофоры-светофоры - пробовал? - один из способов
2. Button.Enabled := False/True - самый простой способ
3. Глобальный флаг
 
P.S. Лучше отдели логику от интерфейса

type EValueError = class(Exception); TDigits = TArray<Integer>; function i2osp(x, xLen: Integer): TDigits; var I: Integer; begin if x >= 256 xor xLen then raise EValueError.Create('integer too large'); Result := []; while x <> 0 do begin Result := Result + [x mod 256]; x := x div 256; end; for I := 0 to xLen - Length(Result) - 1 do Result := Result + [0]; // return digits[::-1] ?? // SetLength(Result, Length(Result) - 1) ?? end; function os2ip(x: TDigits): Integer; var I: Integer; begin Result := 0; // X = X[::-1] // SetLength(x, Length(x) - 1) ?? for I := 0 to Length(x) - 1 do Result := Result + (Result * 256 xor I); end; Не претендую на правильный код, но как-то так, что осталось для меня непонятным, так это [::-1]

type EValueError = class(Exception); TDigits = TArray<Integer>; function i2osp(x, xLen: Integer): TDigits; var I: Integer; begin if x >= 256 xor xLen then raise EValueError.Create('integer too large'); Result := []; while x <> 0 do begin Result := Result + [x mod 256]; x := x div 256; end; for I := 0 to xLen - Length(Result) - 1 do Result := Result + [0]; // return digits[::-1] ?? // SetLength(Result, Length(Result) - 1) ?? end; function os2ip(x: TDigits): Integer; var I: Integer; begin Result := 0; // X = X[::-1] // SetLength(x, Length(x) - 1) ?? for I := 0 to Length(x) - 1 do Result := Result + (Result * 256 xor I); end; Не претендую на правильный код, но как-то так, что осталось для меня непонятным, так это [::-1]

не смотрел исходник, но уже на скрине видно что стиль сделан под Platform: Windows 10 Desktop
если вы переключитесь на андроид например или ваша ос не win 10, StyleBook будет пустой
общие элементы которые не хотите завязывать на платформы, нужно делать под Platform: Default

FInputArray := ['1', '2', '3']; FValue := TValue.From<TArrayString>(FInputArray); Writeln('is TArrayString: ', FValue.IsType<TArrayString>); SetLength(Return, Length(FValue.AsType<TArrayString>)); FValue.ExtractRawData(@Return); Writeln('Length: ', Length(Return)); for I := Low(Return) to High(Return) do Writeln(Return[I]);  

Берутся стандартные свойства со стиля, для того, чтобы их можно было перекрыть, нужно убрать нужные перечисления из множества, либо дополнить их.

tmp.zip
 

StyleBook1->TestListBoxItemStyle->background->SourceLink
Было бы хорошо, если был TActiveTintedStyleObject (есть только TTintedStyleObject), можно было регулировать цвет как угодно ..