Перейти к содержанию
  • Регистрация

Aleks133

Пользователи
  • Публикаций

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

  • Посещение

Информация о Aleks133

  • Звание
    Пользователь

Посетители профиля

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

  1. Добрый вечер. Пытаюсь добавить сканеровку 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 открывается сканер, сканирую и приложение зависает(в оснавном когда сканирую первый раз).
  2. Здравствуйте, экспериментирую с загрузкой своих иконок в imagelist на основе примеров с форума. Мои действия: 1. Загружаю картинку в TImage 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; 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; 4. теперь хочу загрузить фото с камеры procedure TForm1.TakePhotoFromCameraAction1DidFinishTaking(Image: TBitmap); begin //ImageList1.Add(Image); //способ 1 сразу в ImageList Image1.Bitmap.Assign(Image); //способ 2 сначала в TImage потом в ImageList end; Иконка с камеры добавляется нормально(становится картинка+Item 4), как обычная(квадратная) так и обрезанная(круглая). Но как только она добавляется , то все иконки которые были обрезаны по кругу пропадают, а имена остаются. Не пойму что я делаю не так? P.S. если ничего не обрезать, то все работает как надо.
  3. Спасибо за совет!Возможно когда-нибудь к этому приду, но пока для меня это сложновато. Пока сделал как подсказал 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;
  4. Здравствуйте, Хочу сохранять настройки приложения, например выбранный индекс 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; в БД поля хранятся так Можно искать значение для каждого компонента через select values from rab components= name, но это же много разных запросов, мне кажется будут лишние "тормоза", а там не знаю, не пробовал. Для начала решил обратиться за советом сюда.Может можно проще. Как это сделать с помощью ini я знаю, но хотел чтобы развертывался только один файл(БД ), а с ini придется еще один файл добавлять.
  5. Да спасибо, я в основном читаю все на http://docwiki.embarcadero.com там и браузер мне все переводит на русский, а это "там будет описание метода и модуль где он находится System.Threading" не доглядел.Спасибо.Будим учить дальше. P.S Фреймы еще не успел посмотреть, чувствую интересная штука.))
  6. Спасибо, смысл понял(почти), и то благодаря ссылке выше, только пока не понял как это все работает. TTask.run я так понял это независимая процедура которая и может удалить компоненты безболезненно(а tthread.synchronize делает ее еще безопасней?). Вот только редактор ругается на Ttask, может какой-то модуль надо подключить? И я так и не понял откуда ее вызывать(( Из процедуры btn.OnClick := ok;? Извиняюсь за вопросы "чайника". Пишу можно сказать первый проект для себя, и в процессе осваиваю язык.Много чего становится понятным и станавится на свои места в понимании, но еще гораздо больше пока для меня дремучий лес.
  7. Спасибо, так работает. Это по тому принципу что если удаляешь компонент то и удаляется то что на нем? А почему тогда здесь все работает нормально? 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;
  8. ))))Пока не сериал,но к этому идет.Пока только затянувшийся фильмец.))Причем в котором я пока не могу разгадать сюжет. Если есть чем помочь по теме,буду премного благодарен.
  9. Уже замучался, помогите. Вот так создаю окошко в котором поле ввода тескста и кнопка. 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, кнопка и т.п). А если сделать все тоже самое только через таймер,т.е таймер будет убивать компоненты, то все работает как надо. Может причина была в том что кнопка поторая убивала компоненты , не должна была убивать и саму себя?
  10. Aleks133

    Связи LiveBindings

    Подскажите возможно ли переключаться между списками связей. У меня есть ListView в котором 5 Text Item'ов и есть БД в которой в двое больше столбцов. Вопрос:Как сделать так чтобы в Runtime можно было(например по выбору checkbox) менять связи т.е если галочка стоит то этим 5-и Text Item была присвоена одна половина столбцов БД а если галочка снята то другая половина БД Можно было бы на listview подобавлять еще кучу item'ов а потом скрывать ненужные и показывать нужные,но не хочу увеличивать высоту строчки listview.Если только не накладывать TTextObjectAppearance один на другой.
  11. Долго я искал как это сделать в DynamicAppearance. procedure TForm1.Button2Click(Sender: TObject); var i: integer; begin Memo1.Lines.Clear; for i := 0 to ListView1.ItemCount - 1 do begin if ListView1.Items.Objects.FindObjectT<TListItemAccessory>('Accessory2') .Visible = true then begin Memo1.Lines.Add('Индекс отмеченного итема= ' + inttostr(i) + ',Значение = ' + ListView1.Items.Objects.FindObjectT<TListItemText>('Text3').Text ); end; end; end;
  12. procedure TForm1.ListView1UpdateObjects(const Sender: TObject; const AItem: TListViewItem); var i: integer; begin for i := 0 to ListView1.ItemCount - 1 do begin if ContainsText(ListView1.Items.Objects.FindObjectT<TListItemText> ('Text4').Text, '-') = true then begin ListView1.Items.Objects.FindObjectT<TListItemText>('Text4').TextColor := TAlphacolors.Red; ListView1.Items.Objects.FindObjectT<TListItemText>('Text4').TextAlign := TTextAlign.Trailing; end else begin ListView1.Items.Objects.FindObjectT<TListItemText>('Text4').TextColor := TAlphacolors.Green; ListView1.Items.Objects.FindObjectT<TListItemText>('Text4').TextAlign := TTextAlign.Leading; end; if ListView1.Items.Objects.FindObjectT<TListItemText>('Text3').Text = 'бензин' then begin ListView1.Items.Objects.FindObjectT<TListItemText>('Text3').TextColor := TAlphacolors.Blueviolet; end; end; end; А после FDQuery1.activ:=False; FDQuery1.activ:=True; Получается что последняя запись не соответствует условию. Не пойму почему.
  13. Вот так работает, но теперь почему-то другие записи стали белыми if (TOpenColumn(Column).Index = 1) then if (StringGrid1.Cells[1, Row] = 'работа') then // условие 1 Canvas.Fill.Color := TAlphaColors.Blueviolet // задаем цвет текста else if (StringGrid1.Cells[1, Row] = 'бензин') then // условие 2 Canvas.Fill.Color := TAlphaColors.Blue // задаем цвет текста else Canvas.Fill.Color := TAlphaColors.Black; // цвет для всех других записей if (TOpenColumn(Column).Index = 2) then if (StringGrid1.Cells[2, Row] = '-850') then // условие 1 Canvas.Fill.Color := TAlphaColors.Red // задаем цвет текста else if (StringGrid1.Cells[2, Row] = '3000') then // условие 2 Canvas.Fill.Color := TAlphaColors.Green // задаем цвет текста else Canvas.Fill.Color := TAlphaColors.Black; // цвет для всех других записей
  14. Вы гений!))Спасибо!Весь день экспериментирую . А можно ли теперь сделать тоже самое для суммы чтобы цвет другой поставить, а то цвет распространяется на всю строку а мне нужно только на определенный столбец? Условие есть for i := 1 to length(ansilowercase(Grid.Cells[1, Row])) do // если столбец 2 и строка 1 if (TOpenColumn(Column).Index = 1) and (Row = 1) and // и если символ + найден на позиции i (pos('+', ansilowercase(Grid.Cells[1, Row])) = i) then но куда его подставить не пойму, попробую конечно поэкспериментировать по такому же принципу как и Вы показали, но мне кажется будет мешать тот факт что цвет меняется для всей строки а не для определенного столбца.
×
×
  • Создать...