PHP DM Gate v0.9 » KOL 3.23 <span class="vd">[Delphi, Windows]</span>

QAZ (24.02.15 15:41) [33]

> Vladimir Kladov © (24.02.15 13:08) [31]

да-да по крайней мере паскальный вариант, самый большой проект, где был Tlist в логе - это и было изза апплета, сейчас все чисто

остался только косяк с фреймами (или табами) в другом

> Запускаем программу (F8), в Watches добавляем PDWORD($7EF43120),
> ставим "Break when changed", и каждый раз, когда первые
> 4 байта меняются, будет останов. Тут можно посмотреть, кто
> выделил.

чет в 7ке нет такого "Break when changed" и пролетает мимо ненаходит

<Цитата>
Vladimir Kladov © (24.02.15 15:59) [34]

PDWORD(адрес)^ - разыменовать надо.

<Цитата>
Vladimir Kladov © (24.02.15 15:59) [34]

PDWORD(адрес)^ - разыменовать надо.

<Цитата>
Vladimir Kladov © (24.02.15 16:07) [35]

Обновил KOL.zip на kolmck.net.

<Цитата>
Vladimir Kladov © (24.02.15 16:07) [35]

Обновил KOL.zip на kolmck.net.

<Цитата>
QAZ (24.02.15 20:40) [36]

табконтрол вроде не причём, на панелях также
фастмм указывает на создание фрейма в файлах типа Unit2_1.inc
procedure NewForm2( var Result: PForm2; AParent: PControl ); begin {$IFDEF KOLCLASSES} Result := PForm2.Create; {$ELSE OBJECTS} New( Result, Create );<<<<<<<<<<<<<<<<<<<<<<<<<< {$ENDIF KOL CLASSES/OBJECTS} Result.Form := NewPanel( AParent, esNone ).MarkPanelAsForm; Result.Form.DF.FormAddress := @ Result.Form; Result.Form.DF.FormObj := Result; Result.Form.SetClientSize( 468, 278 ); Result.EditBox1 := NewEditBox( Result.Form, [ ] ).SetPosition( 168, 104 ); Result.EditBox1.Text := 'EditBox1'; Result.EditBox1.Color := TColor(clWindow); Result.Form.CreateWindow; end;
показано <<<<<<<<<<<<<
хоть free, хоть close - одинаково

<Цитата>
QAZ (24.02.15 20:40) [36]

табконтрол вроде не причём, на панелях также
фастмм указывает на создание фрейма в файлах типа Unit2_1.inc
procedure NewForm2( var Result: PForm2; AParent: PControl ); begin {$IFDEF KOLCLASSES} Result := PForm2.Create; {$ELSE OBJECTS} New( Result, Create );<<<<<<<<<<<<<<<<<<<<<<<<<< {$ENDIF KOL CLASSES/OBJECTS} Result.Form := NewPanel( AParent, esNone ).MarkPanelAsForm; Result.Form.DF.FormAddress := @ Result.Form; Result.Form.DF.FormObj := Result; Result.Form.SetClientSize( 468, 278 ); Result.EditBox1 := NewEditBox( Result.Form, [ ] ).SetPosition( 168, 104 ); Result.EditBox1.Text := 'EditBox1'; Result.EditBox1.Color := TColor(clWindow); Result.Form.CreateWindow; end;
показано <<<<<<<<<<<<<
хоть free, хоть close - одинаково

<Цитата>
Dimaxx © (25.02.15 00:43) [37]

KOL_asm.inc:

procedure Run( var AppletCtl: PControl );
asm
//----- if AppletCtl = nil then Exit;
TEST EAX, EAX
JZ @@exit
PUSH EBX
XCHG EBX, EAX

//----- AppletRunning := TRUE;
INC [AppletRunning]

//----- Applet := AppletCtl;
MOV EAX, [EBX]
MOV [Applet], EAX

//----- AppletCtl.CreateWindow;
CALL CallTControlCreateWindow

//----- WHILE NOT AppletTerminated DO
@@loop: CMP [AppletTerminated], 0
JNZ @@end_loop

//----- WaitMessage;
CALL WaitMessage

//----- AppletCtl.ProcessMessages;
MOV EAX, [EBX]
CALL TControl.ProcessMessages

{$IFDEF USE_OnIdle}
//----- ProcessIdle(AppletCtl);
MOV EAX, [EBX]
CALL [ProcessIdle]
{$ENDIF}

JMP @@loop
@@end_loop:

{$IFDEF LET_MENU_LEAK}
MOV ECX, [EBX]
XCHG EAX, EBX
POP EBX
JECXZ @@exit
{$ELSE}
POP EBX
LEA EAX, [Applet]
CMP [EAX], 0 <-ОШИБКА!!!!
JZ @@exit
{$ENDIF}
CALL TerminateExecution
@@exit:
end;

<Цитата>
Dimaxx © (25.02.15 00:43) [37]

KOL_asm.inc:

