paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 22:00:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

State image drawing:

Browse Source 
- implement TRawImage.PerformEffect
- use TRawImage.PerformEffect for State drawing of win32 imagelist (except disabled drawing in manifested exe - in this case os method used)
- implement state drawing of default imagelist

git-svn-id: trunk@12776 -
This commit is contained in:
paul 2007-11-08 02:32:57 +00:00
parent b5643a370c
commit eb11482eee
5 changed files with 185 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
lcl/graphtype.pp
View File

@ -42,6 +42,13 @@ type
fsBorder // fill this color (it fills only conneted pixels of this color)
);
TGraphicsBevelCut = (bvNone, bvLowered, bvRaised, bvSpace);
TGraphicsDrawEffect =
(
gdeNormal, // no effect
gdeDisabled, // grayed image
gdeHighlighted, // a bit highlighted image
gdeShadowed // a bit shadowed image
);
//------------------------------------------------------------------------------
// raw image data
@ -173,6 +180,7 @@ type
procedure ReleaseData;
procedure ExtractRect(const ARect: TRect; out ADst: TRawImage);
procedure PerformEffect(const ADrawEffect: TGraphicsDrawEffect; CreateNewData: Boolean = True);
function ReadBits(const APosition: TRawImagePosition; APrec, AShift: Byte): Word;
procedure ReadChannels(const APosition: TRawImagePosition; out ARed, AGreen, ABlue, AAlpha: Word);
procedure ReadMask(const APosition: TRawImagePosition; out AMask: Boolean);
@ -1403,6 +1411,75 @@ begin
Description.MaskLineEnd, ADst.Mask, ADst.MaskSize);
end;
procedure TRawImage.PerformEffect(const ADrawEffect: TGraphicsDrawEffect;
CreateNewData: Boolean);
const
GlowShadow = 48;
ColorMultiplier = (256 - GlowShadow) / 256;
var
AData: PRGBAQuad;
P: Pointer;
i, j: integer;
begin
if CreateNewData then
begin
GetMem(AData, DataSize);
Move(Data^, AData^, DataSize);
P := AData;
end
else
begin
P := Data;
AData := P;
end;
case ADrawEffect of
gdeNormal: ;
gdeDisabled:
begin
for i := 0 to Description.Height - 1 do
for j := 0 to Description.Width - 1 do
begin
with AData^ do
begin
Red := (Red + Green + Blue) div 3;
Green := Red;
Blue := Red;
end;
inc(AData);
end;
end;
gdeHighlighted:
begin
for i := 0 to Description.Height - 1 do
for j := 0 to Description.Width - 1 do
begin
with AData^ do
begin
Red := Round(GlowShadow + Red * ColorMultiplier);
Green := Round(GlowShadow + Green * ColorMultiplier);
Blue := Round(GlowShadow + Blue * ColorMultiplier);
end;
inc(AData);
end;
end;
gdeShadowed:
begin
for i := 0 to Description.Height - 1 do
for j := 0 to Description.Width - 1 do
begin
with AData^ do
begin
Red := Round(Red * ColorMultiplier);
Green := Round(Green * ColorMultiplier);
Blue := Round(Blue * ColorMultiplier);
end;
inc(AData);
end;
end;
end;
Data := P;
end;
{ TRawImageLineStarts }
function TRawImageLineStarts.GetPosition(x, y: cardinal): TRawImagePosition;

10
lcl/imglist.pp
View File

@ -110,13 +110,6 @@ type
TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
TImageType = (itImage, itMask);
TImageListDrawEffect =
(
ideNormal, // no effect
ideDisabled, // grayed image
ideHighlighted, // a bit highlighted image
ideShadowed // a bit shadowed image
);
TCustomImageList = class(TLCLHandleComponent)
private
@ -201,9 +194,10 @@ type
procedure Delete(AIndex: Integer);
destructor Destroy; override;
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; AEnabled: Boolean = True); overload;
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TImageListDrawEffect); overload;
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect); overload;
procedure FillDescription(out ADesc: TRawImageDescription);
procedure GetBitmap(Index: Integer; Image: TBitmap);
procedure GetRawImage(Index: Integer; out Image: TRawImage);
{$ifdef IMGLIST_KEEP_EXTRA}
procedure GetInternalImage(Index: integer; var Image, Mask: TBitmap;
var ImageRect: TRect);

