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

Dozent

Пользователи
 Профиль  Обзор контента

  • Постов

    115

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

  • Посещение

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

    2

 Тип контента 

Сообщения, опубликованные Dozent

    Не правильно подгружается картинка в RunTime

    в TImage

    Опубликовано

     

    Подгрузка изображение ощучествляется в кал-бак функции второстепеного потока, но срабатывает же он из основного) После синхранизации...

    Только если Вы сделаете TThread.Synchronize(TThread.CurrentThread, {тут процедура отрисовки вашего bitmap}) из того самого "второстепенного" потока.

     

     

    создаю поток

    procedure TfrmMain.SetInitializationReadDB(iExerciseId: integer);
begin
  ReadAction := TReadActionFromDB.Create();
  ReadAction.onReadAction := ReadActionDb;
  ReadAction.ExId := iExerciseId;
  ReadAction.Start;
end;

    процедура Exrcute

    procedure TReadActionFromDB.Execute;
var
  qr: ISyncQueryResult;
begin
  try
    fRecordsCount := 0;
    while not Terminated do
    begin
      if ExId > 0 then
      begin
        qr := AppData.Select('log', [TScriptGetParameterHelper.Create('exercise', ExId)]);
        if qr.DataSet.RecordCount > fRecordsCount then
        begin // если появились новые записи
          qr.DataSet.First;
          qr.DataSet.MoveBy(fRecordsCount);
          while not qr.DataSet.Eof do
          begin
            // время события
            fTime := qr.DataSet.FieldByName('VTIME').AsString;;
            // название события
            fActionName := qr.DataSet.FieldByName('DESCRIP_ACTION').AsString;
            // id действия
            if not qr.DataSet.FieldByName('ID_ACTION').IsNull then
              fActionID := qr.DataSet.FieldByName('ID_ACTION').AsInteger
            else
              fActionID := 0;
            // номер записи
            fRecordNumber := qr.DataSet.RecNo;
            // колличество всех записией
            fRecordsCount := qr.DataSet.RecordCount;
            Synchronize(Sync);
            // Queue(Sync);

            // Sleep(100);
            qr.DataSet.Next;
          end;
          // Sleep(500);
        end;
      end;
    end;
  except
    on E: Exception do
      DoReadError(E.ClassName + ' ошибка с сообщением : ' + E.Message);
  end;

end;

    procedure TReadActionFromDB.Sync;
begin
  if Assigned(fonReadAction) then
    fonReadAction(Self, fTime, fActionName, fRecordNumber, fActionID);
end;

    Кал-бак функцию для отрисовки

    procedure TfrmMain.ReadActionDb(Sender: TObject; const sTime, sActionName: string; const RecordNumber, ActionID: integer);
var
  Item: TListBoxItem;
  aFileStream: TFileStream;
  aBitmap: TBitmap;
begin

  Item := TListBoxItem.Create(nil);
  Item.Index := 0;
  // Item.Parent := lbLogActions;
  Item.Height := 60;
  Item.Margins.Top := 10;
  Item.StyleLookup := 'listboxitemaction';
  Item.Tag := ActionID;
  Item.StylesData['timeaction'] := SecToTime(sTime);
  Item.StylesData['labelaction'] := sActionName;
  // Item.StylesData['imageaction'] := '.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png';
  aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
  try
    if (aFileStream.Size > 0) then
    begin
      aBitmap := TBitmap.CreateFromStream(aFileStream);
      Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
      Item.StylesData['imageaction.visible'] := True;
      Item.ItemData.Bitmap.Assign(aBitmap);
    end;
  finally
    FreeAndNil(aFileStream);
  end;
  lbLogActions.InsertObject(0, Item);
end;

    Не правильно подгружается картинка в RunTime

    в TImage

    Опубликовано

    IntToStr(ActionID) - всегда правильное значение? может дело в этом?

     

    Да правильное, бывает просто нужно прокрутить и картинка появится иногда нет) Но метод который помог вам мне не подошёл, мб потому что планшет под виндой. Пока решение не нащёл..

    Не правильно подгружается картинка в RunTime

    в TImage

    Опубликовано · Изменено пользователем Dozent

     

    иногда не подгружаются

    вариант ZuBy тоже не помог? 

    var
 aFileStream: TFileStream;
 aBitmap:     TBitmap;
....
aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
try
  if (aFileStream.Size > 0) then
  begin 
    aBitmap := TBitmap.CreateFromStream(aFileStream);
    Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
    Item.StylesData['imageaction.visible'] := true;
    Item.ItemData.Bitmap.Assign(aBitmap);
  end;
