/mckObjs.pas

Large files files are truncated, but you can click here to view the full file

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



        KKKKK    KKKKK    OOOOOOOOO    LLLLL

        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLL

        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL

        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL

        KKKKKKKKKK      OOOOO   OOOOO  LLLLL

        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL

        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL

        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLLLLLLLLLL     kkkkk

        KKKKK    KKKKK    OOOOOOOOO    LLLLLLLLLLLLL    kkkkk

                                                       kkkkk

    mmmmm  mmmmm   mmmmmm          cccccccccccc       kkkkk   kkkkk

   mmmmmmmm   mmmmm     mmmmm   cccccc       ccccc   kkkkk kkkkk

  mmmmmmmm   mmmmm     mmmmm   cccccc               kkkkkkkk

 mmmmm      mmmmm     mmmmm   cccccc      ccccc    kkkkk  kkkkk

mmmmm      mmmmm     mmmmm     cccccccccccc       kkkkk     kkkkk



  Key Objects Library (C) 2000 by Kladov Vladimir.

  KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.

}

unit mckObjs;



interface



{$I KOLDEF.INC}



uses KOL, Classes, Forms, Controls, Dialogs, Windows, Messages, extctrls,

     stdctrls, comctrls, SysUtils, Graphics, mirror, ShellAPI,

     buttons, mckFileFilterEditor,

//////////////////////////////////////////

     {$IFDEF _D6orHigher}               //

     DesignIntf, DesignEditors          //

     {$ELSE}                            //

//////////////////////////////////////////

     DsgnIntf

//////////////////////////////////////////

     {$ENDIF}                           //

//////////////////////////////////////////

     {$IFNDEF _D2} {$IFNDEF _d3}, imglist {$ENDIF} {$ENDIF},

     TypInfo, menus;



