⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 simagelist.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
字号:
unit sImageList;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList;

type
  TsImageList = class(TDragImageList)
  private
  protected
  public
    procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); override;
  published
    property Count;
    property AllocBy;
    property DrawingStyle;
    property Height;
    property Masked;
    property ShareImages;
    property Width;
    property OnChange;
  end;

implementation

uses sUtils, sBorders, sConst, Commctrl, math;

{ TsImageList }

procedure TsImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
var
  TempBmp : TBitmap;
  CurBmp : TBitmap;
  S32 : PRGBAArray;
  S24 : PRGBArray;
  SavedDC : hdc;
  dX, dY : integer;
begin
  SavedDC := SaveDC(Canvas.Handle);
  if HandleAllocated then begin
    TempBmp := TBitmap.Create;
    TempBmp.Width := Width;
    TempBmp.Height := Height;
    TempBmp.PixelFormat := pf32bit;

    CurBmp := TBitmap.Create;
    CurBmp.Width := Width;
    CurBmp.Height := Height;
    CurBmp.PixelFormat := pf24bit;

    try
    BitBlt(CurBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, Canvas.Handle, X, Y, SRCCOPY);


    ImageList_Draw(Handle, Index, TempBmp.Canvas.Handle, 0, 0, 0);

    for dY := 0 to TempBmp.Height - 1 do begin
      S32 := TempBmp.ScanLine[dY];
      S24 := CurBmp.ScanLine[dY];
      for dX := 0 to TempBmp.Width - 1 do begin
        S24[dX].R := ((S24[dX].R - S32[dX].R) * S32[dX].A + S32[dX].R * 255) div 255;
        S24[dX].G := ((S24[dX].G - S32[dX].G) * S32[dX].A + S32[dX].G * 255) div 255;
        S24[dX].B := ((S24[dX].B - S32[dX].B) * S32[dX].A + S32[dX].B * 255) div 255;
      end;
    end;

    BitBlt(Canvas.Handle, X, Y, TempBmp.Width, TempBmp.Height, CurBmp.Canvas.Handle, 0, 0, SRCCOPY);

    finally
      if Assigned(CurBmp) then FreeAndNil(CurBmp); 
      if Assigned(TempBmp) then FreeAndNil(TempBmp);
    end;
  end;
  RestoreDC(Canvas.Handle, SavedDC);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -