Flashing form when setting top edge

Asked

Viewed 494 times

1

The following code is a component (unfinished), a label, what I was/am trying to do. The idea was to create a label in which I could define edges, paddings and edges, being that for the edges the thickness is common to all and that I can define the presence or not (from the top edge, right edge, bottom edge and left edge).

I left the rewriting of the Paint method last that, in this case, I have not finished because I detected that by instantiating an object of my class (TMyLabel) and define the presence of one of the edges (upper edge, for example) by the boolean property borderTop and the common thickness (at all edges) via whole property borderWidth, the form keeps blinking.

Commented the line on which I specify a value for edge thickness (borderWidth := valor) or in which I define the presence of the upper edge (borderTop := true), form does not flash anymore. I have looked at the methods (setters) associated with the two properties and do not find the error.

My intuition said that the blinking form could only be error in looping or in recursive Procedure/function call, which is not the case. If anyone can help me, I would be grateful.

unit uMyLabel;

interface

uses
  System.Classes,
  System.Types,
  VCL.Controls,
  VCL.Graphics,
  VCL.StdCtrls;

type
  TMyLabel = class(TCustomLabel)
  private
    FborderTop,
    FborderRight,
    FborderBottom,
    FborderLeft : Boolean;
    FborderTopColor,
    FborderRightColor,
    FborderBottomColor,
    FborderLeftColor,
    Fcolor,
    FdisabledBackgroundColor,
    FdisabledFontColor : TColor;
    Fcaption : TCaption;
    FborderWidth,
    FmarginTop,
    FmarginRight,
    FmarginBottom,
    FmarginLeft,
    FpaddingTop,
    FpaddingRight,
    FpaddingBottom,
    FpaddingLeft : Integer;

    procedure setBorderTop(bool : Boolean);
    procedure setBorderRight(bool : Boolean);
    procedure setBorderBottom(bool : Boolean);
    procedure setBorderLeft(bool : Boolean);

    procedure setBorderWidth(width : Integer);

    procedure setCaption(caption : TCaption);

    procedure setColor(color : TColor);

    procedure setMarginTop(width : Integer);
    procedure setMarginRight(width : Integer);
    procedure setMarginBottom(width : Integer);
    procedure setMarginLeft(width : Integer);

    procedure setPaddingTop(width : Integer);
    procedure setPaddingRight(width : Integer);
    procedure setPaddingBottom(width : Integer);
    procedure setPaddingLeft(width : Integer);

    procedure setTransparent(bool : Boolean);

    function getTextHeight : Integer;
    function getTextWidth : Integer;

    function isTransparent : Boolean;
  protected
    procedure paint; override;

    property alignment;

    property canvas;

    property clientHeight;
    property clientWidth;

    property glowsize;

    property height;

    property layout;

    property width;
  public
    constructor create(aOwner : TComponent); overload;
    constructor create(aOwner : TComponent; fontColor : TColor); overload;

    procedure setBorderColor(color : TColor); overload;
    procedure setBorderColor(color1, color2 : TColor); overload;
    procedure setBorderColor(color1, color2, color3 : TColor); overload;
    procedure setBorderColor(color1, color2, color3, color4 : TColor); overload;

    procedure setMargin(width : Integer); overload;
    procedure setMargin(width1, width2 : Integer); overload;
    procedure setMargin(width1, width2, width3 : Integer); overload;
    procedure setMargin(width1, width2, width3, width4 : Integer); overload;

    procedure setPadding(width : Integer); overload;
    procedure setPadding(width1, width2 : Integer); overload;
    procedure setPadding(width1, width2, width3 : Integer); overload;
    procedure setPadding(width1, width2, width3, width4 : Integer); overload;

    property clientRect;

    property explicitLeft;
    property explicitTop;

    property helpContext;
    property helpKeyWord;
    property helpType;

    property parentBiDiMode;
    property parentColor;
    property parentCustomHint;
    property parentShowHint;

    property textHeight : Integer read getTextHeight;
    property textWidth : Integer read getTextWidth;
  published
    property borderTop : Boolean read FborderTop write setBorderTop default false;
    property borderRight : Boolean read FborderRight write setBorderRight default false;
    property borderBottom : Boolean read FborderBottom write setBorderBottom default false;
    property borderLeft : Boolean read FborderLeft write setBorderLeft default false;

    property borderTopColor : TColor read FborderTopColor write FborderTopColor default clBlack;
    property borderRightColor : TColor read FborderRightColor write FborderRightColor default clBlack;
    property borderBottomColor : TColor read FborderBottomColor write FborderBottomColor default clBlack;
    property borderLeftColor : TColor read FborderLeftColor write FborderLeftColor default clBlack;

    property borderWidth : Integer read FborderWidth write setBorderWidth default 0;

    property caption : TCaption read Fcaption write setCaption;

    property color : TColor read Fcolor write setColor default -16777211;

    property disabledBackgroundColor : TColor read FdisabledBackgroundColor write FdisabledBackgroundColor default -16777211;

    property disabledFontColor : TColor read FdisabledFontColor write FdisabledFontColor default 8421504;

    property dragCursor;
    property dragKind;
    property dragMode;

    property enabled;

    property explicitHeight : Integer read FExplicitHeight;
    property explicitWidth : Integer read FExplicitWidth;

    property font;

    property marginTop : Integer read FmarginTop write setMarginTop default 0;
    property marginRight : Integer read FmarginRight write setMarginRight default 0;
    property marginBottom : Integer read FmarginBottom write setMarginBottom default 0;
    property marginLeft : Integer read FmarginLeft write setMarginLeft default 0;

    property paddingTop : Integer read FpaddingTop write setPaddingTop default 0;
    property paddingRight : Integer read FpaddingRight write setPaddingRight default 0;
    property paddingBottom : Integer read FpaddingBottom write setPaddingBottom default 0;
    property paddingLeft : Integer read FpaddingLeft write setPaddingLeft default 0;

    property parentFont;

    property popupMenu;

    property transparent : Boolean read isTransparent write setTransparent default true;

    property visible;

    property onClick;
    property onContextPopup;
    property onDblClick;
    property onDragDrop;
    property onDragOver;
    property onEndDock;
    property onEndDrag;
    property onGesture;
    property onMouseActivate;
    property onMouseDown;
    property onMouseEnter;
    property onMouseLeave;
    property onMouseMove;
    property onMouseUp;
    property onStartDock;
    property onStartDrag;
  end;