type

  //============================================================================

  //---- MIRROR FOR A TIMER ----

  //---- ÇÅÐÊÀËÎ ÄËß ÒÀÉÌÅÐÀ ----

  TKOLTimer = class(TKOLObj)

  private

    FEnabled: Boolean;

    FInterval: Integer;

    FOnTimer: TOnEvent;

    FPeriodic: Boolean;

    FMultimedia: Boolean;

    FResolution: Integer;

    procedure SetEnabled(const Value: Boolean);

    procedure SetInterval(const Value: Integer);

    procedure SetOnTimer(const Value: TOnEvent);

    procedure SetMultimedia(const Value: Boolean);

    procedure SetPeriodic(const Value: Boolean);

    procedure SetResolution(const Value: Integer);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );

              override;

    procedure AssignEvents( SL: TStringList; const AName: String ); override;

    procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );

              override;

  public

    function TypeName: String; override;

    constructor Create( AOwner: TComponent ); override;

  published

    property Interval: Integer read FInterval write SetInterval;

    property Enabled: Boolean read FEnabled write SetEnabled;

    property OnTimer: TOnEvent read FOnTimer write SetOnTimer;

    property Multimedia: Boolean read FMultimedia write SetMultimedia;

    property Resolution: Integer read FResolution write SetResolution;

    property Periodic: Boolean read FPeriodic write SetPeriodic;

  end;



  //============================================================================

  //---- MIRROR FOR A THREAD ----

  //---- ÇÅÐÊÀËÎ ÄËß ÍÈÒÈ ----

  TPriorityClass = ( pcNormal, pcIdle, pcHigh, pcRealTime );

  TThreadPriority = ( tpNormal, tpBelowNormal, tpLowest, tpIdle, tpAboveNormal,

                      tpHighest, tpCritical );



  TKOLThread = class(TKOLObj)

  private

    FPriorityClass: TPriorityClass;

    FThreadPriority: TThreadPriority;

    FOnExecute: TOnThreadExecute;

    FOnSuspend: TObjectMethod;

    FOnResume: TOnEvent;

    FstartSuspended: Boolean;

    F_AutoFree: Boolean;

    procedure SetPriorityClass(const Value: TPriorityClass);

    procedure SetThreadPriority(const Value: TThreadPriority);

    procedure SetOnExecute(const Value: TOnThreadExecute);

    procedure SetOnSuspend(const Value: TObjectMethod);

    procedure SetOnResume(const Value: TOnEvent);

    procedure SetstartSuspended(const Value: Boolean);

    procedure SetAutoFree(const Value: Boolean);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure AssignEvents( SL: TStringList; const AName: String ); override;

    function NotAutoFree: Boolean; override;

    function BestEventName: String; override;

  public

  published

    property PriorityClass: TPriorityClass read FPriorityClass write SetPriorityClass;

    property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority;

    property OnExecute: TOnThreadExecute read FOnExecute write SetOnExecute;

    property OnSuspend: TObjectMethod read FOnSuspend write SetOnSuspend;

    property OnResume: TOnEvent read FOnResume write SetOnResume;

    property startSuspended: Boolean read FstartSuspended write SetstartSuspended;

    property AutoFree: Boolean read F_AutoFree write SetAutoFree;

  end;



  //============================================================================

  //---- MIRROR FOR AN IMAGELIST ----

  //---- ÇÅÐÊÀËÎ ÄËß ÑÏÈÑÊÀ ÐÈÑÓÍÊÎÂ ----

  TKOLImageList = class(TKOLObj)

  private

    FImgWidth: Integer;

    FImgHeight: Integer;

    FCount: Integer;

    FBitmap: TBitmap;

    FSystemImageList: Boolean;

    FTransparentColor: TColor;

    FColors: TImageListColors;

    FMasked: Boolean;

    FBkColor: TColor;

    procedure SetImgHeight(Value: Integer);

    procedure SetImgWidth(Value: Integer);

    procedure SetCount(const Value: Integer);

    procedure SetBitmap(const Value: TBitmap);

    procedure SetSystemImageList(const Value: Boolean);

    function GetBitmap: TBitmap;

    procedure SetTransparentColor(const Value: TColor);

    function GetTransparentColor: TColor;

    procedure SetColors(const Value: TImageListColors);

    procedure SetMasked(const Value: Boolean);

    procedure SetBkColor(const Value: TColor);

    function GetImageListHandle: THandle;

    procedure AssignBitmapToKOLImgList;

  protected

    FKOLImgList: PImageList;

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );

              override;

    //procedure BitmapChanged( Sender: TObject );

  public

    constructor Create( AOwner: TComponent ); override;

    destructor Destroy; override;

    procedure Clear;

    procedure Assign( Value: TPersistent ); override;

    property Handle: THandle read GetImageListHandle;

  published

    property ImgWidth: Integer read FImgWidth write SetImgWidth;

    property ImgHeight: Integer read FImgHeight write SetImgHeight;

    property Count: Integer read FCount write SetCount;

    property bitmap: TBitmap read GetBitmap write SetBitmap;

    property TransparentColor: TColor read GetTransparentColor write SetTransparentColor;

    property systemimagelist: Boolean read FSystemImageList write SetSystemImageList;

    property Colors: TImageListColors read FColors write SetColors;

    property Masked: Boolean read FMasked write SetMasked;

    property BkColor: TColor read FBkColor write SetBkColor;

  end;



  TKOLImageListEditor = class(TComponentEditor)

  private

  protected

  public

    procedure Edit; override;

    procedure ExecuteVerb(Index: Integer); override;

    function GetVerb(Index: Integer): string; override;

    function GetVerbCount: Integer; override;

  end;



  //----------------------------------------------------------------------------

  //---- MIRROR FOR OPENSAVE FILE DIALOG ----

  //---- ÇÅÐÊÀËÎ ÄËß ÄÈÀËÎÃÀ ÂÛÁÎÐÀ ÔÀÉËÀ ----

  TKOLOpenSaveDialog = class(TKOLObj)

  private

    FOptions: TOpenSaveOptions;

    FInitialDir: String;

    FFilter: String;

    FFilterIndex: Integer;

    FTitle: String;

    FDefExtension: String;

    FOpenDialog: Boolean;

    FTemplateName: String;

    procedure SetOptions(const Value: TOpenSaveOptions);

    procedure SetInitialDir(const Value: String);

    procedure SetFilter(const Value: String);

    procedure SetFilterIndex(const Value: Integer);

    procedure SetTitle(const Value: String);

    procedure SetDefExtension(const Value: String);

    procedure SetOpenDialog(const Value: Boolean);

    procedure SetTemplateName(const Value: String);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;

  public

    constructor Create( AOwner: TComponent ); override;

  published

    property Options: TOpenSaveOptions read FOptions write SetOptions;

    property Title: String read FTitle write SetTitle;

    property TemplateName: String read FTemplateName write SetTemplateName;

    property InitialDir: String read FInitialDir write SetInitialDir;

    property Filter: String read FFilter write SetFilter;

    property FilterIndex: Integer read FFilterIndex write SetFilterIndex;

    property DefExtension: String read FDefExtension write SetDefExtension;

    property OpenDialog: Boolean read FOpenDialog write SetOpenDialog;

    property Localizy;

  end;



  TKOLFileFilter = class( TStringProperty )

  private

  protected

  public

    function GetAttributes: TPropertyAttributes; override;

    procedure Edit; override;

  end;



  //----------------------------------------------------------------------------

  //---- MIRROR FOR OPENDIR DIALOG ----

  //---- ÇÅÐÊÀËÎ ÄËß ÄÈÀËÎÃÀ ÂÛÁÎÐÀ ÄÈÐÅÊÒÎÐÈß ----

  TKOLOpenDirDialog = class( TKOLObj )

  private

    FTitle: String;

    FOptions: TOpenDirOptions;

    FInitialPath: String;

    FCenterOnScreen: Boolean;

    FOnSelChanged: TOnODSelChange;

    procedure SetTitle(const Value: String);

    procedure SetOptions(const Value: TOpenDirOptions);

    procedure SetInitialPath(const Value: String);

    procedure SetCenterOnScreen(const Value: Boolean);

    procedure SetOnSelChanged(const Value: TOnODSelChange);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure AssignEvents( SL: TStringList; const AName: String ); override;

  public

    constructor Create( AOwner: TComponent ); override;

  published

    property Title: String read FTitle write SetTitle;

    property Options: TOpenDirOptions read FOptions write SetOptions;

    property InitialPath: String read FInitialPath write SetInitialPath;

    property CenterOnScreen: Boolean read FCenterOnScreen write SetCenterOnScreen;

    property OnSelChanged: TOnODSelChange read FOnSelChanged write SetOnSelChanged;

    property Localizy;

  end;





  //----------------------------------------------------------------------------

  //---- MIRROR FOR COLOR CHOOSING DIALOG ----

  //---- ÇÅÐÊÀËÎ ÄËß ÄÈÀËÎÃÀ ÂÛÁÎÐÀ ÖÂÅÒÀ ----

  TKOLColorDialog = class( TKOLObj )

  private

    FColorCustomOption: TColorCustomOption;

    FCustomColors: array[ 1..16 ] of TColor;

    procedure SetColorCustomOption(const Value: TColorCustomOption);

    function GetCustomColor( const Index: Integer ): TColor;

    procedure SetCustomColor(const Index: Integer; const Value: TColor);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

  public

    constructor Create( AOwner: TComponent ); override;

  published

    property ColorCustomOption: TColorCustomOption read FColorCustomOption write SetColorCustomOption;

    property CustomColor1: TColor index 1 read GetCustomColor write SetCustomColor;

    property CustomColor2: TColor index 2 read GetCustomColor write SetCustomColor;

    property CustomColor3: TColor index 3 read GetCustomColor write SetCustomColor;

    property CustomColor4: TColor index 4 read GetCustomColor write SetCustomColor;

    property CustomColor5: TColor index 5 read GetCustomColor write SetCustomColor;

    property CustomColor6: TColor index 6 read GetCustomColor write SetCustomColor;

    property CustomColor7: TColor index 7 read GetCustomColor write SetCustomColor;

    property CustomColor8: TColor index 8 read GetCustomColor write SetCustomColor;

    property CustomColor9: TColor index 9 read GetCustomColor write SetCustomColor;

    property CustomColor10: TColor index 10 read GetCustomColor write SetCustomColor;

    property CustomColor11: TColor index 11 read GetCustomColor write SetCustomColor;

    property CustomColor12: TColor index 12 read GetCustomColor write SetCustomColor;

    property CustomColor13: TColor index 13 read GetCustomColor write SetCustomColor;

    property CustomColor14: TColor index 14 read GetCustomColor write SetCustomColor;

    property CustomColor15: TColor index 15 read GetCustomColor write SetCustomColor;

    property CustomColor16: TColor index 16 read GetCustomColor write SetCustomColor;

  end;



  //----------------------------------------------------------------------------

  //---- MIRROR FOR TRAY ICON ----

  //---- ÇÅÐÊÀËÎ ÄËß ÈÊÎÍÊÈ Â ÒÐÅÅ ----

  TKOLTrayIcon = class( TKOLObj )

  private

    FIcon: TIcon;

    FActive: Boolean;

    FTooltip: String;

    FAutoRecreate: Boolean;

    FOnMouse: TOnTrayIconMouse;

    FNoAutoDeactivate: Boolean;

    procedure SetIcon(const Value: TIcon);

    procedure SetActive(const Value: Boolean);

    procedure SetTooltip(const Value: String);

    procedure SetAutoRecreate(const Value: Boolean);

    procedure SetOnMouse(const Value: TOnTrayIconMouse);

    procedure SetNoAutoDeactivate(const Value: Boolean);

  protected

    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;

    procedure AssignEvents( SL: TStringList; const AName: String ); override;

  public

    constructor Create( AOwner: TComponent ); override;

    destructor Destroy; override;

  published

    property Icon: TIcon read FIcon write SetIcon;

    property Active: Boolean read FActive write SetActive;

    property NoAutoDeactivate: Boolean read FNoAutoDeactivate write SetNoAutoDeactivate;

    property Tooltip: String read FTooltip write SetTooltip;

    property AutoRecreate: Boolean read FAutoRecreate write SetAutoRecreate;

    property OnMouse: TOnTrayIconMouse read FOnMouse write SetOnMouse;

    property Localizy;

  end;