finally
  FreeAndNil(aFileStream);
end;

    буду смотреть работу с ImageList

    Этот вариант предпочтительнее для Вашего примера.

     

     

    К сожалению не помогло...

    Не изменяется картинка

    в TImage

    Опубликовано · Изменено пользователем Dozent

    Добрый день!
     
    Проблема в том что создавал приложение  со статичным изображением человека. Заливал на планшет под виндой 8.0 всё было норм.
     
    Теперь переделываю чтобы эта статичная картинка задышала. Т.е. заливаю туда др картинку с дыркой в груди. На место грудной части кидаю картинку, в неё TBitmapListAnimation в него заливаю спрайт дыхания состоящий из 15 картинок в 3 строки.
     
    На компе запускаю всё прекрасно дышит!!!! Картинка изменяется. Заливаю на планшет! Прикол в том что картинка статична!!! Она не изменилась
     
    Дело даже не в том что анимация не работает, дело в том что картинка не изменилась! Почему я так решил? Потому что картинку дыхания подогнать идеально пока не получилось и там есть зазоры которые не реально не увидеть! Ну так вот этих зазоров на планшете нет!!!!
     
    Т.е. картинка не изменилась! Что может быть?! Пробовал Clean у проекта делать! Пересобирать Build, ехе удалять и тд не помогает)

    post-417-0-46707900-1438522656.jpg

    post-417-0-12016600-1438522731.jpg

    post-417-0-53782800-1438522932.png

    Не правильно подгружается картинка в RunTime

    в TImage

    Опубликовано

    Добрый день!

     

    Суть в проблемы в следующем.

    Создал стиль для TListBoxItem

     

    В RunTime создаю итемы по событию

    procedure TfrmMain.ReadActionDb(Sender: TObject; const sTime, sActionName: string; const RecordNumber, ActionID: integer);
var
  iCurItem: integer;
  Item: TListBoxItem;
begin
  Item := TListBoxItem.Create(nil);
  Item.Index := 0;
  // Item.Parent := lbLogActions;
  Item.Height := 60;
  Item.Margins.Top := 10;
  Item.StyleLookup := 'listboxitemaction';
  Item.Tag := ActionID;
  Item.StylesData['timeaction'] := SecToTime(sTime);
  Item.StylesData['labelaction'] := sActionName;
  Item.StylesData['imageaction'] := '.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png';
  lbLogActions.InsertObject(0, Item);
