Конференция "KOL" » KOL 3.23 [Delphi, Windows]
 
  • 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>
               <!-- Windows 10 -->
               <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
               <!-- Windows 8.1 -->
               <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
               <!-- Windows Vista -->
               <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
               <!-- Windows 7 -->
               <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
               <!-- Windows 8 -->
               <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 независимо от заданного. Эта шляпа тянется уже давно - то работает, то после очередного обновления КОЛ опять не работает.
 
Конференция "KOL" » KOL 3.23 [Delphi, Windows]
Есть новые Нет новых   [87919   +42][b:0.002][p:0.015]