type KOLTPixelFormat = KOL.TPixelFormat;







function CountSystemColorsUsedInBitmap( Bmp: KOL.PBitmap ): KOLTPixelFormat;

//function SaveBitmap( Bitmap: TBitmap; const Path: String ): Boolean;

procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName: String;

          var Updated: Boolean );

procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: String;

          var Updated: Boolean );

procedure RemoveSelection( FD: IFormDesigner );

function String2Pascal( S: String ): String;

//function GetBmpPixel( Bitmap: TBitmap; X, Y: Integer ): TColor;



procedure Register;



implementation



procedure Register;

begin

  RegisterComponents( 'KOL', [ TKOLTimer, TKOLThread, TKOLImageList, TKOLMainMenu, TKOLPopupMenu,

                      TKOLOpenSaveDialog, TKOLOpenDirDialog, TKOLColorDialog,

                      TKOLTrayIcon ] );

  RegisterComponentEditor( TKOLImageList, TKOLImageListEditor );

  RegisterPropertyEditor( TypeInfo( String ), TKOLOpenSaveDialog, 'Filter',

                          TKOLFileFilter );

  RegisterPropertyEditor( TypeInfo( TOnODSelChange ), TKOLOpenDirDialog, 'OnSelChanged', TKOLOnEventPropEditor );

  RegisterPropertyEditor( TypeInfo( TOnTrayIconMouse ), nil, '', TKOLOnEventPropEditor );

end;



function String2Pascal( S: String ): String;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'String2Pascal', 0

  @@e_signature:

  end;

  if Length( S ) > 0 then

  begin

    Result := '';

    while S <> '' do

    begin

      if Result <> '' then

        Result := Result + ' + ';

      Result := Result + String2PascalStrExpr( Copy( S, 1, 255 ) );

      S := Copy( S, 256, MaxInt );

    end;

  end

    else

    Result := '''''';

end;



procedure RemoveSelection( FD: IFormDesigner );

{$IFDEF _D2orD3}

var L: TComponentList;

{$ENDIF}

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'RemoveSelection', 0

  @@e_signature:

  end;

  try

    {$IFDEF _D5orHigher}

    FD.NoSelection;

    {$ELSE}

      {$IFDEF _D2orD3}

        L := TComponentList.Create;

        FD.SetSelections( L );

        L.Free;

      {$ELSE _D4}

        FD.SetSelections( nil );

      {$ENDIF}

    {$ENDIF}

  except

    Rpt( '*/\* EXCEPTION - Could not remove current selection' );

  end;

end;



function ColorsAreSystem16( ColorList: PList ): Boolean;

const SysColors: array[ 0..15 ] of TColor = ( 0, $800000, $8000, $808000, $80,

      $800080, $8080, $808080, $C0C0C0, $FF0000, $FF00, $FFFF00, $FF, $FF00FF,

      $FFFF, $FFFFFF );

var I, J: Integer;

    C: TColor;

    Found: Boolean;

begin

  Result := TRUE;

  for I := 0 to ColorList.Count-1 do

  begin

    C := TColor( ColorList.Items[ I ] );

    Found := FALSE;

    for J := 0 to 15 do

      if SysColors[ J ] = C then

      begin

        Found := TRUE;

        break;

      end;

    if not Found then

    begin

      Rpt( '***** Color ' + Int2Hex( C, 8 ) + ' not found in system 16 colors' );

      Result := FALSE;

      Exit;

    end;

  end;

end;



function ColorsAreSystem256( ColorList: PList ): Boolean;

const SysColors8bit: array[ 0..255 ] of DWORD = ( $000000,

$C0DCC0, $800000, $808000, $008000, $008080, $000080, $800080, $808080,

$00FF00, $0000FF, $00FFFF, $C0DCC0, $000040, $400040, $000000, $A0A0A4,

$C0C0C0, $C0DCC0, $FFFBF0, $FFFBF0, $FFFBF0, $FFFBF0, $FFFFFF, $FF0000,

$FFFF00, $FF00FF, $FFFFFF, $A6CAF0, $402000, $004040, $202040, $202040,

$606040, $404040, $E08080, $E00080, $C0DCC0, $A0A0A4, $800000, $C02000,

$404000, $A04000, $E04000, $406000, $A06000, $E06000, $40A000, $202040,

$404040, $404040, $E06040, $A6CAF0, $C0DCC0, $40E000, $800000, $004000,

$604000, $C04000, $006000, $606000, $C06000, $00A000, $60A000, $A0A000,

$E0A000, $40C000, $A0C000, $E0C000, $A0E000, $00E040, $600040, $C00040,

$0000FF, $604040, $C04040, $006040, $606040, $C06040, $00A040, $C0A000,

$00C000, $60C000, $C0C000, $60E000, $C0E000, $0000FF, $A00040, $E00040,

$404040, $A04040, $E04040, $406040, $A06040, $E06040, $40A040, $60A040,

$C0A040, $00C040, $60C040, $C0C040, $40E040, $A0E040, $E0E040, $400080,

$A00080, $E00080, $404080, $A04080, $E04080, $406080, $A06080, $A0A040,

$E0A040, $40C040, $A0C040, $E0C040, $60E040, $C0E040, $000080, $600080,

$C00080, $004080, $604080, $C04080, $006080, $606080, $C06080, $00A080,

$A0C080, $E0C080, $40E080, $C0E080, $FF00FF, $A04080, $C00080, $404080,

$C04080, $006080, $604080, $C06080, $40A080, $A0A0A4, $E0A080, $40C080,

$C0C080, $00E080, $A0E080, $E000C0, $00A080, $A00080, $000080, $600080,

$E00080, $406080, $A06080, $E04080, $60A080, $C0A080, $00C080, $40C080,

$A0C080, $E0C080, $40E080, $A0E080, $E0E080, $400080, $A000C0, $004080,

$6040C0, $C040C0, $0060C0, $606080, $C060C0, $00A0C0, $60A0C0, $60C080,

$C0C080, $00E080, $60C080, $C0E080, $0000C0, $6000C0, $C000C0, $4040C0,

$A040C0, $E040C0, $4060C0, $A060C0, $E06080, $40A0C0, $A0A0C0, $C0A0C0,

$00A0C0, $60A0C0, $C0A0C0, $00C0C0, $60C0C0, $C0C0C0, $00FFFF, $60E080,

$C0DCC0, $4000C0, $A000C0, $4040C0, $A040C0, $FF00FF, $4060C0, $E0A0C0,

$40A0C0, $A0A0C0, $E0A0C0, $40C0C0, $A0C0C0, $E0A0C0, $40C0C0, $C0DCC0,

$FFFBF0, $6000C0, $0040C0, $6040C0, $C040C0, $0060C0, $6060C0, $A060C0,

$E060C0, $40A0C0, $A6CAF0, $E0A0C0, $40C0C0, $A6CAF0, $FFFBF0, $60C0C0,

$FFFFFF, $60E080, $6060C0, $A6CAF0, $606040, $808080, $C0C0C0, $C060C0,

$00A0C0, $60A0C0, $A6CAF0, $00FFFF, $60C0C0, $A6CAF0, $00FFFF, $A6CAF0,

$E06080, $E0E080, $E060C0, $A00040, $808080, $A0A0A4, $C0C0C0 );

