Lazarus
Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started by: lainz on March 13, 2013, 01:30:47 am
-
Hi, I'm using BGRABitmap and BGRAControls TBCXButton, I want to use Windows Themes -- it seems that works in linux too, but i've not tested it -- ( http://wiki.freepascal.org/Theme_library ), it uses Canvas to draw theme elements.
There's a problem with fonts, see image and project attached.
What i'm doing wrong?
procedure TForm1.BCXButton1RenderControl(Sender: TObject; Bitmap: TBGRABitmap;
State: TBCGraphicButtonState);
var
Details: TThemedElementDetails;
PaintRect: TRect;
begin
PaintRect := Rect(0, 0, Bitmap.Width, Bitmap.Height);
case State of
gbsNormal: Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
gbsHover: Details := ThemeServices.GetElementDetails(tbPushButtonHot);
gbsActive: Details := ThemeServices.GetElementDetails(tbPushButtonPressed);
gbsDisabled: Details := ThemeServices.GetElementDetails(tbPushButtonDisabled);
end;
ThemeServices.DrawElement(Bitmap.Canvas.Handle, Details, PaintRect, nil);
PaintRect := ThemeServices.ContentRect(Bitmap.Canvas.Handle, Details, PaintRect);
ThemeServices.DrawText(Bitmap.Canvas, Details, 'Test caption', PaintRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0);
end;
Thanks.
-
Reason is maybe the Bitmap.Font.Color. Try to set it to clBtnText.
-
Reason is maybe the Bitmap.Font.Color. Try to set it to clBtnText.
This is BGRABitmap. The property is Bitmap.Canvas.Font.Color. Is the same doesn't works.
-
I add more info: seems that the drawfont is drawed as transparent pixels, see image attached
-
Oh I think I know what's going on. BGRABitmap is not notified that the bitmap has been modified and so alpha correction is not applied. You need to notify :
PaintRect := ThemeServices.ContentRect(Bitmap.Canvas.Handle, Details, PaintRect);
ThemeServices.DrawText(Bitmap.Canvas, Details, 'Test caption', PaintRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0);
Bitmap.Canvas.Changed;
end;
-
Oh I think I know what's going on. BGRABitmap is not notified that the bitmap has been modified and so alpha correction is not applied. You need to notify :
PaintRect := ThemeServices.ContentRect(Bitmap.Canvas.Handle, Details, PaintRect);
ThemeServices.DrawText(Bitmap.Canvas, Details, 'Test caption', PaintRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0);
Bitmap.Canvas.Changed;
end;
That works, but only If I set form color as black, other background color (clDefault, clWhite, clRed, etc..) is applied as font color in some parts, strange? >>>> (problem3.png)
PD: is more strange :)
If I fill Bitmap (BGRABitmap) with a color Bitmap.Fill(clRed); and I set form color for example clBlue, parts in the font are blue, not red!! I will show you another pic >>>> (problem4.png)
Bitmap.Fill(clRed);
Form.Color := clBlue;
-
clRed and clWhite are OK but clDefault is not a color. It's only a constant that must be defined somehow.
-
clRed and clWhite are OK but clDefault is not a color. It's only a constant that must be defined somehow.
Ok, In Windows 7 with the default theme is something like R240,G240,B240.. No idea where is defined.
Whatever the color I select as form color is used in the font, and that is not right.
-
Oh I think I know. clBlack ($000000) cannot be used here for the font color, because it cannot be distinguished from empty pixels. But I suppose you cannot control this parameter.
A work-around would be to store temporarily the alpha channel and restore it after the text is drawn :
function SaveAlphaRect(ABitmap: TBGRABitmap; ARect: TRect): Pointer;
var width,height,count,y: Integer;
pAlphaData: PByte;
pSrc: PBGRAPixel;
begin
IntersectRect(ARect,ARect,Classes.Rect(0,0,ABitmap.Width,ABitmap.Height));
width := ARect.Right-ARect.Left;
height := ARect.Bottom-ARect.Top;
if (width <= 0) or (height <= 0) then result := nil;
getmem(result, sizeof(longint)*2 + sizeof(byte)*width*height);
PLongint(result)^ := width;
(PLongint(result)+1)^ := height;
pAlphaData := pbyte(plongint(result)+2);
for y := ARect.Top to ARect.Bottom-1 do
begin
pSrc := ABitmap.ScanLine[y]+ARect.Left;
count := width;
while count > 0 do
begin
pAlphaData^ := pSrc^.alpha;
inc(pAlphaData);
inc(pSrc);
dec(count);
end;
end;
end;
procedure RestoreAlphaRectAndFree(ABitmap: TBGRABitmap; AX,AY: integer; ASavedAlphaRect: Pointer);
var width,height,count,y: Integer;
pAlphaData: PByte;
pSrc: PBGRAPixel;
begin
if ASavedAlphaRect = nil then exit;
if AX < 0 then AX := 0;
if AY < 0 then AY := 0;
width := PLongint(ASavedAlphaRect)^;
height := (PLongint(ASavedAlphaRect)+1)^;
pAlphaData := pbyte(plongint(ASavedAlphaRect)+2);
for y := AY to AY+height-1 do
begin
pSrc := ABitmap.ScanLine[y]+AX;
count := width;
while count > 0 do
begin
pSrc^.alpha := pAlphaData^;
inc(pAlphaData);
inc(pSrc);
dec(count);
end;
end;
freemem(ASavedAlphaRect);
end;
procedure TForm1.BCXButton1RenderControl(Sender: TObject; Bitmap: TBGRABitmap;
State: TBCGraphicButtonState);
var
Details: TThemedElementDetails;
PaintRect: TRect;
AlphaRect: Pointer;
begin
PaintRect := Rect(0, 0, Bitmap.Width, Bitmap.Height);
case State of
gbsNormal: Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
gbsHover: Details := ThemeServices.GetElementDetails(tbPushButtonHot);
gbsActive: Details := ThemeServices.GetElementDetails(tbPushButtonPressed);
gbsDisabled: Details := ThemeServices.GetElementDetails(tbPushButtonDisabled);
end;
ThemeServices.DrawElement(Bitmap.Canvas.Handle, Details, PaintRect, nil);
Bitmap.Canvas.Changed;
PaintRect := ThemeServices.ContentRect(Bitmap.Canvas.Handle, Details, PaintRect);
AlphaRect := SaveAlphaRect(Bitmap, PaintRect);
ThemeServices.DrawText(Bitmap.Canvas, Details, 'Test caption', PaintRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0);
RestoreAlphaRectAndFree(Bitmap, PaintRect.Left,PaintRect.Top, AlphaRect);
end;
-
Oh I think I know. clBlack ($000000) cannot be used here for the font color, because it cannot be distinguished from empty pixels. But I suppose you cannot control this parameter.
A work-around would be to store temporarily the alpha channel and restore it after the text is drawn :
function SaveAlphaRect(ABitmap: TBGRABitmap; ARect: TRect): Pointer;
var width,height,count,y: Integer;
pAlphaData: PByte;
pSrc: PBGRAPixel;
begin
IntersectRect(ARect,ARect,Classes.Rect(0,0,ABitmap.Width,ABitmap.Height));
width := ARect.Right-ARect.Left;
height := ARect.Bottom-ARect.Top;
if (width <= 0) or (height <= 0) then result := nil;
getmem(result, sizeof(longint)*2 + sizeof(byte)*width*height);
PLongint(result)^ := width;
(PLongint(result)+1)^ := height;
pAlphaData := pbyte(plongint(result)+2);
for y := ARect.Top to ARect.Bottom-1 do
begin
pSrc := ABitmap.ScanLine[y]+ARect.Left;
count := width;
while count > 0 do
begin
pAlphaData^ := pSrc^.alpha;
inc(pAlphaData);
inc(pSrc);
dec(count);
end;
end;
end;
procedure RestoreAlphaRectAndFree(ABitmap: TBGRABitmap; AX,AY: integer; ASavedAlphaRect: Pointer);
var width,height,count,y: Integer;
pAlphaData: PByte;
pSrc: PBGRAPixel;
begin
if ASavedAlphaRect = nil then exit;
if AX < 0 then AX := 0;
if AY < 0 then AY := 0;
width := PLongint(ASavedAlphaRect)^;
height := (PLongint(ASavedAlphaRect)+1)^;
pAlphaData := pbyte(plongint(ASavedAlphaRect)+2);
for y := AY to AY+height-1 do
begin
pSrc := ABitmap.ScanLine[y]+AX;
count := width;
while count > 0 do
begin
pSrc^.alpha := pAlphaData^;
inc(pAlphaData);
inc(pSrc);
dec(count);
end;
end;
freemem(ASavedAlphaRect);
end;
procedure TForm1.BCXButton1RenderControl(Sender: TObject; Bitmap: TBGRABitmap;
State: TBCGraphicButtonState);
var
Details: TThemedElementDetails;
PaintRect: TRect;
AlphaRect: Pointer;
begin
PaintRect := Rect(0, 0, Bitmap.Width, Bitmap.Height);
case State of
gbsNormal: Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
gbsHover: Details := ThemeServices.GetElementDetails(tbPushButtonHot);
gbsActive: Details := ThemeServices.GetElementDetails(tbPushButtonPressed);
gbsDisabled: Details := ThemeServices.GetElementDetails(tbPushButtonDisabled);
end;
ThemeServices.DrawElement(Bitmap.Canvas.Handle, Details, PaintRect, nil);
Bitmap.Canvas.Changed;
PaintRect := ThemeServices.ContentRect(Bitmap.Canvas.Handle, Details, PaintRect);
AlphaRect := SaveAlphaRect(Bitmap, PaintRect);
ThemeServices.DrawText(Bitmap.Canvas, Details, 'Test caption', PaintRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0);
RestoreAlphaRectAndFree(Bitmap, PaintRect.Left,PaintRect.Top, AlphaRect);
end;
Yes, I can't control the color.
Amazing! Now it works.
I'll add it to bgracontrols BCXButton_test, from now we can create OS based custom buttons with BGRA.