Перейти к содержанию

Aleks133

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

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

  • Посещение

Весь контент Aleks133

  1. Огромное спасибо за советы и за то что Вы всегда на связи.Буду разбираться дальше.
  2. т.е. создаю новый unit->описываю в нем Tdatamodule и создаю все компоненты динамически.верно? Я еще нашел на другом форуме Вы предлагали использовать TObjectList, он подойдет?(Вроде не сложен в использовании)
  3. Спасибо большое за оперативный ответ и за отклик в принципе!!! Правильно ли я понимаю: 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; Это я вообще не понял как реализовать. Т.е нужно в 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; а потом для в реализации класса чередовать их или для каждой таблицы использовать свой элемент массива?
  4. Aleks133

    Работа с БД в класс

    Здравствуйте, Подскажите как правильно организовать работу с БД в классах.Есть БД(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 Сильно не ругайте, только учусь.
  5. Классная штука, но в Berlin 10.1 up2 тоже не работает цвет.И при очистке вылетает ошибка "Invalid pointer operation". Если кто-нибудь знает как исправить, буду очень благодарен.
  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
  10. Я в шоке, нашел))Как все было просто.а вот как в stringgrid? И как сделать чтобы значение value бралось из другой колонки тойже сточки? procedure TForm1.Grid1GetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue); begin if aCol = 1 then Value := 50; end;
  11. Aleks133

    TProgressColumn на сетке

    Вечер добрый, Сдаюсь,уже устал искать . Подскажите,кто знает, ну вот как они создали прогресс в TGrid и TStringGrid на демке? Спасибо.
  12. Сам не знаю как, но получилось)))пол дня читал форумы чтобы хоть что-то понять из этого. И методом "научного тыка" вот: 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'у большое спасибо за наводку. Если кто знает что нужно добавить\исправить для гарантированно стабильной(без сюрпризов в дальнейшем) работы кода, буду благодарен.
  13. Спасибо за ответ.Вот только знать бы как это все работает и где это применить((Буду изучать...еще раз спасибо.
  14. Добрый вечер. Пытаюсь добавить сканеровку 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 открывается сканер, сканирую и приложение зависает(в оснавном когда сканирую первый раз).
  15. Здравствуйте, экспериментирую с загрузкой своих иконок в 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. если ничего не обрезать, то все работает как надо.
  16. Спасибо за совет!Возможно когда-нибудь к этому приду, но пока для меня это сложновато. Пока сделал как подсказал 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;
  17. Здравствуйте, Хочу сохранять настройки приложения, например выбранный индекс 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 придется еще один файл добавлять.
  18. Да спасибо, я в основном читаю все на http://docwiki.embarcadero.com там и браузер мне все переводит на русский, а это "там будет описание метода и модуль где он находится System.Threading" не доглядел.Спасибо.Будим учить дальше. P.S Фреймы еще не успел посмотреть, чувствую интересная штука.))
  19. Спасибо, смысл понял(почти), и то благодаря ссылке выше, только пока не понял как это все работает. TTask.run я так понял это независимая процедура которая и может удалить компоненты безболезненно(а tthread.synchronize делает ее еще безопасней?). Вот только редактор ругается на Ttask, может какой-то модуль надо подключить? И я так и не понял откуда ее вызывать(( Из процедуры btn.OnClick := ok;? Извиняюсь за вопросы "чайника". Пишу можно сказать первый проект для себя, и в процессе осваиваю язык.Много чего становится понятным и станавится на свои места в понимании, но еще гораздо больше пока для меня дремучий лес.
  20. Спасибо, так работает. Это по тому принципу что если удаляешь компонент то и удаляется то что на нем? А почему тогда здесь все работает нормально? 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;
  21. ))))Пока не сериал,но к этому идет.Пока только затянувшийся фильмец.))Причем в котором я пока не могу разгадать сюжет. Если есть чем помочь по теме,буду премного благодарен.
  22. Уже замучался, помогите. Вот так создаю окошко в котором поле ввода тескста и кнопка. 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, кнопка и т.п). А если сделать все тоже самое только через таймер,т.е таймер будет убивать компоненты, то все работает как надо. Может причина была в том что кнопка поторая убивала компоненты , не должна была убивать и саму себя?
  23. Подскажите возможно ли переключаться между списками связей. У меня есть ListView в котором 5 Text Item'ов и есть БД в которой в двое больше столбцов. Вопрос:Как сделать так чтобы в Runtime можно было(например по выбору checkbox) менять связи т.е если галочка стоит то этим 5-и Text Item была присвоена одна половина столбцов БД а если галочка снята то другая половина БД Можно было бы на listview подобавлять еще кучу item'ов а потом скрывать ненужные и показывать нужные,но не хочу увеличивать высоту строчки listview.Если только не накладывать TTextObjectAppearance один на другой.
  24. Долго я искал как это сделать в 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;
×
×
  • Создать...