var I, J: Integer;

    C: DWORD;

begin

  Result := FALSE;

  for I := 0 to ColorList.Count-1 do

  begin

    C := DWORD( ColorList.Items[ I ] );

    for J := 0 to 255 do

    begin

      if SysColors8bit[ J ] = C then

      begin

        C := 0;

        break;

      end;

    end;

    if C <> 0 then

    begin

      Rpt( '~~~ color not found: ' + Int2Hex( C, 6 ) );

      Exit;

    end;

  end;

  Result := TRUE;

end;



function ColorsAre64K( ColorList: PList ): Boolean;

var I: Integer;

    C: DWORD;

begin

  Result := FALSE;

  for I := 0 to ColorList.Count-1 do

  begin

    C := DWORD( ColorList.Items[ I ] );

    if (C and $E0C0E0) <> C then

    begin

      Rpt( '~~~ color not found: ' + Int2Hex( C, 6 ) );

      Exit;

    end;

  end;

  Result := TRUE;

end;



function CountSystemColorsUsedInBitmap( Bmp: KOL.PBitmap ): KOL.TPixelFormat;

var Y, X: Integer;

    L: PDWORD;

    ColorList: KOL.PList;

    C: TColor;

    R, G, B: Byte;

begin

  ColorList := NewList;

  ColorList.Capacity := 65537;

  TRY

    for Y := 0 to Bmp.Height - 1 do

    begin

      L := Bmp.ScanLine[ Y ];

      for X := 0 to Bmp.Width - 1 do

      begin

        C := L^ and $FFFFFF;

        if (C and $E0C0E0) <> C then

        begin

          R := C and $FF;

          G := (C and $FF00) shr 8;

          B := C shr 16;

          if ((R and $E0) <> R) and (R <> $FF) or

             ((G and $C0) <> G) and (G <> $FF) or

             ((B and $E0) <> B) and (B <> $FF) then

          begin

            Result := KOL.pf24bit;

            Rpt( '~~~ color not found: ' + Int2Hex( C, 6 ) );

            Exit;

          end;

        end;

        if ColorList.IndexOf( Pointer( C ) ) < 0 then

        begin

          ColorList.Add( Pointer( C ) );

          if ColorList.Count > 65536 then

          begin

            Result := KOL.pf24bit;

            Rpt( '~~~~~ pf24bit (break) ~~~~~ (' + Int2Str( ColorList.Count ) + ')' );

            Exit;

          end;

        end;

        Inc( L );

      end;

    end;

    //Rpt( '------ Colors in bitmap: ' + Int2Str( ColorList.Count ) );

    if (ColorList.Count <= 2) and

       ((ColorList.Count = 0) or

        (ColorList.Count > 0) and (DWORD(ColorList.Items[ 0 ]) and $FFFFFF = $FFFFFF) and

        ((ColorList.Count < 2) or

         (ColorList.Count = 2) and (DWORD( ColorList.Items[ 1 ] ) and $FFFFFF = 0) )) then

    begin

      Result := KOL.pf1bit;

      Rpt( '~~~~~ pf1bit ~~~~~' );

    end else if (ColorList.Count <= 16) and ColorsAreSystem16( ColorList ) then

    begin

      Result := KOL.pf4bit;

      Rpt( '~~~~~ pf4bit ~~~~~' );

    end else if (ColorList.Count <= 256) and ColorsAreSystem256( ColorList ) then

    begin

      Result := KOL.pf8bit;

      Rpt( '~~~~~ pf8bit ~~~~~' );

    end else if (ColorList.Count <= 65536) and ColorsAre64K( ColorList ) then

    begin

      Result := KOL.pf16bit;

      Rpt( '~~~~~ pf16bit ~~~~~' );

    end

    else

    begin

      Result := KOL.pf24bit;

      Rpt( '~~~~~ pf24bit ~~~~~ (' + Int2Str( ColorList.Count ) + ')' );

    end;

  FINALLY

    ColorList.Free;

  END;

end;



{$IFDEF _D2}

procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName: String;

          var Updated: Boolean );

var RL: TStringList;

    Buf1, Buf2: PChar;

    I, J: Integer;

    F: THandle;

    S: String;

    KOLBmp: KOL.PBitmap;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'GenerateBitmapResource', 0

  @@e_signature:

  end;

  KOLBmp := NewDIBBitmap( Bitmap.Width, Bitmap.Height, KOL.pf32bit );

  BitBlt( KOLBmp.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,

          Bitmap.Canvas.Handle, 0, 0, SRCCOPY );

  KOLBmp.HandleType := KOL.bmDIB;

  KOLBmp.PixelFormat := KOL.pf32bit;

  KOLBmp.PixelFormat := CountSystemColorsUsedInBitmap( KOLBmp );

  KOLBmp.SaveToFile( ProjectSourcePath + FileName + '.bmp' );



  Buf1 := nil;

  Buf2 := nil;

  I := 0;

  J := 0;

  S := ProjectSourcePath + FileName + '.res';

  if FileExists( S ) then

  begin

    I := FileSize( S );

    if I > 0 then

    begin

      GetMem( Buf1, I );

      F := KOL.FileCreate( S, ofOpenRead or ofShareDenyWrite or ofOpenExisting );

      if F <> THandle( -1 ) then

      begin

        KOL.FileRead( F, Buf1^, I );

        KOL.FileClose( F );

      end;

    end;

  end;

  RL := TStringList.Create;

  RL.Add( UpperCase( RsrcName ) + ' BITMAP "' + FileName + '.bmp"' );

  RL.SaveToFile( ProjectSourcePath + FileName + '.rc' );

  RL.Free;

  if not FileExists( ProjectSourcePath + FileName + '.rc' ) then

  begin

    ShowMessage( 'Can not save file: ' + ProjectSourcePath + FileName + '.rc' );

    Exit;

  end;

  {ShellExecute( 0, 'open', PChar( ExtractFilePath( Application.ExeName ) + 'brcc32.exe' ),

                PChar( ProjectSourcePath + FileName + '.rc' ), PChar( ProjectSourcePath ),

                SW_HIDE );}

  Rpt( 'Compiling resource ' + ProjectSourcePath + FileName + '.rc' );

  if not ExecuteWait( ExtractFilePath( Application.ExeName ) + 'brcc32.exe',

               '"' + ProjectSourcePath + FileName + '.rc"',

               ProjectSourcePath, SW_HIDE, INFINITE, nil ) then

  begin

    Rpt( 'Can not compile resource with ' + ExtractFilePath( Application.ExeName ) + 'brcc32.exe' );

  end;

  if FileExists( S ) then

  begin

    J := FileSize( S );

    if J > 0 then

    begin

      GetMem( Buf2, J );

      F := KOL.FileCreate( S, ofOpenRead or ofShareDenyWrite or ofOpenExisting );

      if F <> THandle( -1 ) then

      begin

        KOL.FileRead( F, Buf2^, J );

        KOL.FileClose( F );

      end;

    end;

  end;

  if (Buf1 = nil) or (I <> J) or

     (Buf2 <> nil) and not CompareMem( Buf1, Buf2, J ) then

  begin

    Rpt( 'Resource ' + FileName + ' changed.' );

    Updated := TRUE;

  end;

  if Buf1 <> nil then FreeMem( Buf1 );

  if Buf2 <> nil then FreeMem( Buf2 );

