Aleks133
-
Постов
38 -
Зарегистрирован
-
Посещение
Сообщения, опубликованные Aleks133
-
-
Всем привет,
1.Создаю новый проект и сохраняю.
2.Жму на view source этого проекта.
3.Закрываю открывшуюся вкладку с ресурсами.
4.А при попытки добавления в проект нового(чистого) юнита выскакивает access violation.
После этого чтобы создать юнит без ошибки нужно перезапустить проект не нажимая перед этим view source.
Подскажите, это такой прикол среды или я что-то натворил в ней.
RadStudio 10.1 upd 2 berlin
Спасибо.
-
Огромное спасибо за советы и за то что Вы всегда на связи.Буду разбираться дальше.
-
6 минут назад, krapotkin сказал:
Dm самый обычный только создавать его автоматически не нужно как и все формы приложения кроме главной.
т.е. создаю новый unit->описываю в нем Tdatamodule и создаю все компоненты динамически.верно?
8 минут назад, krapotkin сказал:Про массив все верно. Только вместо него лучше взять tthreadlist.
Я еще нашел на другом форуме Вы предлагали использовать TObjectList, он подойдет?(Вроде не сложен в использовании)
-
Спасибо большое за оперативный ответ и за отклик в принципе!!!
Правильно ли я понимаю:
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;
а потом для в реализации класса чередовать их или для каждой таблицы использовать свой элемент массива?
-
Здравствуйте,
Подскажите как правильно организовать работу с БД в классах.Есть БД(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 Сильно не ругайте, только учусь.
-
Классная штука, но в Berlin 10.1 up2 тоже не работает цвет.И при очистке вылетает ошибка "Invalid pointer operation".
Если кто-нибудь знает как исправить, буду очень благодарен.
-
Здавствуйте,
кто-нибудь знает, а будет ли данный пример работать на community edition?Ведь там вроде нельзя исходники менять.
Да и вообще интересно, будут ли работать в CE такие вещи как например ModernLV или vkbdhelper.pas(авто прокрутка к полю ввода), если подкинуть их к проекту?
-
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;
Только есть минус:по удержанию пальца текст не получиться выделить.
-
Для 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;
-
В общем весь день убил на поиски, так ничего и не нашел.Нашел все что хотел,но только все старое что уже не работает.
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
-
Я в шоке, нашел))Как все было просто.а вот как в stringgrid?
И как сделать чтобы значение value бралось из другой колонки тойже сточки?
procedure TForm1.Grid1GetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue); begin if aCol = 1 then Value := 50; end;
-
-
Сам не знаю как, но получилось)))пол дня читал форумы чтобы хоть что-то понять из этого.
И методом "научного тыка" вот:
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'у большое спасибо за наводку.
Если кто знает что нужно добавить\исправить для гарантированно стабильной(без сюрпризов в дальнейшем) работы кода, буду благодарен.
-
16 часов назад, Slym сказал:
SharedActivity.startActivityForResult(intent, 0);
результат получаешь в TMessageResultNotification
intent.getStringExtra("SCAN_RESULT");
intent.getStringExtra("SCAN_RESULT_FORMAT");Спасибо за ответ.Вот только знать бы как это все работает и где это применить((Буду изучать...еще раз спасибо.
-
Добрый вечер. Пытаюсь добавить сканеровку 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 открывается сканер, сканирую и приложение зависает(в оснавном когда сканирую первый раз).
-
Здравствуйте, экспериментирую с загрузкой своих иконок в 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. если ничего не обрезать, то все работает как надо.
-
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; -
Здравствуйте,
Хочу сохранять настройки приложения, например выбранный индекс 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 придется еще один файл добавлять.
-
6 минут назад, krapotkin сказал:
смелее используйте F1
Да спасибо, я в основном читаю все на http://docwiki.embarcadero.com там и браузер мне все переводит на русский, а это
"там будет описание метода и модуль где он находится System.Threading" не доглядел.Спасибо.Будим учить дальше.
P.S Фреймы еще не успел посмотреть, чувствую интересная штука.))
-
6 минут назад, slav_z сказал:
ну здесь же Button29 не разрушается... тыкая по кнопке будут проблемы если убивается сам элемент по которому тыкать...
ах да, точно, понял, спасибо.
-
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;?
Извиняюсь за вопросы "чайника". Пишу можно сказать первый проект для себя, и в процессе осваиваю язык.Много чего становится понятным и станавится на свои места в понимании, но еще гораздо больше пока для меня дремучий лес.
-
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; -
21 час назад, #WAMACO сказал:
Что? Опять? Сериал. Новый сезон. "Убийство кнопок" :))
))))Пока не сериал,но к этому идет.Пока только затянувшийся фильмец.))Причем в котором я пока не могу разгадать сюжет.
Если есть чем помочь по теме,буду премного благодарен.
-
Уже замучался, помогите.
Вот так создаю окошко в котором поле ввода тескста и кнопка.
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, кнопка и т.п).
А если сделать все тоже самое только через таймер,т.е таймер будет убивать компоненты, то все работает как надо.
Может причина была в том что кнопка поторая убивала компоненты , не должна была убивать и саму себя?
Access Violation на чистом проекте
в Вопросы
Опубликовано
Боюсь обновлять версию,хоть и хотелось бы. Т.к не знаю как ее нормально удалить. Деинсталятора нет. А обычно когда такие большие программы удаляешь вручную, ни к чему хорошему это не приводит.Я имею ввиду конфликты новой версии с остатками старой.Поэтому пока работает пусть работает)) Спасибо за ответ.