implementation

constructor TMyLabel.create(aOwner : TComponent);
begin
  inherited create(aOwner);
  FborderTopColor := 0;
  FborderRightColor := 0;
  FborderBottomColor := 0;
  FborderLeftColor := 0;
  FborderWidth := 0;
  Fcolor:= -16777211;
  FdisabledBackgroundColor := -16777211;
  FdisabledFontColor := 8421504;
  font.color := 0;
  FmarginTop := 0;
  FmarginRight := 0;
  FmarginBottom := 0;
  FmarginLeft := 0;
  FpaddingTop := 0;
  FpaddingRight := 0;
  FpaddingBottom := 0;
  FpaddingLeft := 0;
  FborderTop := false;
  FborderRight := false;
  FborderBottom := false;
  FborderLeft := false;
  showHint := true;
  transparent := true;
end;

constructor TMyLabel.create(aOwner: TComponent; fontColor: TColor);
begin
  create(aOwner);
  font.color := fontColor;
end;

procedure TMyLabel.paint;
var
  o : TPoint;
  rect : TRect;
  fontColor : TColor;
procedure setSize;
begin
  height := marginTop + paddingTop + canvas.textHeight(caption) + paddingBottom + marginBottom;
  width := marginLeft + paddingLeft + canvas.textWidth(caption) + paddingRight + marginRight;

  if borderTop then
  begin
    if borderBottom then
      height := height + 2*FborderWidth
    else
      height := height + FborderWidth;
  end
  else
  if borderBottom then
    height := height + FborderWidth;

  if borderRight then
  begin
    if borderLeft then
      width := width + 2*FborderWidth
    else
      width := width + FborderWidth;
  end
  else
  if borderLeft then
    width := width + FborderWidth;