end;



{$ELSE not _D2}



// This version of GenerateBitmapResource provided by Alex Pravdin.

// It does not use brcc32.exe, and creates res-file directly, so

// it is fast and has no restrictions on bitmap format at all.



procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName:

          String; var Updated: Boolean );

var

    HD1: packed record // First part of RESOURCEHEADER structure before

                       // Unicode string contained bitmap resource name

        DataSize: cardinal;

        HeaderSize: cardinal;

        NFFFF: word;

        DataType: word;

    end;



    HD2: packed record // Second part of RESOURCEHEADER

        DataVersion: cardinal;

        MemFlags: word;

        PrimaryLang: byte;

        SubLang: byte;

        Version: cardinal;

        Charact: cardinal;

    end;



    br, hFR, hFtm, DIBLen, WLen, RLen, tm: DWORD;

    Buf1, Buf2: PByteArray;

    FE: boolean;

    Res, Bmp: string;

    tmStr: WideString;



    KOLBmp: KOL.PBitmap;

    KOLPF: KOL.TPixelFormat;



begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'GenerateBitmapResource', 0

  @@e_signature:

  end;

  Res := ProjectSourcePath + FileName + '.res';

  Bmp := ProjectSourcePath + FileName + '.bmp';

  FE := FileExists( Res );



  //Bitmap.SaveToFile( Bmp );

  KOLBmp := KOL.NewDIBBitmap( Bitmap.Width, Bitmap.Height, KOL.pf32bit );

  BitBlt( KOLBmp.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,

          Bitmap.Canvas.Handle, 0, 0, SRCCOPY );

  KOLBmp.HandleType := KOL.bmDIB;

  KOLBmp.PixelFormat := KOL.pf32bit;

  KOLPF := CountSystemColorsUsedInBitmap( KOLBmp );

  KOLBmp.PixelFormat := KOLPF;

  KOLBmp.SaveToFile( Bmp );

  KOLBmp.Free;



  if FE then

  begin

    DeleteFile( PChar( Res + '_tmp' ) );

    CopyFile( PChar(Res), PChar( (Res+'_tmp') ), False );

  end;



  hFR := CreateFile( PChar(Res), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ,

      nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0 );



  if hFR = INVALID_HANDLE_VALUE then begin

      Rpt( 'Can not create file ' + Res + #13#10'Error: ' + SysErrorMessage( GetLastError ) );

      Exit;

  end;



  hFtm := CreateFile( PChar(Bmp), GENERIC_READ, FILE_SHARE_READ, nil,

      OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );



  DIBLen := GetFileSize( hFtm, nil ) - 14{SizeOf( TBITMAPFILEHEADER )};

  WLen := ( Length( RsrcName ) + 1 ) * 2;



  HD1.DataSize := DIBLen;

  HD1.HeaderSize := 12{SizeOf( HD1 )} + 16{SizeOf( HD2 )} + WLen;

  HD1.NFFFF := $FFFF;

  HD1.DataType := 2; // RT_BITMAP

  HD2.DataVersion := 0;

  HD2.MemFlags := 0;

  HD2.PrimaryLang := LANG_NEUTRAL;

  HD2.SubLang := SUBLANG_DEFAULT;

  HD2.Version := 0;

  HD2.Charact := 0;



  RLen := HD1.HeaderSize + DIBLen + 32;

  GetMem( Buf1, RLen );

  FillChar( Buf1[0], RLen, 0 );



  Buf1[4]:=$20; Buf1[8]:=$FF; Buf1[9]:=$FF; Buf1[12]:=$FF; Buf1[13]:=$FF;



  tmStr := UpperCase( RsrcName ) + #0;

  CopyMemory( @Buf1[32], @HD1, 12 );

  CopyMemory( @Buf1[32+12], @tmStr[1], WLen );

  CopyMemory( @Buf1[32+12+WLen], @HD2, 16 );



  SetFilePointer( hFtm, 14{SizeOf( TBITMAPFILEHEADER )}, nil, FILE_BEGIN);

  ReadFile( hFtm, Buf1[32+12+16+WLen], DIBLen, br, nil );



  WriteFile( hFR, Buf1[0], RLen, br, nil );

  CloseHandle( hFtm );

  CloseHandle( hFR );

  DeleteFile( Bmp );



  if FE then begin

      hFtm := CreateFile( PChar( (Res+'_tmp') ), GENERIC_READ,

FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );

      tm := GetFileSize( hFtm, nil );

      GetMem( Buf2, tm );

      ReadFile( hFtm, Buf2[0], tm, br, nil );

      CloseHandle( hFtm );

      DeleteFile( Res + '_tmp' );

      if ( RLen <> tm ) or (not CompareMem( @Buf1[0], @Buf2[0], Min( RLen,

tm ) )) then begin

          Rpt( 'Resource ' + Res + ' changed.' );

          Updated := True;

      end;

      FreeMem( Buf2 );

  end;

  FreeMem( Buf1 );



end;

{$ENDIF}



function SaveIcon( Icon: TIcon; const Path: String ): Boolean;

var MS, MS2: TMemoryStream;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'SaveIcon', 0

  @@e_signature:

  end;

  Result := TRUE;

  MS := TMemoryStream.Create;

  MS2 := TMemoryStream.Create;

  try

    Icon.SaveToStream( MS );

    if FileExists( Path ) then

    begin

      MS2.LoadFromFile( Path );

      if (MS.Size = MS2.Size) and CompareMem( MS.Memory, MS2.Memory, MS.Size ) then

        Exit;

      if FileExists( Path + '.$$$' ) then

        DeleteFile( Path + '.$$$' );

      MoveFile( PChar( Path ), PChar( Path + '.$$$' ) );

    end;

    MS.Position := 0;

    MS.SaveToFile( Path );

    //Result := True;

    //Rpt( 'Icon stored to ' + Path );

  finally

    MS.Free;

    MS2.Free;

  end;

end;



procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: String;

          var Updated: Boolean );