procedure Run( var AppletCtl: PControl );
asm
//----- if AppletCtl = nil then Exit;
TEST EAX, EAX
JZ @@exit
PUSH EBX
XCHG EBX, EAX

//----- AppletRunning := TRUE;
INC [AppletRunning]

//----- Applet := AppletCtl;
MOV EAX, [EBX]
MOV [Applet], EAX

//----- AppletCtl.CreateWindow;
CALL CallTControlCreateWindow

//----- WHILE NOT AppletTerminated DO
@@loop: CMP [AppletTerminated], 0
JNZ @@end_loop

//----- WaitMessage;
CALL WaitMessage

//----- AppletCtl.ProcessMessages;
MOV EAX, [EBX]
CALL TControl.ProcessMessages

{$IFDEF USE_OnIdle}
//----- ProcessIdle(AppletCtl);
MOV EAX, [EBX]
CALL [ProcessIdle]
{$ENDIF}

JMP @@loop
@@end_loop:

{$IFDEF LET_MENU_LEAK}
MOV ECX, [EBX]
XCHG EAX, EBX
POP EBX
JECXZ @@exit
{$ELSE}
POP EBX
LEA EAX, [Applet]
CMP [EAX], 0 <-ОШИБКА!!!!
JZ @@exit
{$ENDIF}
CALL TerminateExecution
@@exit:
end;

<Цитата>
Dimaxx © (25.02.15 00:46) [38]

В destructor TMenu.Destroy не используется (но определяется) Next.

<Цитата>
Dimaxx © (25.02.15 00:46) [38]

В destructor TMenu.Destroy не используется (но определяется) Next.

<Цитата>
Vladimir Kladov © (25.02.15 05:35) [39]

> CMP [EAX], 0 <-ОШИБКА!!!!

Какая? В Delphi7 ошибки нет. У вас что, Free Pascal? Delphi 201x? Пишите яснее.

> В destructor TMenu.Destroy не используется (но определяется)
> Next.

destructor TMenu.Destroy;
var Next, Prnt: PMenu;
{$IFNDEF LET_MENU_LEAK}
Save_Ref: Integer;
{$ENDIF}
begin
{$IFDEF DEBUG_MENU_DESTROY}
LogFileOutput( GetStartDir + 'TMenu.Destroy.txt',
Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) );
{$ENDIF}
if Count > 0 then
begin
FMenuItems.ReleaseObjects;
FMenuItems := NewList;
end;
if FParentMenu <> nil then
begin
{$IFNDEF LET_MENU_LEAK}
Save_Ref := Self.fRefCount; //** Очень грязный хак, конечно. Цель: предотвратить
Self.fRefCount := 17; // попытку повторного уничтожения этого объекта меню.
{$ENDIF}
Prnt := FParentMenu;
Next := Prnt.RemoveSubMenu( FId );
FParentMenu := nil;
Prnt.FMenuItems.Remove( @ Self );
{$IFNDEF LET_MENU_LEAK}
Self.fRefCount := Save_Ref; //** Можно было бы и не восстанавливать.
{$ELSE}
if Next = nil then Exit; //** Пришлось закомментарить. Вызывало утечку.
{$ENDIF}
end;
if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then
begin
if {$IFDEF USE_FLAGS} not (G2_Destroying in FControl.fFlagsG2)
{$ELSE} not FControl.fDestroying {$ENDIF} then //!!!fix by Galkov
begin
Windows.SetMenu( FControl.fHandle, 0 );
// this removes main menu from window, but does not destroy it
end;
FControl.fMenu := 0;
Next := PMenu( FControl.fMenuObj );
while Next <> nil do
begin
if Next.fNextMenu = @Self then
begin
Next.fNextMenu := fNextMenu;
break;
end;
Next := Next.fNextMenu;
end;
end;
Next := fNextMenu;
if FBitmap <> 0 then
Bitmap := 0;
if FHandle <> 0 then
begin
//if not
DestroyMenu( FHandle )
// then LogFileOutput( GetStartDir + 'err.log.txt', SysErrorMessage( GetLastError ) )
;
end;
FCaption := '';
FMenuItems.Free;
Next.Free;
inherited;
// all later created (popup) menus (of the same control)
// are destroyed too
end;

Расскажите уже, каким компилятором пользуетесь, что он такую чушь сказал.

<Цитата>
Vladimir Kladov © (25.02.15 05:35) [39]

> CMP [EAX], 0 <-ОШИБКА!!!!

Какая? В Delphi7 ошибки нет. У вас что, Free Pascal? Delphi 201x? Пишите яснее.

> В destructor TMenu.Destroy не используется (но определяется)
> Next.

destructor TMenu.Destroy;
var Next, Prnt: PMenu;
{$IFNDEF LET_MENU_LEAK}
Save_Ref: Integer;
{$ENDIF}
begin
{$IFDEF DEBUG_MENU_DESTROY}
LogFileOutput( GetStartDir + 'TMenu.Destroy.txt',
Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) );
{$ENDIF}
if Count > 0 then
begin
FMenuItems.ReleaseObjects;
FMenuItems := NewList;
end;
if FParentMenu <> nil then
begin
{$IFNDEF LET_MENU_LEAK}
Save_Ref := Self.fRefCount; //** Очень грязный хак, конечно. Цель: предотвратить
Self.fRefCount := 17; // попытку повторного уничтожения этого объекта меню.
{$ENDIF}
Prnt := FParentMenu;
Next := Prnt.RemoveSubMenu( FId );
FParentMenu := nil;
Prnt.FMenuItems.Remove( @ Self );
{$IFNDEF LET_MENU_LEAK}
Self.fRefCount := Save_Ref; //** Можно было бы и не восстанавливать.
{$ELSE}
if Next = nil then Exit; //** Пришлось закомментарить. Вызывало утечку.
{$ENDIF}
end;
if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then
begin
if {$IFDEF USE_FLAGS} not (G2_Destroying in FControl.fFlagsG2)
{$ELSE} not FControl.fDestroying {$ENDIF} then //!!!fix by Galkov
begin
Windows.SetMenu( FControl.fHandle, 0 );
// this removes main menu from window, but does not destroy it
end;
FControl.fMenu := 0;
Next := PMenu( FControl.fMenuObj );
while Next <> nil do
begin
if Next.fNextMenu = @Self then
begin
Next.fNextMenu := fNextMenu;
break;
end;
Next := Next.fNextMenu;
end;
end;
Next := fNextMenu;
if FBitmap <> 0 then
Bitmap := 0;
if FHandle <> 0 then
begin
//if not
DestroyMenu( FHandle )
// then LogFileOutput( GetStartDir + 'err.log.txt', SysErrorMessage( GetLastError ) )
;
end;
FCaption := '';
FMenuItems.Free;
Next.Free;
inherited;
// all later created (popup) menus (of the same control)
// are destroyed too
end;

Расскажите уже, каким компилятором пользуетесь, что он такую чушь сказал.

<Цитата>
Vladimir Kladov © (25.02.15 05:48) [40]

Во вчерашнем обновлении не довставил новый TerminateExecution в KOL_ASM.INC. Поправить смогу только вечером. Берите код, что я здесь привел вчера, и вставьте сами (отличается комментариями с паскаль-кодом). Либо включите PAS_VERSION.

<Цитата>
Vladimir Kladov © (25.02.15 05:48) [40]

Во вчерашнем обновлении не довставил новый TerminateExecution в KOL_ASM.INC. Поправить смогу только вечером. Берите код, что я здесь привел вчера, и вставьте сами (отличается комментариями с паскаль-кодом). Либо включите PAS_VERSION.

<Цитата>
Владимир Кладов (07.05.15 16:33) [55]

Я в курсе. Начиная с Windows 8.1, GetVersion/GetVersionEx объявлена устаревшей. Для того, чтобы приложение правильно определяло версию, к нему нужен специально оформленный манифест.

<Цитата>
DWorker (07.05.15 18:12) [56]

Короткий вариант, определяет до 10 версии (9х поддержки нет):

function WinVerShort: TWindowsVersion;
begin
case LoWord(GetVersion) of
$0005: Result := wvY2K;
$0105: Result := wvXP;
$0205: Result := wvServer2003;
$0006: Result := wvVista;
$0106: Result := wvSeven;
$0206: Result := wvEight;
$0306: Result := wvEight_1;
$000A: Result := wvTen;
else
Result := wvNT;
end;
end;

Нужен подобный манифест:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
<assemblyIdentity
type="win32"
name="DelphiApplication"
version="1.0.0.0"
processorArchitecture="*"
/>
<description> my foo exe </description>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
<security>
<requestedPrivileges>
<requestedExecutionLevel
level="asInvoker"
uiAccess="false"
/>
</requestedPrivileges>
</security>
</trustInfo>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
<application>

<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>

<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>

<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>

<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>

<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
</application>
</compatibility>
</assembly>

<Цитата>
alexacolor (08.05.15 11:06) [57]

актуальный манифест нынче очень полезен.

функция _WStrLComp в паскалевском исполнении за гранью добра и зла
из за неё не работают Name Value в WStrList, например

<Цитата>
alexacolor (08.05.15 14:09) [58]

p.s. Ну не то что бы за гранью, но может запилить SVN комюнити?
Образовалось ещё одно применение для KOL: firemonkey программы для Windows. Всякие Tray Icon, tree и прочее

<Цитата>
Dimaxx © (11.05.15 22:12) [59]

При создании приложения в KOLProject меняем шрифт - в проекте в файле .inc меняются параметры любые, кроме имени шрифта. В итоге шрифт ВСЕГДА System независимо от заданного. Эта шляпа тянется уже давно - то работает, то после очередного обновления КОЛ опять не работает.

<Цитата>