-
-
@thaddy: Reading without action for me like no reaction)
-
Action taken right now. I'll have a look...
Was easier by email...
-
After one minute:
procedure TForm1.Button1Click(Sender: PObj);
var
i : Integer;
begin
for I := 1 to 4000 do
begin
lv := NewListView(Form, lvsList, [], nil, nil, nil);
try
lv.Show;
finally
lv.Free;
end;
end;
end;
No leaks.... Slightly improved.....
form.BeginUpdate;
try
for I := 1 to 4000 do
begin
lv := NewListView(Form, lvsList, [], nil, nil, nil);
try
lv.Show;
finally
lv.Free;
end;
finally
Form.EndUpdate;
end;
end;
No leaks at all.... And finally:
procedure TForm1.Button2Click(Sender: PObj);
begin
if Assigned(lv) then lv.Free;
end;
Case closed.
-
BTW the trick is of course:
SHOWMODAL!
-
The lesson is: your program doesn't have full control over OS resources when your application has no time to respond to messages. Although Autofree does a good job, it still needs to be notified. AND you are creating the listview in a procedure again and again. in that case NO framework can guarantee that the original object is already freed. By using a try finally block you can prevent this.
Second mistake: you use show, where you really want to use either showmodal or use the virtual listview option (Vladimir has an excellent example on kolmck,net)
Third mistake: too many screen updates... Lock the form, with begin update ensures that no paint messages are send until you are finished with your work (be sure to unlock it!)
Fourth mistake:
The way you have written the code can cause the conflict that there is no listview at all, so you have to check if it is not already destroyed.
If you test your code with my small improvements, you will find that it does not leak at all. But good programming is completely different. I can point you to at least a dozen other basic mistakes in the rest of the your program.
-
Easy to make mistakes:
form.BeginUpdate;
try
for I := 1 to 4000 do
begin
lv := NewListView(Form, lvsList, [], nil, nil, nil);
try
lv.Show;
finally
lv.Free;
end;
end;
finally
Form.EndUpdate;
end;
end;
-
It doesn't leak, but it does not show either <smile>
Programming in human memory isn't without flaws...
But then again: the code is nonsense.
Why would you do that?
In the VCL application you solved things more normal. But with a totally different algorithm. Your KOL code has to many mistakes anyway.
If you really want to create a new listview object every 4000 times --- do the screen lock in the loop too..... It still doesn't leak and this time everything is tested with memproof (I can prove it!)
-
2 thaddy:
Please send me a compiled EXE and project source of example, which create and destroy 4000 ListViews
-
В общем, ответа от thaddy нет, а проблема остается - создать (и уничтожить) 4000 ListView в программе на KOL не представляется возможным.
Причем не важно, сразу создавать или размазывать код по времени.
-
Страдаете откровенной ерундой. вот код, утечек нет.
procedure TForm1.Button1Click(Sender: PObj);
var
i : Integer;
begin
for I := 1 to 4000 do begin
lv := NewListView(Form, lvsList, [], nil, nil, nil);
lv.SetPosition(0, 0).SetSize(20, 20);
Form.Invalidate;
lv.Free;
end;
end;
а так же читаем комменты в коле
procedure Show;
где тут написано что можно юзать метод с листвью?
-
Попробуйте UNICODE_CTRLS. В новых Delphi начиная с 2009, как я понимаю, иначе и не получается, там этот символ просто должен быть. (Хорошо бы еще понять, как сделать, чтобы утечки не было без него - для старых Delphi. Возможно, надо отлавливать какое-нибудь событие с W на конце имени, хотя контрол и не уникодовский. Первый раз подобное было замечено с treeview).
2Dufa: Однако, можно. Не помню как раньше (и было ли иначе), но сейчас это то же самое что Visible := true;
-
Все, разобрался. Действительно, UNICODE не при чем. Действительно, имеется утечка - именно для ListView. Надо было отнести код, удаляющий привязку контрола к окну, в WM_NCDESTROY. Есть некоторые сомнения, что абсолютно все будет работать корректно:
- как минимум, пришлось вызвать обработчик WM_NCDESTROY по умолчанию
- так же, в коде есть комментарий по поводу исправления для корректного уничтожения progress bar'а (версия 2.41-2.42). Я проверил - вроде бы все нормально после переноса, но может, я что-то не учел.
- дополнительно, есть вероятность, что требуется проверка того, что сообщение WM_DESTROY / WM_NCDESTROY пришло от своего собственного окна. Заключение в кавычки {IFnDEF SMALLER_CODE}, видимо, достаточно - в общем случае проверка останется.
- изменения могут привести к тому, что несколько больше обработчиков событий и оконных сообщений может срабатывать в момент разрушения контрола или формы. Но в принципе, особых проблем не наблюдается - на тестах.
Сейчас я приготовлю обновление. Если есть пожелания о внесении в версию каких-либо изменений, пишите сейчас.
-
хотелось бы для мост копабилити в TKOLStrList между анси и юникодом наблюдать property values
interface
type
PWStrList = ^TWstrList;
procedure OptimizeForRead;
protected
procedure SetValue(const AName, Value: KOLWideString);
function GetValue(const AName: KOLWideString): KOLWideString;
public
function IndexOfName(AName: KOLWideString): Integer;
property Values[const AName: KOLWideString]: KOLWideString read GetValue write SetValue;
end;
implementation
procedure TWStrList.OptimizeForRead;
begin
if fList <> nil then
fList.OptimizeForRead;
end;
function TWStrList.IndexOfName(AName: KOLWideString): Integer;
var i: Integer;
L: Integer;
fCount: integer;
begin
Result:=-1;
L := Length( AName );
if L > 0 then
begin
AName := WLowerCase( AName ) + fNameDelim;
Inc( L );
fCount := GetCount - 1;
for i := 0 to fCount do
begin
if _WStrLComp( PWideChar( WLowerCase( ItemPtrs[ i ] ) ), PWideChar( AName ), L ) = 0 then
begin
Result:=i; exit;
end;
end;
end;
end;
procedure TWStrList.SetValue(const AName, Value: KOLWideString);
var
I: Integer;
begin
I := IndexOfName(AName);
if i=-1
then Add( AName + fNameDelim + Value )
else Items[i] := AName + fNameDelim + Value;
end;
function TWStrList.GetValue(const AName: KOLWideString): KOLWideString;
var
i: Integer;
begin
I := IndexOfName(AName);
if I >= 0
then Result := Copy(Items[i], Length(AName) + 2, Length(Items[i])-Length(AName)-1)
else Result := '';
end;
-
так, еще?
|
Есть новые 
Нет новых [134427 +34][b:0][p:0.004]