if (State <> bsDisabled) and (Ord(State) >= NumGlyphs) then
State := bsUp;
Result.B := True;
Result.I := FIndexs[True, State];
if Result.I = -1 then
begin
Result.B := False;
Result.I := FIndexs[False, State];
end;
if Result.I <> -1 then
Exit;
if FImageList = nil then
begin
if (FOriginal.Width = 0) or (FOriginal.Height = 0) then
Exit;
UsesMask := (FOriginalMask.Width <> 0) and (FOriginalMask.Height <> 0);
end
else
begin
if (FImageIndex < 0) or (FImageIndex >= FImageList.Count) then
Exit;
UsesMask := False;
end;
B := State <> bsDisabled;
{ + AddPixels is to make sure the highlight color on generated disabled glyphs
do
esn't get cut off }
if FImageList = nil then
begin
IWidthA := FOriginal.Width div FNumGlyphs;
IHeightA := FOriginal.Height;
end
else
begin
IWidthA := TCustomImageListAccess(FImageList).Width;
IHeightA := TCustomImageListAccess(FImageList).Height;
end;
IRectA := Rect(0, 0, IWidthA, IHeightA);
AddPixels := Ord(State = bsDisabled);
IWidth := IWidthA + AddPixels;
IHeight := IHeightA + AddPixels;
IRect := Rect(0, 0, IWidth, IHeight);
if FGlyphList = nil then
begin
if GlyphCache = nil then
GlyphCache := TGlyphCache.Create;
FGlyphList := GlyphCache.GetList(IWidth, IHeight);
end;
{$IFDEF TB97D3}
IsHighColorDIB := (FImageList = nil) and (FOriginal.PixelFormat > pf4bit);
{$ENDIF}
OriginalBmp := nil;
OriginalMaskBmp := nil;
TmpImage := nil;
MaskBmp := nil;
try
OriginalBmp := TBitmap.Create;
OriginalBmp.Assign (FOriginal);
OriginalMaskBmp := TBitmap.Create;
OriginalMaskBmp.Assign (FOriginalMask);
TmpImage := TBitmap.Create;
TmpImage.Width := IWidth;
TmpImage.Height := IHeight;
TmpImage.Canvas.Brush.Color := clBtnFace;
if FImageList = nil then
TmpImage.Palette := CopyPalette(OriginalBmp.Palette);
I := State;
if Ord(I) >= NumGlyphs then
I := bsUp;
SourceRect := Bounds(Ord(I) * IWidthA, 0, IWidthA, IHeightA);
if FImageList <> nil then
begin
MaskBmp := TBitmap.Create;
MaskBmp.Monochrome := True;
MaskBmp.Width := IWidthA;
MaskBmp.Height := IHeightA;
ImageList_Draw (FImageList.Handle, FImageIndex, MaskBmp.Canvas.Handle,
0, 0, ILD_MASK);
end;
if State <> bsDisabled then
begin
if FImageList = nil then
begin
TmpImage.Canvas.CopyRect (IRectA, OriginalBmp.Canvas, SourceRect);
if not UsesMask then
begin
{$IFDEF TB97D3}
{ Use clDefault instead of FTransparentColor whereever possible to
ensure compatibility with all video drivers when using high-color
(> 4 bpp) DIB glyphs }
FIndexs[B, State] := FGlyphList.AddMasked(TmpImage, clDefault);
{$else
}
FIndexs[B, State] := FGlyphList.AddMasked(TmpImage, FTransparentColor);
{$ENDIF}
end
else
begin
MonoBmp := TBitmap.Create;
try
MonoBmp.Monochrome := True;
MonoBmp.Width := IWidth;
MonoBmp.Height := IHeight;
MonoBmp.Canvas.CopyRect (IRectA, OriginalMaskBmp.Canvas, SourceRect);
FIndexs[B, State] := FGlyphList.Add(TmpImage, MonoBmp);
finally
MonoBmp.Free;
end;
end;
end
else
begin
ImageList_Draw (FImageList.Handle, FImageIndex, TmpImage.Canvas.Handle,
0, 0, ILD_NORMAL);
FIndexs[B, State] := FGlyphList.Add(TmpImage, MaskBmp);
end;
end
else
begin
MonoBmp := nil;
DDB := nil;
try
MonoBmp := TBitmap.Create;
{ Uses the CopyBitmapToDDB to work around a Delphi 3 flaw. If you copy
a DIB to a second bitmap via Assign, change the HandleType of the
second bitmap to bmDDB, then
try to read the Handle property, Delphi
converts it back to a DIB. }
if FImageList = nil then
DDB := CopyBitmapToDDB(OriginalBmp)
else
begin
DDB := TBitmap.Create;
DDB.Width := IWidthA;
DDB.Height := IHeightA;
ImageList_Draw (FImageList.Handle, FImageIndex, DDB.Canvas.Handle,
0, 0, ILD_NORMAL);
end;
if NumGlyphs > 1 then
with TmpImage.Canvasdo
begin
CopyRect (IRectA, DDB.Canvas, SourceRect);
{ Convert white to clBtnHighlight }
if not IsHighColorDIB then
GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
IRectA.BottomRight, [GetNearestColor(OriginalBmp.Canvas.Handle, clWhite)])
else
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
IRectA.BottomRight, [clWhite]);
ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
IRectA.BottomRight, clBtnHighlight);
{ Convert gray to clBtnShadow }
if not IsHighColorDIB then
GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
IRectA.BottomRight, [GetNearestColor(OriginalBmp.Canvas.Handle, clGray)])
else
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
IRectA.BottomRight, [clGray]);
ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
IRectA.BottomRight, clBtnShadow);
if not UsesMask then
begin
{ Generate the transparent mask in MonoBmp. The reason why
itdo
esn't just use a mask color is because the mask needs
to be of the glyph -before- the clBtnHighlight/Shadow were
translated }
if not IsHighColorDIB then
GenerateMaskBitmap (MonoBmp, DDB,
SourceRect.TopLeft, IRectA.BottomRight, FTransparentColor)
else
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
SourceRect.TopLeft, IRectA.BottomRight, [-1]);
end
else
MonoBmp.Canvas.CopyRect (IRectA, OriginalMaskBmp.Canvas, SourceRect);
with MonoBmpdo
begin
Width := Width + AddPixels;
Height := Height + AddPixels;
{ Set the additional bottom and right row on disabled glyph
masks to white so that it always shines through, since the
bottom and right row on TmpImage was left uninitialized }
Canvas.Pen.Color := clWhite;
Canvas.PolyLine ([Point(0, Height-1), Point(Width-1, Height-1),
Point(Width-1, -1)]);
end;
FIndexs[B, State] := FGlyphList.Add(TmpImage, MonoBmp);
end
else
begin
{ Create a disabled version }
if FOldDisabledStyle then
begin
{ "Old" TSpeedButton style }
if FImageList = nil then
begin
if not UsesMask then
begin
if IsHighColorDIB then
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
SourceRect.TopLeft, IRectA.BottomRight, [clBlack])
else
begin
with MonoBmpdo
begin
Assign (DDB);
{ must be a DDB for this to work right }
Canvas.Brush.Color := clBlack;
Monochrome := True;
end;
end;
end
else
begin
MonoBmp.Assign (DDB);
{ must be a DDB for this to work right }
with TBitmap.Createdo
try
Monochrome := True;
Width := OriginalMaskBmp.Width;
Height := OriginalMaskBmp.Height;
R := Rect(0, 0, Width, Height);
Canvas.CopyRect (R, OriginalMaskBmp.Canvas, R);
DC := Canvas.Handle;
with MonoBmp.Canvasdo
begin
BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
SourceRect.Left, SourceRect.Top, ROP_DSna);
BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
SourceRect.Left, SourceRect.Top, SRCPAINT);
end;
finally
Free;
end;
MonoBmp.Canvas.Brush.Color := clBlack;
MonoBmp.Monochrome := True;
end
end
else
begin
with MonoBmpdo
begin
Width := IWidthA;
Height := IHeightA;
Canvas.Brush.Color := clWhite;
Canvas.FillRect (IRectA);
ImageList_Draw (FImageList.Handle, FImageIndex, Canvas.Handle,
0, 0, ILD_TRANSPARENT);
Canvas.Brush.Color := clBlack;
Monochrome := True;
end;
end;
end
else
begin
{ The new Office 97 / MFC look }
if not UsesMask and (FImageList = nil) then
begin
with TmpImage.Canvasdo
begin
if not IsHighColorDIB then
GenerateMaskBitmap (MonoBmp, DDB, IRectA.TopLeft,
IRectA.BottomRight, [FTransparentColor, clWhite, clSilver])
else
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
SourceRect.TopLeft, IRectA.BottomRight, [-1, clWhite, clSilver]);
end;
end
else
begin
{ Generate the mask in MonoBmp. Make clWhite and clSilver transparent. }
if not IsHighColorDIB then
GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
IRectA.BottomRight, [clWhite, clSilver])
else
GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
IRectA.BottomRight, [clWhite, clSilver]);
if FImageList = nil then
UseMaskBmp := OriginalMaskBmp
else
UseMaskBmp := MaskBmp;
{ and all the white colors in UseMaskBmp }
with TBitmap.Createdo
try
Monochrome := True;
Width := UseMaskBmp.Width;
Height := UseMaskBmp.Height;
R := Rect(0, 0, Width, Height);
Canvas.CopyRect (R, UseMaskBmp.Canvas, R);
DC := Canvas.Handle;
with MonoBmp.Canvasdo
begin
BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
SourceRect.Left, SourceRect.Top, ROP_DSna);
BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
SourceRect.Left, SourceRect.Top, SRCPAINT);
end;
finally
Free;
end;
end;
end;
with TmpImage.Canvasdo
begin
Brush.Color := clBtnFace;
FillRect (IRect);
Brush.Color := clBtnHighlight;
DC := Handle;
SetTextColor (DC, clBlack);
SetBkColor (DC, clWhite);
BitBlt (DC, 1, 1, IWidthA, IHeightA,
MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
Brush.Color := clBtnShadow;
DC := Handle;
SetTextColor (DC, clBlack);
SetBkColor (DC, clWhite);
BitBlt (DC, 0, 0, IWidthA, IHeightA,
MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
end;
FIndexs[B, State] := FGlyphList.AddMasked(TmpImage, clBtnFace);
end;
finally
DDB.Free;
MonoBmp.Free;
end;
end;
finally
MaskBmp.Free;
TmpImage.Free;
OriginalMaskBmp.Free;
OriginalBmp.Free;
end;
