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

Aleks133

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

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

  • Посещение

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

  1. 12 часов назад, krapotkin сказал:

    Бывает. На функционал обычно не влияет. В делфи как всегда для исправления ошибок - берите версию поновее.

    Может сторонние пакеты типа CnWizards или типа того есть. Тоже могут влиять.

    Боюсь обновлять версию,хоть и хотелось бы. Т.к не знаю как ее нормально удалить. Деинсталятора нет. А обычно когда такие большие программы удаляешь вручную, ни к чему хорошему это не приводит.Я имею ввиду конфликты новой версии с остатками старой.Поэтому пока работает пусть работает)) Спасибо за ответ.

  2. Всем привет,

    1.Создаю новый проект и сохраняю.

    2.Жму на view source этого проекта.

    3.Закрываю открывшуюся вкладку с ресурсами.

    4.А при попытки добавления в проект нового(чистого) юнита выскакивает access violation.

    После этого чтобы создать юнит без ошибки нужно перезапустить проект не нажимая перед этим view source.

    Подскажите, это такой прикол среды или я что-то натворил в ней.

    RadStudio 10.1 upd 2 berlin

    Спасибо.

    error.png

  3. 6 минут назад, krapotkin сказал:

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

    т.е. создаю новый unit->описываю в нем Tdatamodule и создаю все компоненты динамически.верно?

    8 минут назад, krapotkin сказал:

    Про массив все верно. Только вместо него лучше взять tthreadlist. 

    Я еще нашел на другом форуме Вы предлагали использовать TObjectList, он подойдет?(Вроде не сложен в использовании)

      

  4. Спасибо большое за оперативный ответ и за отклик в принципе!!!

    Правильно ли я понимаю:

    1.Создаем datamodule(Tdm)->кидаем на него нужные компоненты

    1.1. Или Создаем datamodule(Tdm)->создаем в нем constructor create для создания нужных компонентов динамически?

    2.В своих классах используем этот дата-модуль так?

    uses UnitDM
    
    type TMyclass=class(TObject)
    private
    ...
    public
    function getdata:string
    end;
    
    type TNewDM = class(Tdm)
    
    implementation
    
    ...
    function TMyclass.getdata:string;
    var
    NewDM1:TNewDM;
    begin
    NewDM1:=TNewDM.Create;
    Connection.params.value['base']:='путь к бд';
    Query.sql.text:='запрос';
    result:=Query.fields[1].asstring;
    NewDM1.free;
    end;
    ...

      А в основном юните использовать так:

    ...
    implementation
    uses MyClass;
    ....
    var
    s:string;
    MyClass1:TMyclass;
     begin
      MyClass1:=TMyclass.create;
      s:=MyClass1.getdata;
      MyClass1.free;
     end;

     

    4 часа назад, krapotkin сказал:

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

    Это я вообще не понял как реализовать. Т.е нужно  в TMyClass создать массив что-то вроде того? 

    ...
    type TMyclass=class(TObject)
     private
       ArrDm: array [0 .. 2] of TDm;
     public
       function getdata:string
    end;
    
    implementation
    ...
    
    constructor TMyClass.create;
    var i:integer;
    begin
      for i:=0 to 2 do
        ArrDm[i]:=TDm.create;
    end;

    а потом для в реализации класса чередовать их или для каждой таблицы использовать свой элемент массива?

     

  5. Здравствуйте,

    Подскажите как правильно организовать работу с БД в классах.Есть БД(Sqlite), для работы использую FireDac.

    Например структура БД состоит из 3-х таблиц.Сейчас у меня для каждой таблицы свой(боюсь конфликтов в программе) FDQuery.

    Основной Unit разросся, поэтому хочу весь функционал перевести в отдельный класс.С классами только начал знакомиться.

    Начал писать так:

    unit WorkBase;
    
    interface
    
    uses classes, Sysutils, FireDAC.Stan.Intf, FireDAC.Stan.Option,
      FireDAC.Stan.Error,
      FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
      FireDAC.Stan.Async, FireDAC.Phys, FireDAC.FMXUI.Wait, FireDAC.Stan.Param,
      FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
      FireDAC.Comp.Client, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
      FireDAC.Stan.ExprFuncs, system.Variants;
    
    type
      TDBWork = class
      private
        Bcon: TFDConnection;
        BQ: TFDQuery;
        procedure beforeconnection(sender: TObject);
        function GetCountExe: integer;
      public
        procedure SetAccaunts(fname, token: string);    
        function GetAccauntsList: TStringList;
        constructor create;
        destructor free; // override;
        property Count: integer read GetCountExe;
      end;
    
    implementation
    
    { TDBWork }
    
    procedure TDBWork.beforeconnection(sender: TObject);
    begin
      Bcon.Params.Values['Database'] := ExtractFilePath(ParamStr(0)) + 'base.db';
    end;
    
    constructor TDBWork.create;
    begin
      Bcon := TFDConnection.create(nil);
      Bcon.BeforeConnect := beforeconnection;
      Bcon.Connected;
      Bcon.LoginPrompt := false;
      Bcon.Params.Values['LockingMode'] := 'Normal';
      Bcon.Params.Values['DriverID'] := 'SQlite';
      BQ := TFDQuery.create(nil);
      BQ.Connection := Bcon;
    end;
    
    destructor TDBWork.free;
    begin
      Bcon.free;
      BQ.free;
      // inherited;
    end;
    
    function TDBWork.GetCountExe: integer;
    begin
      BQ.Close;
      BQ.SQL.Text := 'select max(id) from exe';
      BQ.OpenOrExecute;  
      result := BQ.RowsAffected;
    end;
    
    function TDBWork.GetAccauntsList: TStringList;
    begin
      result := TStringList.create;
      with BQ do
      begin
        Close;
        Open('select * from accaunt');
        First;
        while not BQ.Eof do
        begin
          result.Add(BQ.FieldByName('name').AsString);
          next;
        end;
      end;
    end;
    
    // добавление аккаунта
    procedure TDBWork.SetAccaunts(fname: string; fFirstname: string);
    var
      rez: variant;
    begin
      try
        with BQ do
        begin
          Open('select * from accaunt');
          rez := Lookup('name', fname, 'name');
          if vartype(rez) = varnull then
          begin
            Close;
            SQL.Text := 'insert into accaunt(name,Firstname) values(:n,:t)';
            ParamByName('n').AsString := fname;
            ParamByName('t').AsString := fFirstname;
            ExecSQL;
          end;
        end;
      except
    
      end;
    end;
    end.

    Дальше мне нужно добавить новую функцию для работы со второй  таблицей.Вот только теперь думаю, добавлять в constructor еще один query или можно с одим работать.Например для записи в лог.Вдруг гдето в программе обе функции будут использовать этот один query одновременно, например в основном потоке и дополнительном.Или этого быть не может из-за того что компоненты FDConnection и FDQuery создаются динамически и при использовании класса я каждый раз создаю новый экземпляр? 

    procedure TForm1.Button35Click(Sender: TObject);
    var
    wb1:TDBWork;
    list:TStringList;
    s:string;
    begin
    wb1:=TDBWork.create;
    list:=TStringList.Create;
    list:=wb1.GetAccauntsList;
    showmessage(list.Text);
    wb1.free;
    list.Free;
    end;

    ps Сильно не ругайте, только учусь.

  6. Здавствуйте, 

    кто-нибудь знает, а будет ли данный пример работать на community edition?Ведь там вроде нельзя исходники менять.

    Да и вообще интересно, будут ли работать в CE такие вещи как например ModernLV или vkbdhelper.pas(авто прокрутка к полю ввода), если подкинуть их к проекту?   

  7. 10.1 upd2 Berlin Указанный способ не сработал.

    Вышел из положения так: 

    procedure TForm1.Edit6Click(Sender: TObject);
    var
      selcol, selst: Integer;
    begin  
      selst := Edit6.SelStart; //запонинаем куда кликнули курсором
      if Edit6.Text <> '' then  
      begin
        Edit6.SelectAll;  //выделяем всю строку
        selcol := Edit6.SelLength;//узнаем сколько символов в строке
        Edit6.SelStart := selcol - 1; //ставим курсор в любое место чтобы снять выделение и в помощьнике клавиатуры появились подсказки
        Edit6.SelStart := selst; //и возвращаем каретку на место куда изначально было кликнуто
      end;
    end;

    Только есть минус:по удержанию пальца текст не получиться выделить. 

  8. Для stringgrid разобрался

    procedure TForm1.StringGrid1EditingDone(Sender: TObject;
      const ACol, ARow: Integer);
    begin
      StringGrid1.Cells[1, ARow] := StringGrid1.Cells[ACol, ARow];  
    end;

    а вот для грида не работает((

    procedure TForm1.Grid1EditingDone(Sender: TObject; const ACol, ARow: Integer);
    begin
      Grid1.Columns[1].Controls.items[ARow].data := Grid1.Columns[ACol]
        .Controls.items[ARow].data;  
    end;

     

  9. В общем весь день убил на поиски, так ничего и не нашел.Нашел все что хотел,но только все старое что уже не работает.

    1.Как обращаться к ячейке, для чтения и записи?не через Grid1GetValue а с кнопки например так :

    procedure TForm1.Button4Click(Sender: TObject);
    val: TValue;
      str: string;
    begin
      val := Grid1.Columns[1].Controls.items[1].Data; //не работает так
    showmessage(val.tostring);
    end;

     

    2. Как ячейке в столбце TProgressColumn присвоить значение(тоже с кнопки)?

     

    Пока все что у меня получилось сделать (по справке) это:

     private
        a, b, c: array of TValue;
        { Private declarations }
     public
        constructor Create(AOwner: TComponent); override;
        { Public declarations }
      end;
    
    const
      kat: array [0 .. 5] of string = ('Доходы', 'Расходы', 'Магазин', 'Продукты',
        'Работа', 'Заправка');
      sym_kat: array [0 .. 5] of Integer = (1000, 2000, 2500, 355, 1500, 1700);
    
    var
      Form1: TForm1;
    
    implementation
    
    constructor TForm1.Create(AOwner: TComponent);
    begin
      inherited;
      SetLength(a, Grid1.RowCount);
      SetLength(b, Grid1.RowCount);
      SetLength(c, Grid1.RowCount);
    end;
    
    procedure TForm1.Grid1GetValue(Sender: TObject; const ACol, ARow: Integer;
      var Value: TValue);
    var
      i: Integer;  
    begin
      if ACol = 0 then
        Value := a[ARow];
      if ACol = 1 then
        Value := b[ARow];
      if ACol = 2 then
        Value := c[ARow];  
    end;
    
    procedure TForm1.Grid1SetValue(Sender: TObject; const ACol, ARow: Integer;
      const Value: TValue);
    var
      i: Integer;
    begin
      if ACol = 0 then
        a[ARow] := Value;
      if ACol = 1 then
        b[ARow] := Value;
      if ACol = 2 then
        c[ARow] := Value;
    end;
    //так заполняю данными
    procedure TForm1.Button3Click(Sender: TObject);
    var
      i: Integer;
    begin
        for i := 0 to Grid1.RowCount - 1 do
      begin
        a[i] := kat[i];
        c[i] := sym_kat[i];
        b[i] := sym_kat[i];
        StringColumn3.UpdateCell(i);
        ProgressColumn2.UpdateCell(i);
        StringColumn4.UpdateCell(i);
      end;
    end;
    //так получу значение из третьего столбца третьей строки
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      showmessage(c[2].ToString); //2500
    end;

    Но при редактировании суммы, прогресс не меняется.Как это сделать, для меня пока загадка.

    Буду признателен за любую помощь.

    P.s.Не обязательно TGrid, можно и TStringGrid

     

    888.png

  10. Я в шоке, нашел))Как все было просто.а вот как в stringgrid?

    И как сделать чтобы значение value бралось из другой колонки тойже сточки?

    procedure TForm1.Grid1GetValue(Sender: TObject; const ACol, ARow: Integer;
      var Value: TValue);
    begin
    if aCol = 1 then
     Value := 50;
    end;

     

  11. Сам не знаю как, но получилось)))пол дня читал форумы чтобы хоть что-то понять из этого.

    И методом "научного тыка" вот:

    uses androidapi.helpers,
    Androidapi.JNI.app,FMX.Helpers.Android,
      Androidapi.JNI.GraphicsContentViewText;
    
    var
    FMessageSubscriptionID:integer;
    
    procedure tform1.Scan1;
    var
      intent: JIntent;
    begin
    FMessageSubscriptionID := TMessageManager.DefaultManager.SubscribeToMessage(TMessageResultNotification,
        HandleActivityMessage);
        intent := TJIntent.Create;
        intent.setAction(StringToJString('com.google.zxing.client.android.SCAN'));
        SharedActivity.startActivityForResult(intent, 0);
    end;
    
    
    procedure TForm1.HandleActivityMessage(const Sender: TObject; const M:TMessage);
    var
       RequestCode, ResultCode: Integer;
       Intent: JIntent;
       s:string;
    begin
      if not(M is TMessageResultNotification) then exit;
      TMessageManager.DefaultManager.Unsubscribe(TMessageResultNotification, FMessageSubscriptionID);
      FMessageSubscriptionID := 0;
    
      RequestCode:=TMessageResultNotification(M).RequestCode;
      ResultCode:=TMessageResultNotification(M).ResultCode;
      Intent:=TMessageResultNotification(M).Value;
    
       if ResultCode = TJActivity.JavaClass.RESULT_OK then
       begin
        if Assigned(Intent) then
          begin
          s:=JStringToString(intent.getStringExtra(StringToJString('SCAN_RESULT')));  //получил результат со сканера
          convert(s);  //использовал результат со сканера в своей процедуре
          end;
        end
        else if ResultCode = TJActivity.JavaClass.RESULT_CANCELED then
        begin
          //Memo1.Lines.Append('RESULT_CANCELED');
        end;
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      scan1; //запуск сканеровки;
    end;

    Не знаю правильно ли это все будет работать, но во всяком случае приложение не виснит(пока) и что хотел получил.

    Slym'у большое спасибо за наводку.

    Если кто знает что нужно добавить\исправить для гарантированно стабильной(без сюрпризов в дальнейшем) работы кода, буду благодарен.

  12. 16 часов назад, Slym сказал:

    SharedActivity.startActivityForResult(intent, 0);
    результат получаешь в TMessageResultNotification
    intent.getStringExtra("SCAN_RESULT");
    intent.getStringExtra("SCAN_RESULT_FORMAT");

    Спасибо за ответ.Вот только знать бы как это все работает и где это  применить((Буду изучать...еще раз спасибо. 

  13. Добрый вечер. Пытаюсь добавить сканеровку qr кода в приложение.Делаю так:

    uses FMX.ALDevBarcode;
    
    private
        FBarcode: TALDevBarcode;
        procedure BarcodeScanResult(Sender: TObject; AResult: string);
        procedure convert(s: string);
    
    procedure TForm1.BarcodeScanResult(Sender: TObject; AResult: string);
    var
      ScanThread: TScanthread;
    begin
      convert(AResult);
    
    end;
    
    procedure TForm1.convert(s: string);
    var
      d, t, sum_start, fn_start, i_start: integer;
      dt, tm: TDateTime;
      sdt, tdt, summa, fn, fn_find_str: string;
      fn_find, fn_name_find: variant;
    begin
      if ContainsText(s, 't=') and ContainsText(s, 'T') and ContainsText(s, '&s=')
        and ContainsText(s, '&fn=') then
      begin
        sum_start := pos('&s=', s, 1); // начало суммы
        fn_start := pos('&fn=', s, 1); // начало фн номера
        i_start := pos('&i=', s, 1); // начало i номера
        fn := copy(s, fn_start + 4, i_start - (fn_start + 4));//ФН номер
        summa := copy(s, sum_start + 3, fn_start - (sum_start + 3)); // сумма
        summa := stringreplace(summa, '.', ',', [rfReplaceAll]);
        sdt := copy(s, pos('t=', s, 1) + 2, 8); // вся дата
        tdt := copy(s, pos('T', s, 1) + 1, 4); // все время
        dt := EncodeDate(strtoint(copy(sdt, 1, 4)), strtoint(copy(sdt, 5, 2)),
          strtoint(copy(sdt, 7, 2))); // цифры переводим в дату
        tm := encodetime(strtoint(copy(tdt, 1, 2)), strtoint(copy(tdt, 3, 2)), 0,
          0); // цифры переводим в время
    
        DateEdit1.DateTime := dt + tm;
        Label1.Text := summa;
        Button2.Hint := fn;  // кнопке сканера присаиваем результат фн
        dm.magaz.Open('select * from magaz');   //список магазинов
        fn_find := dm.magaz.Lookup('fn', fn, 'name');  //ищем имя магазина в бд
        fn_name_find := dm.magaz.Lookup('fn', fn, 'fn');  //ищем фн в бд
        if vartype(fn_name_find) = varnull then
        begin
          Label40.Text := 'Не известный магазин'; // Не известный магазин
          Label40.tag := 0; // такого фн нет в БД
        end
        else if (vartype(fn_find) = varnull) or (fn_find = '') then
        begin
          Label40.Text := 'Не известный магазин'; // Не известный магазин
          Label40.tag := 2; // у этого ФН нет названияв в БД
        end
        else
        begin
          Label40.Text := fn_find; // название найденного по фн магазина
          Label40.tag := 1; // название магазина есть в БД
        end;
        if Label40.tag <> 4 then
          Label40.HitTest := True;    
      end
      else
        showmessage('QR код не содержит нужных данных');
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin    
          FBarcode.Scan;
    
    end;

    Содержимое FMX.ALDevBarcode

    unit FMX.ALDevBarcode;
    
    interface
    
    uses
      FMX.Types, FMX.Platform, System.Classes, System.Rtti,
      Androidapi.JNI.GraphicsContentViewText, Androidapi.Helpers;
    
    type
      TALDevBarcodeScanEvent = procedure (Sender: TObject; AResult: string) of object;
      TALDevBarcode = class(TFmxObject)
      private
        FPreservedClipboardValue: TValue;
        FMonitorClipboard: Boolean;
        FClipService: IFMXClipboardService;
        FOnScanResult: TALDevBarcodeScanEvent;
        function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
        procedure DoScanResult(AValue: string);
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Scan;
        property OnScanResult: TALDevBarcodeScanEvent read FOnScanResult write FOnScanResult;
      end;
    
    implementation
    
    
    { TALDevBarcode }
    
    constructor TALDevBarcode.Create(AOwner: TComponent);
    var
      aFMXApplicationEventService: IFMXApplicationEventService;
    begin
      inherited Create(AOwner);
      FMonitorClipboard := False;
      if not TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(FClipService)) then
        FClipService := nil;
      if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(aFMXApplicationEventService)) then
        aFMXApplicationEventService.SetApplicationEventHandler(HandleAppEvent)
      else
        Log.d('Application Event Service is not supported.');
    end;
    
    destructor TALDevBarcode.Destroy;
    begin
      inherited Destroy;
    end;
    
    procedure TALDevBarcode.DoScanResult(AValue: string);
    begin
      if Assigned(FOnScanResult) then
        FOnScanResult(Self, AValue);
    end;
    
    function TALDevBarcode.HandleAppEvent(AAppEvent: TApplicationEvent;
      AContext: TObject): Boolean;
      function GetBarcodeValue: Boolean;
      var
        value: String;
      begin
        Result := False;
        FMonitorClipboard := False;
        if (FClipService.GetClipboard.ToString <> 'nil') then
        begin
          DoScanResult(FClipService.GetClipboard.ToString);
          FClipService.SetClipboard(FPreservedClipboardValue);
          Result := True;
        end;
      end;
    begin
      Result := False;
      if FMonitorClipboard and (AAppEvent = TApplicationEvent.BecameActive) then
        Result := GetBarcodeValue;
    end;
    
    procedure TALDevBarcode.Scan;
    var
      intent: JIntent;
    begin
      if Assigned(FClipService) then
      begin
        FPreservedClipboardValue := FClipService.GetClipboard;
        FMonitorClipboard := True;
        FClipService.SetClipboard('nil');
        intent := TJIntent.Create;
        intent.setAction(StringToJString('com.google.zxing.client.android.SCAN'));
        //intent.putExtras(TJIntent.JavaClass.EXTRA_TEXT, StringToJString('"SCAN_MODE", "CODE_39"'));
        SharedActivity.startActivityForResult(intent, 0);
      end;
    end;
    end.

    После нажатия на button2 открывается сканер, сканирую и приложение зависает(в оснавном когда сканирую первый раз).

    1892676604_.png.fafe1018516e3ab760a546b676d23880.png

  14. Здравствуйте, экспериментирую с загрузкой своих иконок в imagelist на основе примеров с форума.

    Мои действия:

    1. Загружаю картинку в TImage

    image.png.0c07b2878f3bf0bcd1ddb4ce439fe3e2.png

    2.делаю ее круглой

    procedure TForm1.Button11Click(Sender: TObject);
    var
      b: TBitmap;
    begin
      b := TBitmap.Create();
      b.SetSize(512, 512);
      b.canvas.BeginScene();
      try
        b.canvas.Fill.Bitmap.Bitmap := Image1.Bitmap;
        b.canvas.Fill.Kind := TBrushKind.Bitmap;
        b.canvas.Fill.Bitmap.wrapmode := twrapmode.TileStretch;
        b.canvas.FillEllipse(rectf(0, 0, 512, 512), 1);
        finally
        b.canvas.EndScene;
        b.Free;
      end;

     Image1.Bitmap.Assign(b);
    end;image.png.5ea8cb0f86a4c7b448c453ab18a0f96e.png

    3.загружаю ее в imagelist

    function TImageListHelper.Add(aBitmap: TBitmap): integer;
    const
      Scale = 1;
    var
      vSource: TCustomSourceItem;
      vBitmapItem: TCustomBitmapItem;
      vDest: TCustomDestinationItem;
      vLayer: TLayer;
    begin
      Result := -1;
      if (aBitmap.Width = 0) or (aBitmap.Height = 0) then
        exit;

      // add source bitmap
      vSource := Source.Add;
      vSource.MultiresBitmap.TransparentColor := TColorRec.Fuchsia;
      vSource.MultiresBitmap.SizeKind := TSizeKind.Source;
      vSource.MultiresBitmap.Width := Round(aBitmap.Width / Scale);
      vSource.MultiresBitmap.Height := Round(aBitmap.Height / Scale);
      vBitmapItem := vSource.MultiresBitmap.ItemByScale(Scale, True, True);
      if vBitmapItem = nil then
      begin
        vBitmapItem := vSource.MultiresBitmap.Add;
        vBitmapItem.Scale := Scale;
      end;
      vBitmapItem.Bitmap.Assign(aBitmap);

      vDest := Destination.Add;
      vLayer := vDest.Layers.Add;
      vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero,
        vSource.MultiresBitmap.Width, vSource.MultiresBitmap.Height);
      vLayer.name := vSource.name;
      Result := vDest.Index;
    end;

    procedure TForm1.Button9Click(Sender: TObject);
    begin
        ImageList1.Add(Image1.Bitmap)
    end;image.png.4a2c6ac5d859b28c999bdd749e586d5c.png

    4. теперь хочу загрузить фото с камеры

    procedure TForm1.TakePhotoFromCameraAction1DidFinishTaking(Image: TBitmap);
    begin
          //ImageList1.Add(Image);  //способ 1 сразу в ImageList
          Image1.Bitmap.Assign(Image); //способ 2 сначала в TImage потом в ImageList
    end;

    Иконка с камеры добавляется нормально(становится картинка+Item 4), как обычная(квадратная) так и обрезанная(круглая).

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

    image.png.9600c584d168d970e4b6678bb7ffe8c3.pngimage.thumb.png.aea41da14f0858adbf770c989ae91dd3.png

    Не пойму что я делаю не так?

    P.S. если ничего не обрезать, то все работает как надо.   

     

  15. 5 часов назад, krapotkin сказал:

    правильный ответ - не делать так ))

    нужно хранить настройки приложения в отдельном классе

    тогда кроме самого класса нужны методы, которые 

    1) читают пишут его из ... файла, БД, интернета и т.д.

    2) в нужный момент (обычно чтобы изобразить форму и заполнить св-ва компонентов или еще для чего угодно) использовать эти настройки

    3) вытекает из 2) сохранять в нужный момент новые значения в переменную, где лежат настройки

    для хранения настроек отлично подходит JSON. Т.к. он может иметь иерархическую структуру, что очень удобно. Его и хранить в БД.

    Можно и прямо поля, строки и все такое, но все равно, собирать их нужно в некое хранилище в программе.

    Пример разбирал тут http://www.cyberforum.ru/blogs/469693/blog4883.html

    Спасибо за совет!Возможно когда-нибудь к этому приду, но пока для меня это сложновато. 

    Пока сделал как подсказал Slym. И это работает?. За что ему, большое спасибо!

    procedure TForm1.Button3Click(Sender: TObject);
    var
      s: string;
      obj: TObject;
      v:variant;
    begin
      with FDQuery1 do
      begin
        SQL.Clear;
        SQL.Add('select * from rab');
        OpenOrExecute;
      end;
      while not FDQuery1.Eof do
      begin
        s := FDQuery1.Fields[1].AsString + '.' + FDQuery1.Fields[2].AsString + ':='
          + FDQuery1.Fields[3].AsString + ';';
        Memo1.Lines.Add(s);
        obj := Form1.FindComponent(FDQuery1.Fields[1].AsString);
        v:=FDQuery1.Fields[3].AsVariant;
        setpropvalue(obj, FDQuery1.Fields[2].AsString,v);
        FDQuery1.Next;
      end;
    end; 

  16. Здравствуйте,

    Хочу сохранять настройки приложения, например выбранный индекс tabcontrol'a,список listbox'a и т.п. 

    Как можно сделать что то типа такого?

    procedure TForm1.Button3Click(Sender: TObject);
    var
      s,obj,cap,val: string;
    begin
      with FDQuery1 do
      begin
        SQL.Clear;
        SQL.Add('select * from rab');
        OpenOrExecute;
      end;
      while not FDQuery1.Eof do
      begin
        s := FDQuery1.Fields[1].AsString +'.'+ FDQuery1.Fields[2].AsString +':='+
          FDQuery1.Fields[3].AsString+';';
        Memo1.Lines.Add(s);
      obj:=FDQuery1.Fields[1].AsString;
      cap:=FDQuery1.Fields[2].AsString;
      val:=FDQuery1.Fields[3].AsString;
      //"Component"."properties":="value";      <--------что можно здесь придумать  

    FDQuery1.Next;
      end; 

    в БД поля хранятся так 

    image.png.1d69fcee6c9959019847f8118aabd9ae.png

    Можно искать значение для каждого компонента через select values from rab components= name, но это же много разных запросов, мне кажется будут лишние "тормоза", а там не знаю, не пробовал. Для начала решил обратиться за советом сюда.Может можно проще.  

    Как это сделать с помощью ini я знаю, но хотел чтобы развертывался только один файл(БД ), а с ini придется еще один файл добавлять. 

  17. 6 минут назад, krapotkin сказал:

    смелее используйте F1

    Да спасибо, я в основном читаю все на http://docwiki.embarcadero.com там и браузер мне все переводит на русский, а это

    "там будет описание метода и модуль где он находится System.Threading" не доглядел.Спасибо.Будим учить дальше.

    P.S Фреймы еще не успел посмотреть, чувствую интересная штука.))

  18. 11 часов назад, krapotkin сказал:

    Во-первых, откройте для себя фреймы ))

    Во-вторых убивать себя из обработчика себя нельзя, да и не нужно (см п.1)

    В качестве костыля.

    1. Создавайте все с Owner=NIL2.

    2. 

    
    TTask.Run(procedure begin
    
      tthread.synchronize(nil, procedure begin
    
         KILLTHEMALL();
    
      end);
    
    end)

     

    Спасибо, смысл понял(почти), и то благодаря ссылке выше, только пока не понял как это все работает.

    TTask.run я так понял это независимая процедура которая и может  удалить компоненты безболезненно(а tthread.synchronize делает ее еще безопасней?).

    Вот только редактор ругается на  Ttask, может какой-то модуль надо подключить?

    И я так и не понял откуда ее вызывать(( Из процедуры  btn.OnClick := ok;?

    Извиняюсь за вопросы "чайника". Пишу можно сказать первый проект для себя, и в процессе осваиваю язык.Много чего становится понятным и станавится на свои места в понимании, но еще гораздо больше пока для меня дремучий лес. 

  19. 43 минуты назад, slav_z сказал:

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

    Спасибо, так работает. Это по тому принципу что если удаляешь компонент то и удаляется то что на нем?

    А почему тогда здесь все работает нормально?

    procedure TForm1.Button29Click(Sender: TObject);
    var
      i, j: integer;
      aImage: TImage;
      aRect: TRectangle;
    begin
      Layout4.BeginUpdate;
      try
        // for j := 0 to 30 do
        // if Layout4.FindComponent('img' + inttostr(j)) <> nil then
        // Layout4.FindComponent('img' + inttostr(j)).Free;
        Layout4.DestroyComponents;
        for i := 0 to ListBox1.Items.Count - 1 do
        begin
          aRect := TRectangle.Create(Layout4);
          aRect.Parent := Layout4;
          aRect.Position.X := Layout4.Width;
          aRect.Position.Y := 0;
          aRect.Align := TAlignLayout.Left;
          aRect.Stroke.Kind := TBrushKind.None;
          aRect.Fill.Color := TAlphacolors.Null;
          aRect.Height := 50;
          aRect.Width := 50;
          aRect.Margins.Left := 0;
          aRect.Margins.Top := 0;
          aRect.Margins.Right := 0;
          aRect.Name := 'rect' + i.ToString;
          aRect.Tag := i;
          aRect.OnClick := rectClick;

          aImage := TImage.Create(aRect);
          aImage.Parent := aRect;
          aImage.Align := TAlignLayout.Client;
          aImage.HitTest := false;
          aImage.Name := 'img' + i.ToString;
          aImage.Bitmap.Assign(dm.ImageList1.Bitmap(aImage.Size.Size,
            ListBox1.ListItems.ImageIndex));
          aImage.Tag := i;
          Layout4.Width := Layout4.Width + 50;
        end;
      finally
        Layout4.EndUpdate;
      end;
    end;

  20. 21 час назад, #WAMACO сказал:

    Что? Опять? Сериал. Новый сезон. "Убийство кнопок" :))

    ))))Пока не сериал,но к этому идет.Пока только затянувшийся фильмец.))Причем в котором я пока не могу разгадать сюжет.

    Если есть чем помочь по теме,буду премного благодарен.

  21. Уже замучался, помогите.

    Вот так создаю окошко в котором поле ввода тескста и кнопка.

    procedure TForm1.Label2Click(Sender: TObject);
    var
      brect: TRectangle;
      edt: TEdit;
      btn: TButton;
      lb: TLabel;
    begin
      brect := TRectangle.Create(Form1);
      brect.Parent := Form1;
      brect.Width := 200;
      brect.Height := 200;
      brect.Fill.Color := TAlphacolors.Red;
      brect.Align := TAlignLayout.Center;
      brect.Name := 'showrect';
      lb := TLabel.Create(brect);
      lb.Parent := brect;
      lb.Align := TAlignLayout.Top;
      lb.Name := 'showlb';
      lb.Text := 'Введите коментарий';
      lb.TextSettings.Font.Size := 20;
      edt := TEdit.Create(brect);
      edt.Parent := brect;
      edt.Align := TAlignLayout.Center;
      edt.Width := brect.Width;
      edt.Name := 'showedt';
      btn := TButton.Create(brect);
      btn.Parent := brect;
      btn.Width := 50;
      btn.Height := 30;
      btn.Align := TAlignLayout.Bottom;
      btn.Text := 'OK';
      btn.Name := 'showbtn';
      btn.OnClick := ok;

    end;

    Вот так присваиваю результат ввода и удаляю объекты.

    procedure TForm1.ok(Sender: TObject);
    begin
      Label2.Text := ((Form1.FindComponent('showrect') as TRectangle)
        .FindComponent('showedt') as TEdit).Text;
      (Form1.FindComponent('showrect') as TRectangle).DestroyComponents;\\удаляю сначала компоненты на showrect
      (Form1.FindComponent('showrect') as TRectangle).Parent := NIL; \\потом удаляю сам showrect
      (Form1.FindComponent('showrect') as TRectangle).Release;

    end;

    Все вроде нормально, но после того как нажимаю на кнопку(showbtn) форма не закрывается(на крестик ) и даже не могу переместить окно формы пока я не кликну на любой компонент на этой форме кроме самой формы(edit, кнопка и т.п).

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

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

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