var RL: TStringList;

    Buf1, Buf2: PChar;

    S: String;

    I, J: Integer;

    F: THandle;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'GenerateIconResource', 0

  @@e_signature:

  end;

  {if not SaveIcon( Icon, ProjectSourcePath + FileName + '.ico' )

     and FileExists( ProjectSourcePath + FileName + '.res' ) then Exit;}

  if not SaveIcon( Icon, ProjectSourcePath + FileName + '.ico' ) then

     Exit;

  RL := TStringList.Create;

  RL.Add( UpperCase( RsrcName ) + ' ICON "' + FileName + '.ico"' );

  RL.SaveToFile( ProjectSourcePath + FileName + '.rc' );

  RL.Free;

  Buf1 := nil;

  Buf2 := nil;

  I := 0; J := 0;

  S := ProjectSourcePath + FileName + '.res';

  if FileExists( S ) then

  begin

    I := FileSize( S );

    if I > 0 then

    begin

      GetMem( Buf1, I );

      F := KOL.FileCreate( S, ofOpenRead or ofShareDenyWrite or ofOpenExisting );

      if F <> THandle( -1 ) then

      begin

        KOL.FileRead( F, Buf1^, I );

        KOL.FileClose( F );

      end;

    end;

  end;

  {ShellExecute( 0, 'open', PChar( ExtractFilePath( Application.ExeName ) + 'brcc32.exe' ),

                PChar( ProjectSourcePath + FileName + '.rc' ), PChar( ProjectSourcePath ),

                SW_HIDE );}

  ExecuteWait( ExtractFilePath( Application.ExeName ) + 'brcc32.exe',

               '"' + ProjectSourcePath + FileName + '.rc"',

               ProjectSourcePath, SW_HIDE, INFINITE, nil );

  if FileExists( S ) then

  begin

    J := FileSize( S );

    if J > 0 then

    begin

      GetMem( Buf2, J );

      F := KOL.FileCreate( S, ofOpenRead or ofShareDenyWrite or ofOpenExisting );

      if F <> THandle( -1 ) then

      begin

        KOL.FileRead( F, Buf2^, J );

        KOL.FileClose( F );

      end;

    end;

  end;

  if (Buf1 = nil) or (I <> J) or

     (Buf2 <> nil) and not CompareMem( Buf1, Buf2, J ) then

  begin

    Updated := TRUE;

  end;

  if Buf1 <> nil then FreeMem( Buf1 );

  if Buf2 <> nil then FreeMem( Buf2 );

end;



{ TKOLTimer }



procedure TKOLTimer.AssignEvents(SL: TStringList; const AName: String);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.AssignEvents', 0

  @@e_signature:

  end;

  inherited;

  DoAssignEvents( SL, AName, [ 'OnTimer' ], [ @OnTimer ] );

end;



constructor TKOLTimer.Create(AOwner: TComponent);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.Create', 0

  @@e_signature:

  end;

  inherited;

  fInterval := 1000;

  fEnabled := True;

  FPeriodic := TRUE;

  FResolution := 0;

end;



procedure TKOLTimer.SetEnabled(const Value: Boolean);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.SetEnabled', 0

  @@e_signature:

  end;

  FEnabled := Value;

  Change;

end;



procedure TKOLTimer.SetInterval(const Value: Integer);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.SetInterval', 0

  @@e_signature:

  end;

  FInterval := Value;

  Change;

end;



procedure TKOLTimer.SetMultimedia(const Value: Boolean);

begin

  FMultimedia := Value;

  Change;

end;



procedure TKOLTimer.SetOnTimer(const Value: TOnEvent);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.SetOnTimer', 0

  @@e_signature:

  end;

  FOnTimer := Value;

  Change;

end;



procedure TKOLTimer.SetPeriodic(const Value: Boolean);

begin

  FPeriodic := Value;

  Change;

end;



procedure TKOLTimer.SetResolution(const Value: Integer);

begin

  FResolution := Value;

  Change;

end;



procedure TKOLTimer.SetupFirst(SL: TStringList; const AName,

  AParent, Prefix: String);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.SetupFirst', 0

  @@e_signature:

  end;

  if Multimedia then

  begin

    SL.Add( Prefix + AName + ' := NewMMTimer( ' + IntToStr( Interval ) + ' );' );

    if not Periodic then

      SL.Add( Prefix + 'PMMTimer(' + AName + ').Periodic := FALSE;' );

    if Resolution > 0 then

      SL.Add( Prefix + 'PMMTimer(' + AName + ').Resolution := ' + IntToStr( Resolution ) + ';' );

  end

  else

    SL.Add( Prefix + AName + ' := NewTimer( ' + IntToStr( Interval ) + ' );' );

  //AssignEvents( SL, AName );

  GenerateTag( SL, AName, Prefix );

end;



procedure TKOLTimer.SetupLast(SL: TStringList; const AName,

  AParent, Prefix: String);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLTimer.SetupLast', 0

  @@e_signature:

  end;

  if Enabled then

    SL.Add( Prefix + AName + '.Enabled := True;' );

end;



function TKOLTimer.TypeName: String;

begin

  if Multimedia then Result := 'TMMTimer'

  else Result := inherited TypeName;

end;



{ TKOLImageList }



procedure TKOLImageList.Assign(Value: TPersistent);

var IL: TKOLImageList;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.Assign', 0

  @@e_signature:

  end;

  if (Value <> nil) and (Value is TKOLImageList) then

  begin

    IL := Value as TKOLImageList;

    FImgWidth := IL.ImgWidth;

    FImgHeight := IL.ImgHeight;

    FCount := IL.Count;

    FBitmap.Assign( IL.Bitmap );

    FSystemImageList := IL.SystemImageList;

    FTransparentColor := IL.TransparentColor;

  end

    else

    inherited;

  Change;

end;



procedure TKOLImageList.AssignBitmapToKOLImgList;

var R: Integer;

    TmpBmp: TBitmap;

begin

  if FKOLImgList = nil then Exit;

  if Bitmap <> nil then

  begin

    //Bitmap.SaveToFile( 'c:\test1.bmp' );

    //ShowMessage( 'Bitmap.Handle=' + Int2Str( Bitmap.Handle ) );

    FKOLImgList.Clear;

    FKOLImgList.Colors := Colors;

    //FKOLImgList.BkColor := Color2RGB( BkColor );

    FKOLImgList.ImgWidth := ImgWidth;

    FKOLImgList.ImgHeight := ImgHeight;

    {$IFDEF _D3orHigher}

    {Bitmap.HandleType := bmDIB;

    Bitmap.PixelFormat := pf24bit;}

    {$ENDIF}

    //ShowMessage( Int2Hex( Color2RGB( BkColor ), 8 ) );

    if not Bitmap.Empty then

    begin

      //Bitmap.SaveToFile( 'c:\test2.bmp' );

      TmpBmp := TBitmap.Create;

      TRY

        TmpBmp.Assign( Bitmap );

        if Masked then

          R := FKOLImgList.AddMasked( TmpBmp.Handle, Color2RGB( TransparentColor ) )

        else

        begin

          FKOLImgList.Masked := FALSE;

          R := FKOLImgList.Add( TmpBmp.Handle, 0 );

        end;

        if R < 0 then

          ShowMessage( 'Error adding bitmap: ' + SysErrorMessage( GetLastError ) )

        else

        begin

          DoNotifyLinkedComponents( noChanged );

        end;

      FINALLY

        TmpBmp.Free;

      END;

      //Bitmap.SaveToFile( 'c:\test3.bmp' );

      //ShowMessage( 'Result := ' + Int2Str( R ) );

      //ShowMessage( 'FKOLImgList.Handle=' + Int2Str( FKOLImgList.Handle ) );

    end;

  end;

