Новости от 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};