end;
procedure renderizarFundo;
begin
  if enabled then
    canvas.brush.color := Fcolor
  else
    canvas.brush.color := disabledBackgroundColor;

  o := TPoint.create(0,0);
  rect := TRect.create(o, self.width, self.height);
  canvas.fillRect(rect);
end;
procedure renderizarBorda;
procedure renderizarBordaSuperior;
begin
//
end;
procedure renderizarBordaDireita;
begin
//
end;
procedure renderizarBordaInferior;
begin
//
end;
procedure renderizarBordaEsquerda;
begin
//
end;
begin
  renderizarBordaSuperior;
  renderizarBordaDireita;
  renderizarBordaInferior;
  renderizarBordaEsquerda;
end;
procedure renderizarTexto;
begin
  fontColor := canvas.font.color;

  if not enabled then
    canvas.font.color := disabledFontColor;

  if borderLeft then
  begin
    if borderTop then
      canvas.textOut(marginLeft+borderWidth+paddingLeft,
        marginTop+borderWidth+paddingTop,
        caption
      )
    else
      canvas.textOut(marginLeft+borderWidth+paddingLeft,
        marginTop+paddingTop,
        caption
      );
  end
  else
  begin
    if borderTop then
      canvas.textOut(marginLeft+paddingLeft,
        marginTop+borderWidth+paddingTop,
        caption
      )
    else
      canvas.textOut(marginLeft+paddingLeft,
        marginTop+paddingTop,
        caption
      );
  end;
end;
begin
  setSize;

  renderizarFundo;
  renderizarBorda;
  renderizarTexto;

  canvas.font.color := fontColor;
end;

procedure TMyLabel.setBorderColor(color: TColor);
begin
  if
    (color <> borderTopColor) or
    (color <> borderRightColor) or
    (color <> borderBottomColor) or
    (color <> borderLeftColor)
  then
  begin
    FborderTopColor := color;
    FborderRightColor := color;
    FborderBottomColor := color;
    FborderLeftColor := color;
    refresh;
  end;
end;

procedure TMyLabel.setBorderColor(color1: TColor; color2: TColor);
begin
  if
    (color1 <> borderTopColor) or
    (color1 <> borderBottomColor) or
    (color2 <> borderRightColor) or
    (color2 <> borderLeftColor)
  then
  begin
    FborderTopColor := color1;
    FborderBottomColor := color1;
    FborderRightColor := color2;
    FborderLeftColor := color2;
    refresh;
  end;
end;

procedure TMyLabel.setBorderColor(color1: TColor; color2: TColor; color3: TColor);
begin
  if
    (color1 <> borderTopColor) or
    (color2 <> borderRightColor) or
    (color2 <> borderLeftColor) or
    (color3 <> borderBottomColor)
  then
  begin
    FborderTopColor := color1;
    FborderRightColor := color2;
    FborderLeftColor := color2;
    FborderBottomColor := color3;
    refresh;
  end;
end;

procedure TMyLabel.setBorderColor(color1: TColor; color2: TColor; color3: TColor; color4: TColor);
begin
  if
    (color1 <> borderTopColor) or
    (color2 <> borderRightColor) or
    (color3 <> borderBottomColor) or
    (color4 <> borderLeftColor)
  then
  begin
    FborderTopColor := color1;
    FborderRightColor := color2;
    FborderBottomColor := color3;
    FborderLeftColor := color4;
    refresh;
  end;
end;

procedure TMyLabel.setCaption(caption: TCaption);
begin
  if caption <> Fcaption then
  begin
    Fcaption := caption;
    refresh;
  end;
end;

procedure TMyLabel.setColor(color: TColor);
begin
  Fcolor := color;
  if canvas.brush.color <> color then
    if not transparent then
    begin
      canvas.brush.color := color;
      refresh;
    end;
end;

procedure TMyLabel.setBorderTop(bool: Boolean);
begin
  if bool <> borderTop then
  begin
    FborderTop := bool;
    refresh;
  end;
end;

procedure TMyLabel.setBorderRight(bool: Boolean);
begin
  if bool <> borderRight then
  begin
    FborderRight := bool;
    refresh;
  end;
end;