25
lcl/include/imglist.inc
View File

@ -46,7 +46,6 @@ begin
);
end;
{ TCustomImageList }
{------------------------------------------------------------------------------
@ -547,17 +546,17 @@ end;
procedure TCustomImageList.Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer;
AEnabled: Boolean);
const
EffectMap: array[Boolean] of TImageListDrawEffect =
EffectMap: array[Boolean] of TGraphicsDrawEffect =
(
ideDisabled,
ideNormal
gdeDisabled,
gdeNormal
);
begin
Draw(ACanvas, AX, AY, AIndex, EffectMap[AEnabled]);
end;
procedure TCustomImageList.Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer;
ADrawEffect: TImageListDrawEffect);
ADrawEffect: TGraphicsDrawEffect);
{$ifdef IMGLIST_OLDSTYLE}
var
aBitmap: TBitmap;
@ -642,11 +641,7 @@ begin
{$ifdef IMGLIST_OLDSTYLE}
Image.Assign(TBitMap(FImageList.Items[Index]));
{$else}
CheckIndex(Index);
RawImg.Init;
FillDescription(RawImg.Description);
RawImg.DataSize := FWidth * FHeight * SizeOF(FData[0]);
RawImg.Data := @FData[Index * FWidth * FHeight];
GetRawImage(Index, RawImg);
if not RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True)
then begin
@ -665,6 +660,16 @@ begin
{$endif}
end;
procedure TCustomImageList.GetRawImage(Index: Integer; out Image: TRawImage);
begin
if (FCount = 0) then Exit;
CheckIndex(Index);
Image.Init;
FillDescription(Image.Description);
Image.DataSize := FWidth * FHeight * SizeOF(FData[0]);
Image.Data := @FData[Index * FWidth * FHeight];
end;
{------------------------------------------------------------------------------
procedure TCustomImageList.GetInternalImage(Index: integer; var Image,
Mask: TBitmap);

134
lcl/interfaces/win32/win32wsimglist.pp
View File

@ -53,7 +53,7 @@ type
class procedure Delete(AList: TCustomImageList; AIndex: Integer); override;
class procedure DestroyHandle(AComponent: TComponent); override;
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
class procedure Insert(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
class procedure Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); override;
class procedure Replace(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
@ -77,8 +77,6 @@ const
{ itImage } ILD_NORMAL,
{ itMask } ILD_MASK
);
var
GreyColorMap: array[0..255] of Cardinal;
function ColorToImagelistColor(AColor: TColor): DWord;
begin
@ -266,90 +264,65 @@ begin
end;
class procedure TWin32WSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
var
hdcGrey, hdcBW: HDC;
hbmOld1, hbmGrey, hbmOld2, hbmBW: HBitmap;
InfoGrey: record
Header: TBitmapInfoHeader;
Colors: array[0..255] of Cardinal;
end;
BitsGrey: PChar;
DrawParams: TImageListDrawParams;
RawImg: TRawImage;
ListImg, DeviceImg: TLazIntfImage;
ImgHandle, MskHandle: HBitmap;
ABitmap: TBitmap;
begin
if not WSCheckHandleAllocated(AList, 'Draw')
then Exit;
if ADrawEffect <> ideDisabled then
if ADrawEffect = gdeNormal then
begin
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ACanvas.Handle, ABounds.Left,
ABounds.Top, ABounds.Right, ABounds.Bottom, ColorToImagelistColor(ABkColor),
ColorToImagelistColor(ABlendColor), DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType])
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ACanvas.Handle, ABounds.Left,
ABounds.Top, ABounds.Right, ABounds.Bottom, ColorToImagelistColor(ABkColor),
ColorToImagelistColor(ABlendColor), DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType]);
end
else
if (ADrawEffect = gdeDisabled) and (Win32WidgetSet.CommonControlsVersion >= ComCtlVersionIE6) then
begin
// if it is manifested exe then use winXP algoriphm of gray painting
FillChar(DrawParams, SizeOf(DrawParams), 0);
DrawParams.cbSize := SizeOf(DrawParams);
DrawParams.himlL := HImageList(AList.Handle);
DrawParams.i := AIndex;
DrawParams.hdcDst := ACanvas.Handle;
DrawParams.x := ABounds.Left;
DrawParams.y := ABounds.Top;
DrawParams.cx := ABounds.Right;
DrawParams.cy := ABounds.Bottom;
DrawParams.rgbBk := ColorToImagelistColor(ABkColor);
DrawParams.rgbFg := ColorToImagelistColor(ABlendColor);
DrawParams.fStyle := DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType];
DrawParams.fState := ILS_SATURATE; // draw greyed
ImageList_DrawIndirect(@DrawParams);
end
else
begin
// at moment only Disabled state is implemented
if (Win32WidgetSet.CommonControlsVersion >= ComCtlVersionIE6) then
begin
FillChar(DrawParams, SizeOf(DrawParams), 0);
DrawParams.cbSize := SizeOf(DrawParams);
DrawParams.himlL := HImageList(AList.Handle);
DrawParams.i := AIndex;
DrawParams.hdcDst := ACanvas.Handle;
DrawParams.x := ABounds.Left;
DrawParams.y := ABounds.Top;
DrawParams.cx := ABounds.Right;
DrawParams.cy := ABounds.Bottom;
DrawParams.rgbBk := ColorToImagelistColor(ABkColor);
DrawParams.rgbFg := ColorToImagelistColor(ABlendColor);
DrawParams.fStyle := DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType];
DrawParams.fState := ILS_SATURATE; // draw greyed
ImageList_DrawIndirect(@DrawParams);
end else
begin
hdcGrey := CreateCompatibleDC(ACanvas.Handle);
hdcBW := CreateCompatibleDC(ACanvas.Handle);
// create grey bitmap
FillChar(InfoGrey, sizeof(InfoGrey), 0);
InfoGrey.Header.biSize := sizeof(InfoGrey.Header);
InfoGrey.Header.biWidth := AList.Width;
InfoGrey.Header.biHeight := AList.Height;
InfoGrey.Header.biPlanes := 1;
InfoGrey.Header.biBitCount := 8;
InfoGrey.Header.biCompression := BI_RGB;
// fill color table
System.Move(GreyColorMap, InfoGrey.Colors, 256 * SizeOf(Cardinal));
hbmGrey := CreateDIBSection(hdcGrey, Windows.PBitmapInfo(@InfoGrey)^, DIB_RGB_COLORS, BitsGrey, 0, 0);
hbmBW := CreateBitmap(AList.Width, AList.Height, 1, 0, nil);
hbmOld1 := SelectObject(hdcGrey, hbmGrey);
hbmOld2 := SelectObject(hdcBW, hbmBW);
// draw to greyDC
ImageList_DrawEx(HImageList(AList.Handle), AIndex, hdcGrey, 0,
0, ABounds.Right, ABounds.Bottom, ColorToImagelistColor(ABkColor),
ColorToImagelistColor(ABlendColor), ILD_NORMAL);
// draw to bwDC
ImageList_DrawEx(HImageList(AList.Handle), AIndex, hdcBW, 0,
0, ABounds.Right, ABounds.Bottom, clBlack,
clWhite, ILD_MASK);
// draw grey
BitBlt(ACanvas.Handle, ABounds.Left, ABounds.Top, ABounds.Right,
ABounds.Bottom, hdcGrey, 0, 0, SRCCOPY);
// mask
BitBlt(ACanvas.Handle, ABounds.Left, ABounds.Top, ABounds.Right,
ABounds.Bottom, hdcBW, 0, 0, SRCINVERT);
DeleteObject(SelectObject(hdcBW, hbmOld2));
DeleteDC(hdcBW);
DeleteObject(SelectObject(hdcGrey, hbmOld1));
DeleteDC(hdcGrey);
// use RawImage_PerformEffect to perform drawing effect
AList.GetRawImage(AIndex, RawImg);
RawImg.PerformEffect(ADrawEffect, True);
ABitmap := TBitmap.Create;
if not Widgetset.RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True)
then begin
// bummer, the widgetset doesn't support our 32bit format, try device
ListImg := TLazIntfImage.Create(RawImg, False);
DeviceImg := TLazIntfImage.Create(0, 0);
DeviceImg.DataDescription := GetDescriptionFromDevice(0, AList.Width, AList.Height);
DeviceImg.CopyPixels(ListImg);
DeviceImg.GetRawImage(RawImg);
Widgetset.RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle);
DeviceImg.Free;
ListImg.Free;
end;
ABitmap.SetHandles(ImgHandle, MskHandle);
ACanvas.Draw(ABounds.Left, ABounds.Top, ABitmap);
ABitmap.Free;
FreeMem(RawImg.Data);
end;
end;
@ -413,16 +386,7 @@ begin
then AddData(ImageList, 1, AIndex, AList.Width, AList.Height, AData);
end;
procedure InitGreyColormap;
var
i: Cardinal;
begin
for i := 0 to 255 do
GreyColorMap[i] := $FF000000 or (i shl 16) or (i shl 8) or i;
end;
initialization
InitGreyColormap;
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////

