Lazarus

Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started by: lainz on March 13, 2013, 01:30:47 am

Title: BGRA and Theme library
Post 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?

Code: [Select]
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.
Title: Re: BGRA and Theme library
Post by: Blaazen on March 13, 2013, 02:18:55 am
Reason is maybe the Bitmap.Font.Color. Try to set it to clBtnText.
Title: Re: BGRA and Theme library
Post by: lainz on March 13, 2013, 03:19:43 am
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.
Title: Re: BGRA and Theme library
Post by: lainz on March 13, 2013, 03:34:27 pm
I add more info: seems that the drawfont is drawed as transparent pixels, see image attached
Title: Re: BGRA and Theme library
Post by: circular on March 13, 2013, 08:54:13 pm
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 :

Code: [Select]
  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;
Title: Re: BGRA and Theme library
Post by: lainz on March 13, 2013, 10:28:32 pm
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 :

Code: [Select]
  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;
Title: Re: BGRA and Theme library
Post by: Blaazen on March 13, 2013, 10:38:11 pm
clRed and clWhite are OK but clDefault is not a color. It's only a constant that must be defined somehow.
Title: Re: BGRA and Theme library
Post by: lainz on March 13, 2013, 10:44:41 pm
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.
Title: Re: BGRA and Theme library
Post by: circular on March 14, 2013, 03:23:58 pm
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 :

Code: [Select]
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;
Title: Re: BGRA and Theme library
Post by: lainz on March 14, 2013, 04:05:11 pm
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 :

Code: [Select]
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.
TinyPortal © 2005-2018