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

Morfi

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

  • Постов

    35

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

  • Посещение

 Тип контента 

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

    Срабатывает OnClick на ListBox при скроллинге

    в TListBox

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

    В 15.02.2020 в 17:36, slav_z сказал:

    OnTap лучше не используйте, я бы сделал на обычный OnClick... перед вызовом действий, связанных с элементами списка (ваши ShowMessage 1,  ShowMessage 2 ), просто проверьте "а не прокручивается ли сейчас listbox (scrollbox)" с помощью ListBox.AniCalculations.Moved...

    Не могли бы аргументировать, почему лучше не использовать OnTap?

    10.2 Столбцы с combobox'aми

    в TGrid

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

    В 12.11.2018 в 11:39, d.OnizZz сказал:

    При переходе с 10.0 на 10.2 стал недоступен метод у TColumn CreateCellControl
    И как теперь сделать реализацию с столбцом combobox ?

    Для начала реализуем наследника TComboBox (для переопределения методов GetData, SetData): 

    implementation
  
type
  TComboBoxCell = class(TComboBox)
  private
    FOldValue: TValue;
    FInSetData: boolean;
  protected
    constructor Create(AOwner: TComponent); override;
    function GetData: TValue; override;
    procedure SetData(const Value: TValue); override;
  end;

{ TComboBoxCell }

constructor TComboBoxCell.Create(AOwner: TComponent);
begin
  inherited;
  FInSetData := false;
end;

function TComboBoxCell.GetData: TValue;
begin
  If ItemIndex = -1 then
    result := FOldValue
  else
    result := Items[ItemIndex];
end;

procedure TComboBoxCell.SetData(const Value: TValue);
var
  S: string;
  LIndex: integer;
begin
  if not FInSetData then
    try
      FInSetData := True;
      FOldValue := Value;
      if FOldValue.IsEmpty then
        ItemIndex := -1
      else if FOldValue.TryAsType<string>(S) then
      begin
        LIndex := Items.IndexOf(Value.ToString);
        if LIndex >= 0 then
          ItemIndex := LIndex;
      end
      else
        inherited;
    finally
      FInSetData := False;
    end;
end;

    После чего опишем действие на событие TGrid.OnCreateCustomEditor: 

    procedure TForm.FMXGridCreateCustomEditor(Sender: TObject;
  const Column: TColumn; var Control: TStyledControl);
var
  tmpCombo: TCombobox;
begin
  //Вызываем кастомный редактор для конкретного столбца
  if Column.Header.Equals('CategoryName') then begin
    tmpCombo := TComboBoxCell.Create(nil);
    tmpCombo.OnChange  := DoOnChangeCustomEditor;
    tmpCombo.TagObject := Column;

    tmpCombo.Items.Add('Item1');
    tmpCombo.Items.Add('Item2');
    tmpCombo.Items.Add('Item3');
     
    Control := tmpCombo;
  end;
end;

    И последнее, опишем событие OnChange нашего редактора: 

    procedure TForm.DoOnChangeCustomEditor(Sender: TObject);
var
  Column: TColumn;
begin
  Column := TColumn(TCombobox(Sender).TagObject);
  TCombobox(Sender).Data := TCombobox(Sender).Selected.Text;
  Column.EditorModified;
end;

     

    Как правильно наследоваться от TCustomGrid ?

    в TGrid

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

    Доброго времени суток.

    Нашел проблему при написании кастомного грида, который наследуется от TCustomGrid:

    При использовании LiveBindings  между кастомным гридом и набором данных, после закрытия среды вываливается AV:

    AV.png.ecdfe06687e4a362f93941d216c4a02e.png

     

    CustomGrid.thumb.png.c225d248bb0dad4525ae922da0d51153.png

     

    Подскажите, что я упустил?

     

    Минимальный код кастомного грида:

    Спойлер

      

    
unit Simple.FMX.DBGridTest;

interface

uses
  FMX.Grid, System.Classes;

type
  TCustomFMXGrid = class(TCustomGrid)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  end;

  TFMXGrid = class(TCustomFMXGrid)
  protected
    function GetDefaultStyleLookupName: string; override;
    procedure DoEndUpdate; override;
  published
    property Anchors;
    property Align;
    property CanFocus;
    property CanParentFocus;
    property ClipChildren;
    property ClipParent;
    property ControlType;
    property Cursor;
    property DisableFocusEffect;
    property DragMode;
    property EnableDragHighlight;
    property Enabled;
    property Height;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property HitTest;
    property Locked;
    property Padding;
    property Opacity;
    property Margins;
    property PopupMenu;
    property Position;
    property ReadOnly;
    property RotationAngle;
    property RotationCenter;
    property Scale;
    property Size;
    property StyleLookup;
    property TextSettings;
    property StyledSettings;
    property TabOrder;
    property TabStop;
    property TouchTargetExpansion;
    property Visible;
    property Width;
    property RowHeight;
    property RowCount;
    property Options;
    property Images;

    property DefaultDrawing;
    property OnHeaderClick;
    property OnColumnMoved;
    property OnDrawColumnHeader;
    property OnSelectCell;
    property OnSelChanged;
    property OnDrawColumnBackground;
    property OnDrawColumnCell;
    property OnGetValue;
    property OnSetValue;
    property OnCreateCustomEditor;
    property OnEditingDone;
    property OnResize;
    property OnResized;
    property OnCellClick;
    property OnCellDblClick;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;
  end;