end;

    Проблема в том что, картинки подгружаются не всегда правильно, могу выскочить просто какие-то артефакты, а может вообще уменьшенная часть экрана не понятно почему)

    Можно видеть на картинке что 2 созданный итем не отобразил картинку

     

    Что не так делаю?

    post-417-0-30623700-1438511335.png

    post-417-0-51846400-1438511672.jpg

    [TImage] Обтекание картинки текстом

    в TImage

    Опубликовано · Изменено пользователем Brovin Yaroslav

    Добрый день! Помню на каком-то из последних семинаров показывали как можно быстро и удобно настроить чтобы текст обтекал картику, напомните плз

    Суть в том что хочу реализовать что бы текст обтекал картинку справа. Т.е. картинка слева вверху, а текст справа и снизу картинки. На одном из последних семинаров показывали как это очень удобно и быстро можно сделать! Забыл!
    Подскажите кто помнит, плз)

    При изменении размеров или положения компонентов на форме всё проподает

    в Стили

    Опубликовано

    У меня также глючить, когда включен какой нибудь Multi-Device Preview, я отключаю их и все, скинь пожалуйста скриншот среды с открытой с боку Multi-Device Preview, может что увижу

    http://clip2net.com/s/3knfusR

    При изменении размеров или положения компонентов на форме всё проподает

    в Стили

    Опубликовано

    Если я правильно понял, то на рабочем столе еще появляется не сворачиваемая отрисовка вашей формы, которая очень напрягает память и скорость работы самой среды, такая фигня в XE8, избавляюсь от неё следующим образом:

    Открыть Delphi, перед открытием вашего проекта создать новый проект MultiDeviceProject, зайти в меню View -> Multi-Device Preview -> в нем кнопочка Select Views to Preview (hint) отключить все превьюхи и закрыть проект не сохраняя, открыть ваш проект и все ок. 

    После перезапуска повторяю данные телодвижения, хз как сохранить.

    Нет! У меня такого нет! Всё сворачивается прекрасно! Вот кидаю наовый компонент на форму всё проподает! нужно зайти в код и опят ьв дизайнер и всё появляется до следующей какойнить манипуляции с компонентами...

    При изменении размеров или положения компонентов на форме всё проподает

    в Стили

    Опубликовано

    Добрый день подскажите как побороть БАГУ!!!!

     

    XE8  стоит только изменить положение компонента или изменить его размер на форме как все элементы на форме становиться на видимыми!!!

     

    Допустим кинул кнопку на форму она сразу не видимая только очертания остаются. Необходимо F12 нажать 2 раза и компоненты появляются! 

     

    Начинаешь что-нить двигать всё пропадает!

     

    Как-то лечится?

    Хранения набора данных

    в Базы данных и REST

    Опубликовано

    НАшёл для себя такой выход
     

    {
"field_names": ["ID", "VNAME", "VPASSWORD", "RROLE", "VDESCRIPTION", "VNAMEE", "USERROLE"],
"data": [
[1, "\u0418\u0432\u0430\u043d\u043e\u0432 \u0418.\u0418.", "123", 1, "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c \u0443\u0447\u0435\u0431\u043d\u043e\u0433\u043e \u0437\u0430\u0432\u0435\u0434\u0435\u043d\u0438\u044f.", "\u0418\u0432\u0430\u043d\u043e\u0432 \u0418.\u0418.", "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c"],
[2, "\u041f\u0435\u0442\u0440\u043e\u0432 \u041f.\u041f.", null, 2, null, "\u041f\u0435\u0442\u0440\u043e\u0432 \u041f.\u041f.", "\u0421\u0442\u0443\u0434\u0435\u043d\u0442"],
[4, "\u041b\u043e\u0433\u0438\u043d\u043e\u0432", "321", 2, "", "\u041b\u043e\u0433\u0438\u043d\u043e\u0432", "\u0421\u0442\u0443\u0434\u0435\u043d\u0442"],
[5, "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c", "123", 1, "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c \u0443\u0447\u0435\u0431\u043d\u043e\u0433\u043e \u0437\u0430\u0432\u0435\u0434\u0435\u043d\u0438\u044f.", "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c", "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c"],
[3, "\u0421\u0438\u0434\u043e\u0440\u043e\u0432 \u0421.\u0421.", "321", 2, "", "\u0421\u0438\u0434\u043e\u0440\u043e\u0432 \u0421.\u0421.", "\u0421\u0442\u0443\u0434\u0435\u043d\u0442"],
[8, "\u0422\u0435\u0441\u04421", "123", 1, "\u0442\u0435\u0441\u0442\u043e\u0432\u044b\u0439 \u043f\u043e\u043b\u044c\u0437\u043e\u0432\u0430\u0442\u0435\u043b\u044c \u043f\u0430\u0440\u043e\u043b\u044c 123", "\u0422\u0435\u0441\u04421", "\u041f\u0440\u0435\u043f\u043e\u0434\u0430\u0432\u0430\u0442\u0435\u043b\u044c"]
]
}


     

    function TAppData.JsonToDataSet(AJSON: string): TDataSet;
var
DataSet: TClientDataSet;
jsObject, jsItemObject: TJSONObject;
jsArr, jsArrData: TJSONArray;
jsValue: TJSONValue;
i, j: integer;
begin
jsObject := TJSONObject.ParseJSONValue(AJSON) as TJSONObject;
try
// поиск и добавление полей
jsArr := jsObject.GetValue('field_names') as TJSONArray;
if Assigned(jsArr) then
begin
DataSet := TClientDataSet.Create(nil);
DataSet.Close; // Очищаем перед началом работы
DataSet.FieldDefs.Clear; // Очищаем если что было в полях
for i := 0 to jsArr.Count - 1 do
begin
DataSet.FieldDefs.Add(jsArr.Items[i].Value, ftString, 50);
end;
DataSet.CreateDataSet;
end;
// добавление данных
jsArr := jsObject.GetValue('data') as TJSONArray;
if Assigned(jsArr) then
begin
for i := 0 to jsArr.Count - 1 do
begin
jsArrData := jsArr.Items[i] as TJSONArray;
DataSet.Append; // побавляем поля
for j := 0 to jsArrData.Count - 1 do
DataSet.Fields[j].Value := jsArrData.Items[j].Value;
DataSet.Post;
end;
end;
Result := DataSet;
except
on e: Exception do
begin
FreeAndNil(jsObject);
DataSet.Free;
raise;
end;
end;
end;
×
×
  • Создать...