Новости от 27 марта 2010 (KOL & MCK v2.90)
[-]
Для символа USE_NAMES, исправлен SetName
Hallif, VK
[*]
TStrList, TStrListEx (так же частично для TWStrList, TWStrListEx) методы IndexOf, IndexOf_NoCase, Find и Sort улучшены, добавлен FindFirst
VK, mdw
[-]
Восстановлена совместимость с Delphi2 и Delphi3
VK
[*]
UNI
Дополнительные изменения для улучшения UNICODE_CTRLS: RemoveSpaces, AnsiCompareText, AnsiCompareStrA, _AnsiCompareStrA, AnsiCompareStrNoCaseA, _AnsiCompareStrNoCaseA, AnsiEq, CompareLVColumns

[-]
Ссылка на uxtheme изменена на uxtheme.dll.
MTsv DN
[-]
Исправления в декларациях (для определенного символа STREAM_COMPAT): SeekMemStream, SetSizeMemStream, ReadMemStream, WriteMemStream, WriteExMemoryStream.
Hallif
[-]
Исправление в WndProcToolbarCtrl для Win98
MTsv DN
[+]
TIcon.LoadFromXXXX теперь понимает иконки WinCE (16 бит на пиксель)
mdw
[+]
ASM версия для WinVer
MTsv DN, VK
[*]
MCK
В mirror.pas и mckCtrls.pas, введен тип TDelphiString и все условные декларации по {$IFDEF _D2009orHigher} устранены - для правильной работы Code Completion.
VK
[-]
TAction.LinkMenuItem исправлен для динамических меню
mdw
[*]
В WndProc_LVCustomDraw, Canvas больше не создается.
mdw

procedure TMCKWizard.Execute;
var
 prj: String;
 unt: String;
 dlg: TSaveDialog;
 lst: TStringList;
begin
 dlg            := TSaveDialog.Create(nil);
 dlg.Options    := [ofOverwritePrompt, ofExtensionDifferent, ofPathMustExist];
 dlg.Title      := 'Save Project';
 dlg.Filter     := 'DPR files|*.dpr';
 dlg.DefaultExt := 'dpr';
 if dlg.Execute then begin
   prj := dlg.FileName;
   if (Pos('.', prj) = Length(prj) - 3) then
     SetLength(prj, Length(prj) - 4);
   dlg.Title := 'Save Unit';
   dlg.Filter := 'PAS files|*.pas';
.....

procedure Swap( var X, Y: Integer ); overload;
{$IFDEF F_P}
var Tmp: Integer;
begin
 Tmp := X;
 X := Y;
 Y := Tmp;
end;
{$ELSE DELPHI}
asm
 MOV  ECX, [EDX]
 XCHG ECX, [EAX]
 MOV  [EDX], ECX
end;
//[END Swap]
{$ENDIF F_P/DELPHI}

//[procedure Swap]
procedure Swap(var X, Y: Byte); overload;
var
 T: Byte;
begin
 T := X;
 X := Y;
 Y := T;
end;

//[FUNCTION _GetDIBPixelsTrueColorWithAlpha]
function _GetDIBPixelsTrueColorWithAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
var
 Pixel: DWORD;
 RGB:   TRGBQuad;
begin
 Pixel := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta +
                  X * Bmp.fBytesPerPixel )^ and $FFFFFFFF;
 RGB := TRGBQuad(Pixel);
 Swap(RGB.rgbBlue, RGB.rgbRed);
 Result := TColor( RGB );
end;
//[END _GetDIBPixelsTrueColorWithAlpha]

function TBitmap.GetDIBPixels(X, Y: Integer): TColor;
begin
 if not Assigned( fGetDIBPixels ) then
 begin
   if fHandleType = bmDIB then
   begin
     fScanLine0 := ScanLine[ 0 ];
     fScanLineDelta := Integer(ScanLine[ 1 ]) - Integer(fScanLine0);
     case PixelFormat of
     pf1bit:
       begin
         fPixelMask := $01;
         fPixelsPerByteMask := 7;
         fGetDIBPixels := _GetDIBPixelsPalIdx;
       end;
     pf4bit:
       begin
         fPixelMask := $0F;
         fPixelsPerByteMask := 1;
         fGetDIBPixels := _GetDIBPixelsPalIdx;
       end;
     pf8bit:
       begin
         fPixelMask := $FF;
         fPixelsPerByteMask := 0;
         fGetDIBPixels := _GetDIBPixelsPalIdx;
       end;
     pf15bit:
       begin
         fPixelMask := 15;
         fGetDIBPixels := _GetDIBPixels16bit;
       end;
     pf16bit:
       begin
         fPixelMask := 16;
         fGetDIBPixels := _GetDIBPixels16bit;
       end;
     pf24bit:
       begin
         fPixelsPerByteMask := 0;
         fBytesPerPixel := 3;
         fGetDIBPixels := _GetDIBPixelsTrueColor;
       end;
     pf32bit:
       begin
         fPixelsPerByteMask := 1;
         fBytesPerPixel := 4;
         fGetDIBPixels := {$IFDEF FIXDIB32}_GetDIBPixelsTrueColorWithAlpha{$ELSE}_GetDIBPixelsTrueColor{$ENDIF};
       end;
     else;
     end;
   end;
   if not Assigned( fGetDIBPixels ) then
   begin
     Result := Pixels[ X, Y ];
     Exit;
   end;
 end;
 Result := fGetDIBPixels( @Self, X, Y );