procedure Register;

implementation

uses
  FMX.Styles, FMX.Presentation.Factory, FMX.Presentation.Style, FMX.Grid.Style,
  FMX.Controls, FMX.Types;

procedure Register;
begin
  RegisterComponents('Simple', [TFMXGrid]);
end;


{ TCustomFMXGrid }

constructor TCustomFMXGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

end;

destructor TCustomFMXGrid.Destroy;
begin

  inherited;
end;

{ TFMXGrid }

procedure TFMXGrid.DoEndUpdate;
begin
  Model.ClearCache;
  inherited;
end;

function TFMXGrid.GetDefaultStyleLookupName: string;
begin
  result := 'gridstyle';
end;

initialization
  TPresentationProxyFactory.Current.Register(TCustomFMXGrid, TControlType.Styled, TStyledPresentationProxy<TStyledGrid>);
  TPresentationProxyFactory.Current.Register(TFMXGrid, TControlType.Styled, TStyledPresentationProxy<TStyledGrid>);

  TColumnClasses.Register([TColumn, TStringColumn, TProgressColumn, TCheckColumn, TDateColumn, TTimeColumn, TPopupColumn,
  TImageColumn, TCurrencyColumn, TFloatColumn, TIntegerColumn, TGlyphColumn]);

  RegisterFmxClasses([TFMXGrid]);
finalization
  TColumnClasses.UnRegister([TColumn, TStringColumn, TProgressColumn, TCheckColumn, TDateColumn, TTimeColumn, TPopupColumn,
  TImageColumn, TCurrencyColumn, TFloatColumn, TIntegerColumn, TGlyphColumn]);

  TPresentationProxyFactory.Current.Unregister(TFMXGrid, TControlType.Styled, TStyledPresentationProxy<TStyledGrid>);
  TPresentationProxyFactory.Current.Unregister(TCustomFMXGrid, TControlType.Styled, TStyledPresentationProxy<TStyledGrid>);

end.

     

    Стилизованный выпадающий список

    в Стилизация

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

    Столкнулся с такой проблемой:

    Есть форма с TComboBox. Стиль форме (один из тех, который поставляется из коробки) задаю в run-time: 

    procedure TFormEditorRoomAttribute.FormCreate(Sender: TObject);
begin
  inherited;
  self.StyleBook := uAccommodationInventory.ReferenceAccommodationInventoryForm.StyleBook;
end;

    Необходимо, чтобы TComboBox отображал items c bitmap. Заполняю TComboBox.ListBox так же в run-time (TListBoxItem.StyleLookup := 'listboxitemleftdetail'): 

    var
  I: integer;
  FListBoxItem: TListBoxItem;
begin
  //cbPicture: TCombobox;
  Self.cbPicture.BeginUpdate;

  Self.FRoomAttributePictures := ConnectionModule.DSServerModuleAccommodationClient.GetRoomAttributePictures;
  for I := 0 to Self.FRoomAttributePictures.Count - 1
  do
    begin
      FListBoxItem := TListBoxItem.Create(Self.cbPicture);
      FListBoxItem.TagObject:= Self.FRoomAttributePictures[i];

      FListBoxItem.ItemData.Text := Self.FRoomAttributePictures[i].ID.ToString;
      FListBoxItem.ItemData.Bitmap := Self.FRoomAttributePictures[i].GetBitmap;
      FListBoxItem.StyleLookup := 'listboxitemleftdetail';
      Self.cbPicture.AddObject(FListBoxItem);
    end;
  Self.cbPicture.EndUpdate;
end;

    TComboBox.DropDownKind выставляю в "Custom".
    Вроде как всё готово. Но получается вот такая картина.

    Создаю и отображаю форму, bitmap в TCombobox отображен:
    0001.png.bf0853437e25d59afe15edf28d6b2f33.png

    Раскрываю список, bitmaps так же отображаются:
    0002.png.1009cda5894b9dbbb7fbbfdff83ec01f.png

    Но, как только выбираю один из items, происходит следующее:
    0003.png.ed5d07f9a77f609986a9b7bd2090c83e.png
    выбранный item не отображается, вообще!

    Долго ли, мало ли копался в исходниках TCombobox...

    В общем нашел некоторое решение данной проблемы. На событие TComboBox.OnClosePopup повесил код: 

    begin
  //cbPicture: TCombobox;
  self.cbPicture.Selected.NeedStyleLookup;
  self.cbPicture.NeedStyleLookup;
  self.ApplyStyleLookup;
end;

    Результат, выбранный item отображается в TCombobox:
    0004.png.2b2db7974dd335b63980b0f4cbf11aac.png

     

    Теперь вопрос: Так и должно отрабатывать? Или что-то делаю не так?! Если что-то делаю не так, то как надо делать?

    TList<TMyObject>

    в DataSnap

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

    Подскажите, пожалуйста, как реализовать серверный метод, который должен выдать TList<TMyObject> ?

    Имеется в виду, что бы на стороне клиента получилось бы так: 

    var
FResult: TList<TMyObject>;
begin
  //...
  FResult := MyServerMethod; //Серверный метод, который возвращает TList<TMyObject>
  //...
end;

     

    Проблема в реализации PBKDF2-SHA1 средствами INDY(TIdHMACSHA1)

    в Решаемые задачи

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

    Здравствуйте!

    Пытаюсь реализовать алгоритм PBKDF2-SHA1. Для вычисления HMAC-SHA1 использую класс TidHMACSHA1.

    Код PBKDF2-SHA1 нашел на просторах интернета и немного подкорректировал для использования с INDY (TidHMACSHA1): 

    function PBKDF2Sha1(pass, salt: string; count, kLen: Integer): string;

  function IntX(i: Integer): string; inline;
  begin
    Result := Char(i shr 24) + Char(i shr 16) + Char(i shr 8) + Char(i);
  end;

var
  D, I, J: Integer;
  T, F, U, wPass: TIdBytes;
begin
  wPass := ToBytes(pass);
  D := Ceil(kLen / (160 div 8));
  for i := 1 to D do
  begin
    F := EncryptHMACSha1(ToBytes(salt + IntX(i)), wPass);
    U := F;
    for j := 2 to count do
    begin
      U := EncryptHMACSha1(U, wPass); //<-- Проблема
      F := XorBlock(F, U);
    end;
    T := T + F;
  end;
  Result := ToHex(Copy(T, 1, kLen));
end;

    Для вычисления HMAC-SHA1 используется функция EncryptHMACSha1: 

    function EncryptHMACSha1(Input, AKey: TIdBytes): TIdBytes;
var
  HMachSha1: TIdHMACSHA1;
begin
  HMachSha1 := TIdHMACSHA1.Create;
   try
     HMachSha1.Key := AKey;
     Result := HMachSha1.HashValue(Input);
   finally
     HMachSha1.Free;
   end;
end;

    Возникает проблема, когда эта функция используется 6-й раз в функции PBKDF2Sha1: 

    for i := 1 to D do // D := 2
  begin
    F := EncryptHMACSha1(ToBytes(salt + IntX(i)), wPass); // Использование функции (разы): 1-й, 4-й
    U := F;
    for j := 2 to count do // count := 3
    begin
      U := EncryptHMACSha1(U, wPass); // <--Проблема! Использование функции (разы): 2-й, 3-й, 5-й, !6-й!
      F := XorBlock(F, U);
    end;
    T := T + F;
  end;

    Возникает исключение в глубинах INDY-кода:

    error.jpg

    а точнее в функции TIdHashSHA1.NativeGetHashBytes (файл: idHashSHA,pas) на строке с кодом: 

    SetLength(Result, SizeOf(UInt32)*5); // в файле строка под номером 460

    Помогите решить данную проблему.

     

    Версии:

    Delphi: 10.1
    INDY: 10.6.2.5341

    Крэш приложения в Windows 7

    в Прочие вопросы

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

    Среда XE8 стоит на Win 8,1. Приложение запускается.

     

    Переношу приложение на клиентскую машину с Win 7. Запускаю - вылетает такая ошибка:

    post-94-0-35328500-1437591647.jpg

     

    А после, это:

    post-94-0-66537300-1437592006.jpg

     

    Привожу код, который выполняется при начале отображения формы:

    procedure TForm1.FormShow(Sender: TObject);
var
  StrTemp: TStrings;
begin
try
  StrTemp := TStringList.Create;
  DM1.FDConnection1.Params.Database := ExtractFileDir(ParamStr(0))+'\data\flatcom.db';

  DM1.FDConnection1.Connected := True;
  DM1.FDTable1.Active := true;

  DM1.GetAdmins(StrTemp);
  self.edtAdmin.Items := StrTemp;
  edtAdmin.Items.Count;

  StrTemp.Clear;
  DM1.GetNationals(StrTemp);
  self.edtNationality.Items := StrTemp;

  StrTemp.Clear;
  DM1.GetRoomsType(StrTemp);
  self.edtRoomType.Items := StrTemp;

  StrTemp.Clear;
  DM1.GetCalcs(StrTemp);
  self.edtCalc.Items := StrTemp;

  StrTemp.Free;

  self.dtdtContract.Date := Date;

  Self.edtNumContract.SetFocus;
  Self.edtNumContract.SelectAll;
