📄 simagelist.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 + -