end;

...

//[PROCEDURE _SetDIBPixelsTrueColorWithAlpha]
procedure _SetDIBPixelsTrueColorWithAlpha(Bmp: PBitmap; X, Y: Integer; Value: TColor);
var RGB: TRGBQuad;
   Pos: PDWord;
begin
 RGB := TRGBQuad({Color2RGB}(Value));
 Swap(RGB.rgbBlue, RGB.rgbRed);

 Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
                + X * Bmp.fBytesPerPixel );
 Pos^ := Pos^ {and $FF000000} or DWORD(RGB);
end;
//[END _SetDIBPixelsTrueColorWithAlpha]

procedure TBitmap.SetDIBPixels(X, Y: Integer; const Value: TColor);
begin
 if not Assigned( fSetDIBPixels ) then
 begin
   if fHandleType = bmDIB then
   begin
     fScanLine0 := ScanLine[ 0 ];
     fScanLineDelta := Integer(ScanLine[ 1 ]) - Integer(fScanLine0);
     case PixelFormat of
     pf1bit:
       begin
         //fPixelMask := $01;
         //fPixelsPerByteMask := 7;
         fSetDIBPixels := _SetDIBPixels1bit;
       end;
     pf4bit:
       begin
         fPixelMask := $0F;
         fPixelsPerByteMask := 1;
         fSetDIBPixels := _SetDIBPixelsPalIdx;
       end;
     pf8bit:
       begin
         fPixelMask := $FF;
         fPixelsPerByteMask := 0;
         fSetDIBPixels := _SetDIBPixelsPalIdx;
       end;
     pf15bit:
       begin
         fPixelMask := 15;
         fSetDIBPixels := _SetDIBPixels16bit;
       end;
     pf16bit:
       begin
         fPixelMask := 16;
         fSetDIBPixels := _SetDIBPixels16bit;
       end;
     pf24bit:
       begin
         fPixelsPerByteMask := 0;
         fBytesPerPixel := 3;
         fSetDIBPixels := _SetDIBPixelsTrueColor;
       end;
     pf32bit:
       begin
         fPixelsPerByteMask := 1;
         fBytesPerPixel := 4;
         fSetDIBPixels := {$IFDEF FIXDIB32}_SetDIBPixelsTrueColorWithAlpha{$ELSE}_SetDIBPixelsTrueColor{$ENDIF};
       end;
     else;
     end;
   end;
   if not Assigned( fSetDIBPixels ) then
   begin
     Pixels[ X, Y ] := Value;
     Exit;
   end;
 end;
 fSetDIBPixels( @Self, X, Y, Value );
end;

M.FMenuItems.Remove( Result );

M.FMenuItems.Remove( Result );

if Result.FParentMenu <> nil then
Result.FParentMenu.FMenuItems.Remove( Result );

Items.Remove(Result);

Items.Remove(Result);

property Items[ Id: HMenu ]: PMenu

//[function TMenu.RemoveSubMenu]
function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu;
{$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF}
begin
 Result := Items[ ItemToRemove ];
 if Result = nil then Exit;
 if Result.FParentMenu <> nil then
   {$IFDEF DEBUG_MENU} OK := {$ENDIF}
   RemoveMenu( Result.FParentMenu.FHandle, Result.FId, MF_BYCOMMAND )
 else
   {$IFDEF DEBUG_MENU} OK := {$ENDIF}
   RemoveMenu( FHandle, Result.FId, MF_BYCOMMAND );
 {$IFDEF DEBUG_MENU}
 if not OK then
   ShowMessage( 'Error removing menu: ' + Int2Str( GetLastError ) + ' - ' +
                SysErrorMessage( GetLastError ) );
 {$ENDIF}
 if Count = 0 then
 begin
   Result.Free;
   Result := nil;
 end;
 RedrawFormMenuBar;
end;

//[function TMenu.RemoveSubMenu]
function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu;
{$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF}
var M: PMenu;
begin
 Result := Items[ ItemToRemove ];
 if Result = nil then Exit;
 M := Result.FParentMenu;
 if M = nil then M := @Self;
 {$IFDEF DEBUG_MENU} OK := {$ENDIF}
 RemoveMenu( M.FHandle, Result.FId, MF_BYCOMMAND );
 M.FMenuItems.Remove( Result );
 {$IFDEF DEBUG_MENU}
 if not OK then
   ShowMessage( 'Error removing menu: ' + Int2Str( GetLastError ) + ' - ' +
                SysErrorMessage( GetLastError ) );
 {$ENDIF}
 if Count = 0 then
 begin
   Result.Free;
   Result := nil;
 end;
 RedrawFormMenuBar;
end;

M.FMenuItems.Remove( Result );

 
 ...
 if  L >= Count then
     Dec( L );
 Index := L;
 if  not Result then
     Result := fCompareStrListFun( PAnsiChar( fList.Items[ L ] ),
                                   PAnsiChar( S ) ) = 0;

function TStrList.Find(const S: AnsiString; var Index: Integer): Boolean;
var
 L, H, I, C: Integer;
begin
 Result := FALSE;
 L := 0;
 H := FCount - 1;
 if  H < 0 then Exit; // === if FCount = 0 then Exit;
 if  fAnsiSort then
 begin
     if  fCaseSensitiveSort then
         fCompareStrListFun := CompareAnsiCase
     else
         fCompareStrListFun := CompareAnsiNoCase;
 end
   else
 begin
     if  fCaseSensitiveSort then
         fCompareStrListFun := StrComp
     else
         fCompareStrListFun := StrComp_NoCase;
 end;
 C := 0;
 while L <= H do
 begin
   I := (L + H) shr 1;
   C := fCompareStrListFun( PAnsiChar( fList.Items[ I ] ),
                            PAnsiChar( S ) );
   if C < 0 then L := I + 1 else
   begin
     H := I - 1;
     if C = 0 then
     begin
       Result := TRUE;
       Index := I;
       Exit;
     end;
   end;
 end;
 Index := L;
 if  C < 0 then Index := -L;
end;

if Index < 0 then Insert( -Index, sNew ) else Insert( Index+1, sNew );

function TStrList.Find(const S: AnsiString; var Index: Integer): Boolean;
var
 L, H, C: Integer;
begin
 Result := FALSE;
 Index := 0;
 L := 0;
 H := FCount - 1;
 if  H < 0 then Exit; // === if FCount = 0 then Exit;
 if  fAnsiSort then
 begin
     if  fCaseSensitiveSort then
         fCompareStrListFun := CompareAnsiCase
     else
         fCompareStrListFun := CompareAnsiNoCase;
 end
   else
 begin
     if  fCaseSensitiveSort then
         fCompareStrListFun := StrComp
     else
         fCompareStrListFun := StrComp_NoCase;
 end;
 C := 0;
 while L <= H do
 begin
   Index := (L + H) shr 1;
   C := fCompareStrListFun( PAnsiChar( fList.Items[ Index ] ),
                            PAnsiChar( S ) );
   if C < 0 then L := Index + 1 else
   begin
     H := Index - 1;
     if C = 0 then
     begin
       Result := TRUE;
       Exit;
     end;
   end;
 end;
 if  C < 0 then Index := -L;
end;

function StrComp(const Str1, Str2: PAnsiChar): Integer; assembler;
asm
 {$IFDEF F_P}
       MOV     EAX, [Str1]
       MOV     EDX, [Str2]
 {$ENDIF F_P}
 MOV CL, [EAX]
 SUB CL, [EDX]
 JZ  @@compare
 MOVSX EAX, CL
 JMP @@fin
@@compare:

       PUSH    EDI
       PUSH    ESI
       MOV     EDI,EDX
       XCHG    ESI,EAX
       OR      ECX, -1
       XOR     EAX,EAX
       REPE    CMPSB
       MOV     AL,[ESI-1]
       MOV     DL,[EDI-1]
       SUB     EAX,EDX
       POP     ESI
       POP     EDI
