• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 370
  • Last Modified:

Why is my rectangle not showing?

HI all,

Im writing an app which when a user mouses over a control (TLabel based) it draws a framerect around the control.  
  My simple code is:

procedure TDispText.paint;
var Rect : TRect;
begin

 if FIsMouseIn then  // triggered from mouse over
    begin
     Rect := self.BoundsRect;
     Canvas.Brush.Color := clWhite;
      Canvas.DrawFocusRect(rect);
    end;
   inherited paint;
end;

My rectangle isnt been drawn though.
Do I have to draw it in the form's paint event (there will be more than one TDispText tho) or have I done something wrong??

Any help appreciated

Al

0
TCS_AL
Asked:
TCS_AL
1 Solution
 
Slick812Commented:
hello TCS AL, the paint event is only called when the component needs to be painted (usually a WM_PAINT message from the system). So you willl need to call the paint method yourself in code. In the the event that sets the FIsMouseIn to true, you might try and add paint

begin
FIsMouseIn := True
paint;
end;


you may also need to call it if you set it to false in the mouse out event
0
 
geobulCommented:
Hi,

In addition to Slick's comment try calling inherited first not last in your overrided Paint method:

procedure TDispText.paint;
var Rect : TRect;
begin
  inherited paint; // call inherited here not in the if..then
  if FIsMouseIn then  // triggered from mouse over
  begin
    Rect := self.BoundsRect;
    Canvas.Brush.Color := clWhite;
    Canvas.DrawFocusRect(rect);
  end;
end;

Regards, Geo
0
 
geobulCommented:
One more thing:
If you want to change the color of the rectangle use Canvas.FrameRect(rect); instead of Canvas.DrawFocusRect(rect);

Regards, Geo
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
pderuiterCommented:
try this procedure, call it in your onmousemove:

procedure drawHandle(Control: TControl; Visible: boolean);
var
  DrawRect: TRect;
  Width: integer;
  Height: integer;
  DC: THandle;
  container: TWinControl;

const
  handleSize: integer = 4;

  procedure DrawHandle (X, Y : Integer);
  var
    Rect : tRect;
  begin
    PatBlt (DC, DrawRect.Left + X, DrawRect.Top + Y,
            HandleSize, HandleSize, PATCOPY)
  end;
begin
  if not Control.Visible then exit;
  container := TWinControl(Control.Parent.Controls[0]);

  DrawRect    := Control.ClientRect;

  OffSetRect(DrawRect,Control.Left - 2,Control.Top - 2);

  Container.Update;

  Width  := DrawRect.Right - DrawRect.Left + 4;
  Height := DrawRect.Bottom - DrawRect.Top + 4;


  DC := GetDC(Container.Handle);
  SelectObject (DC, GetStockObject(BLACK_BRUSH));

  DrawHandle(0, 0);
  DrawHandle((Width - HandleSize) div 2, 0);
  DrawHandle( Width - HandleSize, 0);

  DrawHandle (0, (Height - HandleSize) div 2);
  DrawHandle (Width - HandleSize, (Height - HandleSize) div 2);

  DrawHandle (0, Height - HandleSize);
  DrawHandle ((Width - HandleSize) div 2, Height - HandleSize);
  DrawHandle (Width - HandleSize, Height - HandleSize);

  ReleaseDC (Container.Handle, DC);

  Container.Update;
end;
0
 
TCS_ALAuthor Commented:
pderuiter,

Unfortunately your code dosent work either.  No handle is drawn.
stepping through it, I noticed that this line
   DC := GetDC(Container.Handle);
returns a 0 value.
I did notice that you are casting the control to a TWinControl, whereas a label is decended from TGraphicControl.
Im not sure if this is important as Im still a relative beginner.

Also I forgot to mention, the TDispText is situated on top of a TShape object.  Could the shapes paint method be drawing over the rectangle??

Oh and putting the inherited paint before or after the if statement makes no difference either.

Regards

Al


0
 
geobulCommented:
Hi,

>Oh and putting the inherited paint before or after the if statement makes no difference either.

I'm pretty sure that it changes everything.
 
I suppose that your component's canvas is larger than the visual part of the component. Using a rectangle around the text (not around the control) for drawing resolves the problem. Here is an example which works fine for me.

  TDispText = class(TLabel)
  private
    FIsMouseIn: boolean;
    FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
  protected
    procedure WMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;
    procedure WMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
  public
    procedure Paint; override;
  published
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

procedure TDispText.WMMouseEnter(var Msg: TWMMouse);
begin
  inherited;
  FIsMouseIn := true;
  Paint;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TDispText.WMMouseLeave(var Msg: TWMMouse);
begin
  inherited;
  FIsMouseIn := false;
  Paint;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TDispText.paint;
begin
 inherited paint;
 if FIsMouseIn then  // triggered from mouse over
 begin
   Canvas.Brush.Color := clWhite;
   Canvas.FrameRect(ClientRect);
 end;
end;

Regards, Geo
0
 
TCS_ALAuthor Commented:
Geo,

Thanks for the code, it does work, so points to u.
Interesting, u using the  mouse messages for your events.  I just overrode the labels MouseMove method.  Is that normal, or is your way the norm.

Thanks anyway.

Al
0
 
TCS_ALAuthor Commented:
oops, make that the properties onMouseEnter and OnMouseExit.

Al.


0
 
geobulCommented:
Why 'C' grade? It means that my answer was the worst ever. Once you say that your questions is for 50 points your account will be reduced with exactly 50 points regardless of the grade you will give. But my expert points will be increased with more if you give a better grade. If you don't give 'A' it's usual to say why you are not satisfied by the answer.

>I just overrode the labels MouseMove method.

And your label repaints itself many times in a second on every mouse move? Never do that.

Regards, Geo
0
 
TCS_ALAuthor Commented:
Geo,

Sorry bout that.  Its my first time ive ever used this facility.  

So just imagine I gave you an A grade.

Al
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now