end;



{procedure TKOLImageList.BitmapChanged(Sender: TObject);

begin

  AssignBitmapToKOLImgList;

end;}



procedure TKOLImageList.Clear;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.Clear', 0

  @@e_signature:

  end;

  if FBitmap <> nil then

  begin

    FBitmap.Width := 0;

    FBitmap.Height := 0;

  end;

  FCount := 0;

end;



constructor TKOLImageList.Create( AOwner: TComponent );

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.Create', 0

  @@e_signature:

  end;

  inherited Create( AOwner );

  FBkColor := clNone;

  FBitmap := TBitmap.Create;

  //FBitmap.OnChange := BitmapChanged;

  FImgWidth := 32;

  FImgHeight := 32;

  FTransparentColor := clDefault;

  FMasked := TRUE;

  NeedFree := False; // ImageList in KOL destroyes self when its parent

                     // control is destroyed - automatically.

  fCreationPriority := 10;

end;



destructor TKOLImageList.Destroy;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.Destroy', 0

  @@e_signature:

  end;

  FKOLImgList.Free;

  FBitmap.Free;

  inherited;

end;



function TKOLImageList.GetBitmap: TBitmap;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.GetBitmap', 0

  @@e_signature:

  end;

  if SystemImageList then

    Result := nil

  else

    Result := FBitmap;

end;



function TKOLImageList.GetImageListHandle: THandle;

begin

  if FKOLImgList = nil then

  begin

    FKOLImgList := NewImageList( nil );

    AssignBitmapToKOLImgList;

  end;

  Result := FKOLImgList.Handle;

end;



function TKOLImageList.GetTransparentColor: TColor;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.GetTransparentColor', 0

  @@e_signature:

  end;

  Result := FTransparentColor;

  if Result = clDefault then

  if FBitmap <> nil then

  if (FBitmap.Width <> 0) and (FBitmap.Height <> 0) then

    Result := FBitmap.Canvas.Pixels[ 0, FBitmap.Height - 1 ];

end;



procedure TKOLImageList.SetBitmap(const Value: TBitmap);

{$IFDEF _D2}

var KOLBmp: KOL.PBitmap;

{$ENDIF}

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetBitmap', 0

  @@e_signature:

  end;

  if FBitmap = Value then Exit;

  FBitmap.Assign( Value );

  if (FBitmap.Height <> 0) and (FBitmap.Width <> 0) then

  begin

    FImgHeight := FBitmap.Height;

    {AK->}if FImgWidth<=0 then{<-AK} FImgWidth := FImgHeight;

    FCount := FBitmap.Width div FImgWidth;

  end;

  {$IFDEF _D2}

  KOLBmp := NewBitmap( Value.Width, Value.Height );

  TRY

    KOLBmp.HandleType := KOL.bmDIB;

    KOLBmp.PixelFormat := KOL.pf32bit;

    BitBlt( KOLBmp.Canvas.Handle, 0, 0, Value.Width, Value.Height,

            Value.Canvas.Handle, 0, 0, SrcCopy );

    case CountSystemColorsUsedInBitmap( KOLBmp ) of

    KOL.pf1bit, KOL.pf4bit: Colors := ilcColor4;

    KOL.pf8bit: Colors := ilcColor8;

    KOL.pf32bit: Colors := ilcColor32;

    else         Colors := ilcColor24;

    end;

  FINALLY

    KOLBmp.Free;

  END;

  {$ELSE}

  if FBitmap.HandleType = bmDDB then

    Colors := ilcColorDDB

  else

  begin

    case FBitmap.PixelFormat of

    pf1bit,

    pf4bit: Colors := ilcColor4;

    pf8bit: Colors := ilcColor8;

    pf32bit: Colors := ilcColor32;

    //pf24bit:

    else Colors := ilcColor24;

    end;

  end;

  {$ENDIF}

  if (FBitmap.Height <> 0) and (FBitmap.Width <> 0) then

  begin

    TransparentColor := FBitmap.Canvas.Pixels[ 0, FBitmap.Height - 1 ];

  end;

  if FKOLImgList <> nil then

    AssignBitmapToKOLImgList;

  Change;

end;



procedure TKOLImageList.SetBkColor(const Value: TColor);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetBkColor', 0

  @@e_signature:

  end;

  FBkColor := Value;

  AssignBitmapToKOLImgList;

  Change;

end;



procedure TKOLImageList.SetColors(const Value: TImageListColors);

//{$IFDEF _D2}

var KOLBmp: KOL.PBitmap;

//{$ENDIF}

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetColors', 0

  @@e_signature:

  end;

  if FColors = Value then Exit;

  FColors := Value;

  if FBitmap = nil then Exit;

  if FBitmap.Width * FBitmap.Height = 0 then Exit;

  //{$IFDEF _D2}

  KOLBmp := NewBitmap( FBitmap.Width, FBitmap.Height );

  TRY

    KOLBmp.HandleType := KOL.bmDIB;

    KOLBmp.PixelFormat := KOL.pf32bit;

    BitBlt( KOLBmp.Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height,

            FBitmap.Canvas.Handle, 0, 0, SrcCopy );

    case Value of

    ilcColor4: KOLBmp.PixelFormat := KOL.pf4bit;

    ilcColor8: KOLBmp.PixelFormat := KOL.pf8bit;

    ilcColor24: KOLBmp.PixelFormat := KOL.pf24bit;

    ilcColor32: KOLBmp.PixelFormat := KOL.pf32bit;

    else        KOLBmp.HandleType := KOL.bmDDB;

    end;

    FBitmap.Handle := KOLBmp.ReleaseHandle;

  FINALLY

    KOLBmp.Free;

  END;

  (*{$ELSE}

  if Assigned( FBitmap ) then

  begin

    if FColors = ilcColorDDB then

      FBitmap.HandleType := bmDDB

    else

    begin

      FBitmap.HandleType := bmDIB;

      case Value of

      ilcColor4: FBitmap.PixelFormat := pf4bit;

      ilcColor8: FBitmap.PixelFormat := pf8bit;

      ilcColor24: FBitmap.PixelFormat := pf24bit;

      ilcColor32: FBitmap.PixelFormat := pf32bit;

      end;

    end;

  end;

  {$ENDIF}*)

  Change;

end;



procedure TKOLImageList.SetCount(const Value: Integer);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetCount', 0

  @@e_signature:

  end;

  FCount := Value;

  if Value > 0 then

  begin

    {AK->} if FImgWidth <= 0 then {<-AK} // change by Andrzej Kubaszek 28-Jan-2002

      FImgWidth := FImgHeight;

    if FBitmap <> nil then

    if FBitmap.Width > 0 then

      FImgWidth := FBitmap.Width div FCount;

  end;

  Change;