@@fin:
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer;
asm
 {$IFDEF F_P}
       MOV     EAX, [Str1]
       MOV     EDX, [Str2]
 {$ENDIF F_P}
       PUSH    EDI
       PUSH    ESI
       MOV     EDI,EDX
       XCHG    ESI,EAX
       OR      ECX, -1
       
       MOV     EDI,EDX
 @@0:
       XOR     EDX,EDX
       REPE    CMPSB
       MOV     AL,[ESI-1]
       MOV     AH, AL
       SUB     AH, 'a'
       CMP     AH, 25
       JA      @@1
       SUB     AL, $20
 @@1:
       MOV     DL,[EDI-1]
       MOV     AH, DL
       SUB     AH, 'a'
       CMP     AH, 25
       JA      @@2
       SUB     DL, $20
 @@2:
       MOV     AH, 0
       SUB     EAX,EDX
       JNZ     @@exit
       CMP     DL, 0
       JNZ     @@0

 @@exit:
       POP     ESI
       POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function WndProcForm(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

if fModalForm <> nil then

     if Self_.fModalForm <> nil then
       SetFocus( Self_.fModalForm.fHandle )
     else if ( Self_.FCurrentControl <> nil ) and
             not ( Self_.fCurrentControl.IsForm xor Self_.fIsApplet ) then

if (Child <> nil)
      and (Child <> Self_) //+ by Galkov, Jun-2009

{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IF Defined(KOL_MCK)}{$ELSE}, mirror, Classes,  mckCCtrls, Controls, mckCtrls {$ENDIF};
{$ELSE}
{$I uses.inc} mirror,
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
{$ENDIF}

{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IFNDEF KOL_MCK}, mirror, Classes,  mckCCtrls, Controls, mckCtrls {$ENDIF};
{$ELSE}
{$I uses.inc} mirror,
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
{$ENDIF}

Windows.PMenuitemInfo( @ MII )^ );

function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm
      CMP      word ptr [EDX].TMsg.message, WM_NOTIFY
      JNE      @@ret_false
       PUSH     ECX
       PUSH     EDX
      push     eax
      MOV      ECX, [EDX].TMsg.lParam
      {$IFDEF USE_PROP}
      PUSH     offset[ID_SELF]
      PUSH     [ECX].TNMHdr.hwndFrom
      CALL     GetProp
      {$ELSE}
      PUSH     GWL_USERDATA
      PUSH     [ECX].TNMHdr.hwndFrom
      CALL     GetWindowLong
      {$ENDIF}
       pop      ecx
       POP      EDX
       TEST     EAX, EAX
       JZ       @@ret_false_ECX
       cmp      eax, ecx
       jz       @@ret_false_ECX
       MOV      ECX, [EAX].TControl.fHandle
       MOV      [EDX].TMsg.hwnd, ECX
       POP      ECX
      JMP      TControl.EnumDynHandlers
@@ret_false_ECX:
       POP      ECX
@@ret_false:
      XOR      EAX, EAX
end;

   MainMenu1.ItemEnabled[mmUndo] :=
   not MainMenu1.ItemEnabled[mmUndo];

ComboBox.Add('впвпавпвпва');

var s:KOLString;
begin
s:='впвпавпвпва';
ComboBox.Add(s);
end;

var Buffer: array[ 0..2047 ] of KOLChar;

var Buffer: array[ 0..1023 ] of byte;
----------
Result := PKOLChar(@Buffer[0]);

procedure TList.SetCapacity( Value: Integer );
asm
       CMP       EDX, [EAX].fCount
       {$IFDEF USE_CMOV}
       CMOVL     EDX, [EAX].fCount
       {$ELSE}
       JGE       @@1
       MOV       EDX, [EAX].fCount
@@1:    {$ENDIF}
       CMP       EDX, [EAX].fCapacity
       JE        @@exit

       MOV       [EAX].fCapacity, EDX
       SAL       EDX, 2
       LEA       EAX, [EAX].fItems
      CALL      System.@ReallocMem
@@exit:
end;

procedure TForm1.KOLForm1Show(Sender: PObj);
var L: PList;
   i: Integer;
begin
   L := NewList;
   for i := 1 to 100000 do
   begin
       L.Add( Pointer( i ) );
   end;
   ShowMessage( Int2Str( L.Count ) );
   L.Free;

if (Msg.message = WM_QUIT) then
     begin
       AppletTerminated := True;
       if HelpFilePath <> '' then
         FreeMem(HelpFilePath);
       {$IFDEF PROVIDE_EXITCODE}
       ExitCode := Msg.wParam;
       {$ENDIF PROVIDE_EXITCODE}
     end

procedure TForm1.ListView1LVStateChange(Sender: PControl; IdxFrom,
 IdxTo: Integer; OldState, NewState: Cardinal);
var i: Integer;
   procedure UpdScr( Ctl: PControl; F: DWORD );
   var j: Integer;
   begin
       GetScrollInfo( Ctl.Handle, F, si );
       si.nPos := i;
       j := SetScrollInfo( Ctl.Handle, F, si, TRUE );
       Form.Caption := 'Current pos = ' + Int2Str(j);
       GetScrollInfo( Ctl.Handle, F, si );
       Label3.Caption := 'nMax=' + Int2Str(si.nMax) +
           ' nPage=' + Int2Str(si.nPage) +
           ' nPos='  + Int2Str(si.nPos);
   end;
begin
   i := ListView1.LVCurItem;
   if i < 0 then Exit;
   UpdScr( Memo1, SB_VERT );
   UpdScr( SBAPI, SB_CTL );
   UpdScr( SBKOL, SB_CTL );
end;