procedure TMyLabel.setBorderBottom(bool: Boolean);
begin
  if bool <> borderBottom then
  begin
    FborderBottom := bool;
    refresh;
  end;
end;

procedure TMyLabel.setBorderLeft(bool: Boolean);
begin
  if bool <> borderLeft then
  begin
    FborderLeft := bool;
    refresh;
  end;
end;

procedure TMyLabel.setBorderWidth(width: Integer);
begin
  if width > -1 then
  begin
    if width <> borderWidth then
    begin
      FborderWidth := width;
      refresh;
    end;
  end
  else
  begin
    FborderWidth := 0;
    refresh;
  end;
end;

procedure TMyLabel.setMarginTop(width: Integer);
begin
  if width > -1 then
  begin
    if width <> marginTop then
    begin
      FmarginTop := width;
      refresh;
    end;
  end
  else
  begin
    FmarginTop := 0;
    refresh;
  end;
end;

procedure TMyLabel.setMarginRight(width: Integer);
begin
  if width > -1 then
  begin
    if width <> marginRight then
    begin
      FmarginRight := width;
      refresh;
    end;
  end
  else
  begin
    FmarginRight := 0;
    refresh;
  end;
end;

procedure TMyLabel.setMarginBottom(width: Integer);
begin
  if width > -1 then
  begin
    if width <> marginBottom then
    begin
      FmarginBottom := width;
      refresh;
    end;
  end
  else
  begin
    FmarginBottom := 0;
    refresh;
  end;
end;

procedure TMyLabel.setMarginLeft(width: Integer);
begin
  if width > -1 then
  begin
    if width <> marginLeft then
    begin
      FmarginLeft := width;
      refresh;
    end;
  end
  else
  begin
    FmarginLeft := 0;
    refresh;
  end;
end;

procedure TMyLabel.setMargin(width: Integer);
begin
  if
    (width <> marginTop) or
    (width <> marginRight) or
    (width <> marginBottom) or
    (width <> marginLeft)
  then
  begin
    FmarginTop := width;
    FmarginRight := width;
    FmarginBottom := width;
    FmarginLeft := width;
    refresh;
  end;
end;

procedure TMyLabel.setMargin(width1: Integer; width2: Integer);
begin
  if
    (width1 <> marginTop) or
    (width1 <> marginBottom) or
    (width2 <> marginRight) or
    (width2 <> marginLeft)
  then
  begin
    FmarginTop := width1;
    FmarginBottom := width1;
    FmarginRight := width2;
    FmarginLeft := width2;
    refresh;
  end;
end;

procedure TMyLabel.setMargin(width1: Integer; width2: Integer; width3: Integer);
begin
  if
    (width1 <> marginTop) or
    (width2 <> marginRight) or
    (width2 <> marginLeft) or
    (width3 <> marginBottom)
  then
  begin
    FmarginTop := width1;
    FmarginRight := width2;
    FmarginLeft := width2;
    FmarginBottom := width3;
    refresh;
  end;
end;

procedure TMyLabel.setMargin(width1: Integer; width2: Integer; width3: Integer; width4: Integer);
begin
  if
    (width1 <> marginTop) or
    (width2 <> marginRight) or
    (width3 <> marginBottom) or
    (width4 <> marginLeft)
  then
  begin
    FmarginTop := width1;
    FmarginRight := width2;
    FmarginBottom := width3;
    FmarginLeft := width4;
    refresh;
  end;
end;

procedure TMyLabel.setPaddingTop(width: Integer);
begin
  if width > -1 then
  begin
    if width <> paddingTop then
    begin
      FpaddingTop := width;
      refresh;
    end;
  end
  else
  begin
    FpaddingTop := 0;
    refresh;
  end;
end;

procedure TMyLabel.setPaddingRight(width: Integer);
begin
  if width > -1 then
  begin
    if width <> paddingRight then
    begin
      FpaddingRight := width;
      refresh;
    end;
  end
  else
  begin
    FpaddingRight := 0;
    refresh;
  end;
end;

procedure TMyLabel.setPaddingBottom(width: Integer);
begin
  if width > -1 then
  begin
    if width <> paddingBottom then
    begin
      FpaddingBottom := width;
      refresh;
    end;
  end
  else
  begin
    FpaddingBottom := 0;
    refresh;
  end;