end;



procedure TKOLImageList.SetImgHeight(Value: Integer);

var I: Integer;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetImgHeight', 0

  @@e_signature:

  end;

  if Value < 0 then

    Value := 0;

  if SystemImageList then

    if Value >= 32 then

      Value := 32

    else

      Value := 16

  else

  if FBitmap <> nil then

  begin

    if not FBitmap.Empty then

    if (FBitmap.Height <> 0) and (FBitmap.Width <> 0) then

    if Value <> FBitmap.Height then

      Value := FBitmap.Height;

  end;



  if FImgHeight = Value then Exit;

  if Count > 0 then

  if not( csLoading in ComponentState ) then

  begin

    I := MessageBox( 0, 'Changing image list height will lead to clearing it. Are ' +

                     'You sure You want to change height now?',

                     'TKOLImageList.ImgHeight change', MB_YESNO or

                     MB_DEFBUTTON2 or MB_SETFOREGROUND );

    if I = ID_NO then Exit;

    Clear;

  end;

  FImgHeight := Value;

  if SystemImageList then

    FImgWidth := FImgHeight;

  Change;

end;



procedure TKOLImageList.SetImgWidth(Value: Integer);

var I: Integer;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetImgWidth', 0

  @@e_signature:

  end;

  if Value < 0 then Value := 0;

  if SystemImageList then

  begin

    if Value >= 32 then

      Value := 32

    else

      Value := 16;

  end

     else

  if FBitmap <> nil then

  begin

    if not FBitmap.Empty then

    if (FBitmap.Width <> 0) and (FBitmap.Height <> 0) then

    if Value > FBitmap.Width then

      Value := FBitmap.Width;

  end;



  if FImgWidth = Value then Exit;

  if Count > 0 then

  if not( csLoading in ComponentState ) then

  begin

    I := MessageBox( 0, 'Changing image list width will lead to clearing it. Are ' +

                     'You sure You want to change width now?',

                     'TKOLImageList.ImgWidth change', MB_YESNO or

                     MB_DEFBUTTON2 or MB_SETFOREGROUND );

    if I = ID_NO then Exit;

    Clear;

  end;

  FImgWidth := Value;

  if SystemImageList then

    FImgHeight := FImgWidth;

  Change;

end;



procedure TKOLImageList.SetMasked(const Value: Boolean);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetMasked', 0

  @@e_signature:

  end;

  FMasked := Value;

  Change;

end;



procedure TKOLImageList.SetSystemImageList(const Value: Boolean);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetSystemImageList', 0

  @@e_signature:

  end;

  if Value = FSystemImageList then Exit;

  FSystemImageList := Value;

  if Value then

  begin

    Clear;

    SetImgHeight( ImgHeight );

    SetImgWidth( ImgHeight );

  end

    else

    Clear;

  Change;

end;



procedure TKOLImageList.SetTransparentColor(const Value: TColor);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetTransparentColor', 0

  @@e_signature:

  end;

  FTransparentColor := Value;

  AssignBitmapToKOLImgList;

  Change;

end;



procedure TKOLImageList.SetupFirst(SL: TStringList; const AName,

  AParent, Prefix: String);

const Booleans: array[ Boolean ] of String = ( 'False', 'True' );

const ColorsValues: array[ TImageListColors ] of String = ( 'ilcColor', 'ilcColor4',

                    'ilcColor8', 'ilcColor16', 'ilcColor24', 'ilcColor32', 'ilcColorDDB',

                    'ilcDefault' );

var RsrcName, RsrcFile: String;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetupFirst', 0

  @@e_signature:

  end;

  SL.Add( Prefix + AName + ' := NewImageList( ' + AParent + ' );' );

  GenerateTag( SL, AName, Prefix );

  if SystemImageList then

    SL.Add( Prefix + AName + '.LoadSystemIcons( ' + Booleans[ ImgHeight = 16 ] + ' );' )

  else

  begin

    if Colors <> ilcDefault then

      SL.Add( Prefix + AName + '.Colors := ' + ColorsValues[ Colors ] + ';' );

    if not Masked then

    begin

      SL.Add( Prefix + AName + '.Masked := FALSE;' );

      if BkColor <> clNone then

        SL.Add( Prefix + AName + '.BkColor := ' + Color2Str( BkColor ) +

                ';' );

    end;

    if FImgWidth <> 32 then

      SL.Add( Prefix + '  ' + AName + '.ImgWidth := ' + IntToStr( FImgWidth ) + ';' );

    if FImgHeight <> 32 then

      SL.Add( Prefix + '  ' + AName + '.ImgHeight := ' + IntToStr( FImgHeight ) + ';' );

  end;

  if (FBitmap.Width <> 0) and (FBitmap.Height <> 0) then

  begin

    if (FImgHeight = 32) and (FImgWidth <> FImgHeight)  then

      SL.Add( Prefix + '  ' + AName + '.ImgWidth := ' + IntToStr( FImgWidth ) + ';' );

    RsrcName := UpperCase( ParentKOLForm.FormName + '_' + Name );

    RsrcFile := ParentKOLForm.FormName + '_' + Name;

    SL.Add( Prefix + '  {$R ' + RsrcFile + '.res}' );

    if Masked then

      SL.Add( Prefix + AName + '.AddMasked( LoadBmp( hInstance, ''' +

              RsrcName + ''', ' +

              AName + ' ), ' + Color2Str( TransparentColor ) + ' );' )

    else

      SL.Add( Prefix + AName + '.Add( LoadBmp( hInstance, ''' +

              RsrcName + ''', ' +

              AName + ' ), 0 );' );

    //Rpt( 'Generating resource: ' + ProjectSourcePath + RsrcFile + '.res' );

    GenerateBitmapResource( FBitmap, RsrcName, RsrcFile, fUpdated );

  end;

end;



procedure TKOLImageList.SetupLast(SL: TStringList; const AName, AParent,

  Prefix: String);

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageList.SetupLast', 0

  @@e_signature:

  end;

  inherited;

end;



{ TKOLImageListEditor }



procedure TKOLImageListEditor.Edit;

var IL: TImageList; //Invisible;

    {$IFDEF _D6orHigher}

    ILCE: IComponentEditor;

    {$ELSE}

    ILCE: TComponentEditor;

    {$ENDIF}

    ILH: THandle;

    KIL: TKOLImageList;

    KName: String;

    I: Integer;

    //TrColor: TColor;

begin

  asm

    jmp @@e_signature

    DB '#$signature$#', 0

    DB 'TKOLImageListEditor.Edit', 0

  @@e_signature:

  end;

  if Component = nil then Exit;

  if not ( Component is TKOLImageList ) then Exit;

  KIL := Component as TKOLImageList;

  if KIL.SystemImageList then

  begin

    ShowMessage( 'It is not possible to edit system image list!' );

    Exit;

  end;

 …