55
lcl/widgetset/wsimglist.pp
View File

@ -40,7 +40,7 @@ interface
// the uses clause of the XXXintf.pp
////////////////////////////////////////////////////
uses
Classes, Contnrs, GraphType, Graphics, ImgList, LCLType, LCLIntf,
Classes, Contnrs, GraphType, Graphics, IntfGraphics, ImgList, LCLType, LCLIntf,
WSLCLClasses, WSProc;
type
@ -54,7 +54,7 @@ type
class procedure Delete(AList: TCustomImageList; AIndex: Integer); virtual;
class procedure DestroyHandle(AComponent: TComponent); override;
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); virtual;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); virtual;
class procedure Insert(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); virtual;
@ -74,27 +74,56 @@ type
private
FWidth: Integer;
FHeight: Integer;
FList: TCustomImageList;
public
constructor Create(AWidth, AHeight: Integer); reintroduce;
procedure Draw(AIndex: Integer; ACanvas: TCanvas; ABounds: TRect; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle);
constructor Create(AList: TCustomImageList); reintroduce;
procedure Draw(AIndex: Integer; ACanvas: TCanvas; ABounds: TRect; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle);
end;
{ TDefaultImageListImplementor }
constructor TDefaultImageListImplementor.Create(AWidth, AHeight: Integer);
constructor TDefaultImageListImplementor.Create(AList: TCustomImageList);
begin
inherited Create(True);
FWidth := AWidth;
FHeight := AHeight;
FList := AList;
end;
procedure TDefaultImageListImplementor.Draw(AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle);
ABounds: TRect; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle);
var
Bitmap: TBitmap;
ABitmap: TBitmap;
RawImg: TRawImage;
ListImg, DeviceImg: TLazIntfImage;
ImgHandle, MskHandle: HBitmap;
begin
Bitmap := TBitmap(Items[AIndex]);
ACanvas.Draw(ABounds.Left, ABounds.Top, Bitmap);
if ADrawEffect = gdeNormal then
begin
ABitmap := TBitmap(Items[AIndex]);
ACanvas.Draw(ABounds.Left, ABounds.Top, ABitmap);
end
else
begin
FList.GetRawImage(AIndex, RawImg);
RawImg.PerformEffect(ADrawEffect, True);
ABitmap := TBitmap.Create;
if not RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True)
then begin
// bummer, the widgetset doesn't support our 32bit format, try device
ListImg := TLazIntfImage.Create(RawImg, False);
DeviceImg := TLazIntfImage.Create(0, 0);
DeviceImg.DataDescription := GetDescriptionFromDevice(0, FList.Width, FList.Height);
DeviceImg.CopyPixels(ListImg);
DeviceImg.GetRawImage(RawImg);
RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle);
DeviceImg.Free;
ListImg.Free;
end;
ABitmap.SetHandles(ImgHandle, MskHandle);
ACanvas.Draw(ABounds.Left, ABounds.Top, ABitmap);
ABitmap.Free;
FreeMem(RawImg.Data);
end;
end;
function InternalCreateBitmap(AList: TCustomImageList; AWidth, AHeight: Integer; AData: PRGBAQuad): TBitmap;
@ -129,7 +158,7 @@ var
ABitmap: TBitmap;
i: integer;
begin
Result := TLCLIntfHandle(TDefaultImageListImplementor.Create(AWidth, AHeight));
Result := TLCLIntfHandle(TDefaultImageListImplementor.Create(AList));
if AData <> nil then
begin
@ -158,7 +187,7 @@ begin
end;
class procedure TWSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TImageListDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
begin
if not WSCheckHandleAllocated(AList, 'Draw')
then Exit;