end;

procedure TMyLabel.setPaddingLeft(width: Integer);
begin
  if width > -1 then
  begin
    if width <> paddingLeft then
    begin
      FpaddingLeft := width;
      refresh;
    end;
  end
  else
  begin
    FpaddingLeft := 0;
    refresh;
  end;
end;

procedure TMyLabel.setPadding(width: Integer);
begin
  if
    (width <> paddingTop) or
    (width <> paddingRight) or
    (width <> paddingBottom) or
    (width <> paddingLeft)
  then
  begin
    FpaddingTop := width;
    FpaddingRight := width;
    FpaddingBottom := width;
    FpaddingLeft := width;
    refresh;
  end;
end;

procedure TMyLabel.setPadding(width1: Integer; width2: Integer);
begin
  if
    (width1 <> paddingTop) or
    (width1 <> paddingBottom) or
    (width2 <> paddingRight) or
    (width2 <> paddingLeft)
  then
  begin
    FpaddingTop := width1;
    FpaddingBottom := width1;
    FpaddingRight := width2;
    FpaddingLeft := width2;
    refresh;
  end;
end;

procedure TMyLabel.setPadding(width1: Integer; width2: Integer; width3: Integer);
begin
  if
    (width1 <> paddingTop) or
    (width2 <> paddingRight) or
    (width2 <> paddingLeft) or
    (width3 <> paddingBottom)
  then
  begin
    FpaddingTop := width1;
    FpaddingRight := width2;
    FpaddingLeft := width2;
    FpaddingBottom := width3;
    refresh;
  end;
end;

procedure TMyLabel.setPadding(width1: Integer; width2: Integer; width3: Integer; width4: Integer);
begin
  if
    (width1 <> paddingTop) or
    (width2 <> paddingRight) or
    (width3 <> paddingBottom) or
    (width4 <> paddingLeft)
  then
  begin
    FpaddingTop := width1;
    FpaddingRight := width2;
    FpaddingBottom := width3;
    FpaddingLeft := width4;
    refresh;
  end;
end;

procedure TMyLabel.setTransparent(bool : Boolean);
begin
  if bool <> transparent then
  begin
    if bool then
      canvas.brush.style := bsClear
    else
    begin
      canvas.brush.color := Fcolor;
      canvas.brush.style := bsSolid;
    end;
    refresh;
  end;
end;

function TMyLabel.getTextHeight : Integer;
begin
  getTextHeight := canvas.textHeight(Fcaption);
end;

function TMyLabel.getTextWidth : Integer;
begin
  getTextWidth := canvas.textWidth(Fcaption);
end;

function TMyLabel.isTransparent : Boolean;
begin
  if canvas.brush.style = bsClear then
    isTransparent := true
  else
    isTransparent := false;
end;

end.
  • 1

    Have you tried using DisableAlign and EnableAlign?

  • It doesn’t work. And I’m really unable to see the cause of the problem. Anyway, I appreciate the help.

  • 1

    Try to use the property DoubleBuffered := True, this property is public, it will not be in the inspector Object.

  • This property does not exist; my component extends Tcustomlabel.

  • Got it. This property belongs to Owner (Twincontrol). I added the line (aOwner as Twincontrol) to the constructor. Doublebuffered := True; and stopped flashing; it worked.

  • The bad thing is that, since Tcustomlabel is not a Twincontrol, it is necessary to change a property of Parent/Owner. This is really not good. But, anyway, now that the why of the problem has been found (thank you!), I will run after a way to add Doublebuffered to that class. It seems that if I didn’t understand wrong, this problem is because of the refreshs.

  • 1

    Try to remove the refresh by invalidate

Show 2 more comments

1 answer

1

    constructor TMyLabel.create(aOwner : TComponent);
    begin
      inherited create(aOwner);

      if AOwner.InheritsFrom(TWinControl) then
      begin
        Self.Parent := (aOwner as TWinControl);
        (aOwner as TWinControl).DoubleBuffered := True;
      end;
...

Browser other questions tagged

You are not signed in. Login or sign up in order to post.