except
  ShowMessage('Файл базы данных не найден. Обратитесь к разработчику.');
  Self.Close;
end;
end;

    Ошибка, явно в этом месте:

      DM1.FDConnection1.Params.Database := ExtractFileDir(ParamStr(0))+'\data\flatcom.db';

  DM1.FDConnection1.Connected := True;

    Если можете, скажите, в чем может быть проблема?

    Визуальные компоненты из dll в форме основного приложения

    в Прочие вопросы

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

    Всем доброго времени суток.

     

    Возможно ли описать и создать визуальные компоненты в dll, а отобразить их на форме (или, например на TLayout этой формы) приложения, использующего эту dll?

     

    Среда: Delphi XE7.

    Реализация дочерней формы в родительской

    в Формы

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

     

    Нужно именно форму встроить с рамкой или встроить содержимое одной формы в другую?

    1. Если речь идет о втором, то есть механизмы Frame (аналогично VCL). Создаете фреймы в проекте. B в нужных местах формы размещаете их в любом количестве. Кстати использование фреймов для разработки позволяет разгрузить форму от логики по обработке UI и сосредоточиться на логике обработки ваших данных. 

     

     

     

    Нужно именно форму встроить с рамкой или встроить содержимое одной формы в другую?

    1. Если речь идет о втором, то есть механизмы Frame (аналогично VCL). Создаете фреймы в проекте. B в нужных местах формы размещаете их в любом количестве. Кстати использование фреймов для разработки позволяет разгрузить форму от логики по обработке UI и сосредоточиться на логике обработки ваших данных. 

     

    Ярослав, а можно по подробнее об фреймах?

    [TGrid] Как получить значение ячейки при использовании LiveBinding?

    в TGrid

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

    Всем доброго времени суток.

     

    На форме есть TGrid:

     

    post-94-0-17845900-1428776272_thumb.jpg

     

    Данные к нему прикручены через LiveBinding от TFDQuery:

     

    post-94-0-97738900-1428776318.jpg

     

    Как мне узнать значение ячейки первого столбца, активной строки?

     

    post-94-0-52536000-1428776712.jpg

     

    Пробовал реализовать через событие Grid1SelectCell:

    procedure TForm5.Grid1SelectCell(Sender: TObject; const ACol, ARow: Integer;
  var CanSelect: Boolean);
var
 CellStr: string; //Значение ячейки первого столбца.
begin
 CellStr := TTextCell(Grid1.Columns[0].Controls.Items[ARow]).Text;
end;

    Вот этот код:

    TTextCell(Grid1.Columns[0].Controls.Items[ARow]).Text;

    я вычитал здесь: http://fire-monkey.ru/topic/120-tgrid-kak-ustanovit-tekst-v-iacheike-tcheckcolumn-delphi-xe-4/

    Однако, при его выполнение срабатывает исключение: "argument out of range".

     

    Подскажите, как мне решить эту задачу?

     

    Версия среды: XE7 FMX.

    Изменение размера шрифта в RunTime

    в TLabel

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

    Доброго времени суток.

     

    Создаю программно компоненты TLabel.

    Status1 := TLabel.Create(Form1);
Status1.Name := 'LabelStatus1_'+idMachine.ToString;
Status1.Parent := RectangleStatus;
Status1.Align := TAlignLayout(9);
Status1.TextSettings.HorzAlign := TTextAlign(0);
//По умолчанию, при создании объекта TLabel, размер шрифта устанавливается в значение 12
Status1.TextSettings.Font.Size := 24;
Status1.TextSettings.WordWrap := true;
Status1.Text := 'Статус 1';
Status1.Visible := true;

    Изменяю значение размера шрифта:

    Status1.TextSettings.Font.Size := 24 

    Значение изменяется, но размер шрифта TLabel при отображении на форме остается прежним.

     

    Как можно, или нужно изменять размер шрифта компонента в RunTime?

    [Отклонение] Hardware-кнопки

    в Работа с кнопками

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

    Есть некоторая особенность. Событие в программе при нажатии на кнопку "меню" реагирует только со второго раза, всегда.

     

    Ставлю breakpoint на событие TForm.FormKeyUp.

     

    post-94-0-41090800-1397066789_thumb.jpg

     

    Точка срабатывает только каждый второй раз на нажатие кнопки меню.

     

    Это баг?! Можно ли исправить?!

     

    Среда разработки: XE5 up1

    Версия android: 4.4.2 (CM11)

    Устройство: Huawei U8860

×
×
  • Создать...