Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 248
  • Last Modified:

Button Component Problem

I have this component that displays bitmaps as the button.

The problem is the onmouseleave doesn't always work and the button will stick on highlighted...

Here is the code...

unit MMButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls;

type
  TSoundType = (stAppResource, stDLLResource, stFile);
  TMMButton = class(TGraphicControl)
  private
    { Private declarations }
    FBmpNormal,
    FBmpHiLight,
    FBmpPushed,
    FBmpDisabled      : TBitmap;

    FSndOver,
    FSndPush          : string;

    FSoundType        : TSoundType;
    FDllInstance      : integer;

    FDown,
    FOver             : Boolean;

    procedure setNormal(Value : TBitMap);
    procedure setHiLight(Value : TBitMap);
    procedure setPushed(Value : TBitMap);
    procedure setDisabled(Value : TBitmap);
    procedure doSound(whichSound: string);
  protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Paint; override;
    procedure Click; override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property PicNormal   : TBitMap read FBmpNormal write setNormal;
    property PicHiLight  : TBitMap read FBmpHiLight write setHiLight;
    property PicPushed   : TBitMap read FBmpPushed write setPushed;
    property PicDisabled : TBitmap read FBmpDisabled write setDisabled;

    property SndOver     : string read FSndOver write FSndOver;
    property SndPush     : string read FSndPush write FSndPush;
    property SoundType   : TSoundType read FSoundType write FSoundType;
    property DLLInst     : integer read FDLLInstance write FDLLInstance;

    property Height default 30;
    property Width default 30;

    property Enabled;
    property Visible;

    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;

  end; //TMMButton

procedure Register;

implementation
uses
  MMSystem;

procedure Register;
  begin
    RegisterComponents('Additional', [TMMButton]);
  end; //Register

constructor TMMButton.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    Width := 30;
    Height := 30;
    FBmpNormal  := TBitMap.Create;
    FBmpHiLight := TBitmap.Create;
    FBmpPushed  := TBitmap.Create;
    FBmpDisabled := TBitmap.Create;
    FSoundType := stAppResource;
    FDLLInstance := 0;
  end;

destructor TMMButton.Destroy;
  begin
    FBmpNormal.Free;
    FBmpHiLight.Free;
    FBmpPushed.Free;
    FBmpDisabled.Free;
    inherited Destroy;
  end;

procedure TMMButton.setNormal(Value: TBitMap);
  begin
    FBmpNormal.Assign(Value);
    if not FBmpNormal.Empty then begin
      //  Set the height and width of the component based on the
      //  size of the Normal bitmap
      Height := FBmpNormal.Height;
      Width := FBmpNormal.Width;
      FBmpNormal.PaletteModified := True;
      end;
  end; //setNormal

procedure TMMButton.setHiLight(Value: TBitMap);
  begin
    FBmpHiLight.Assign(Value);
  end; //setHiLight

procedure TMMButton.setPushed(Value: TBitMap);
  begin
    FBmpPushed.Assign(Value);
  end; //setPushed

procedure TMMButton.setDisabled(Value: TBitMap);
  begin
    FBmpDisabled.Assign(Value);
  end; //setDisabled

procedure TMMButton.doSound(whichSound : string);
  begin
    case FSoundType of
      stAppResource : PlaySound(PChar(whichSound), hInstance, SND_RESOURCE or SND_ASYNC or SND_NODEFAULT);
      stDLLResource : PlaySound(PChar(whichSound), FDLLInstance, SND_RESOURCE or SND_ASYNC or SND_NODEFAULT);
      stFile        : PlaySound(PChar(whichSound), 0, SND_FILENAME or SND_ASYNC or SND_NODEFAULT);
    end; //case
  end; //doSound

procedure TMMButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
    FDown := True;
    doSound(FSndPush);
    if Not FBmpPushed.Empty then Paint;
    inherited MouseDown(Button, Shift, X, Y);
  end; //MouseDown

procedure TMMButton.CMMouseEnter(var Message: TMessage);
  begin
    FOver := True;
    doSound(FSndOver);
    if (Not FBmpHiLight.Empty) or FDown then Paint;
  end; //CMMouseEnter

procedure TMMButton.CMMouseLeave(var Message: TMessage);
  begin
    FOver := False;
    if (Not FBmpHiLight.Empty) or FDown then Paint;
  end; //CMMouseLeave

procedure TMMButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  var
    DoClick: Boolean;
  begin
    FDown := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if DoClick then begin
      Paint;
      If Assigned(OnClick) then OnClick(Self);
      end;
    inherited MouseUp(Button, Shift, X, Y);
  end; //MouseUp

procedure TMMButton.Click;
  begin
  end; //Click

// On 7/14/97, I added 7 lines of code to the paint method to allow the bitmaps colors to
// be displayed correctly on a machine showing only 256 colors.
//
// Robert Vivrette - RobertV@csi.com

procedure TMMButton.Paint;
  var
    ARect : TRect;
    Src   : TBitMap;
    OldPal : HPalette;                                                          // RLV - 7/14/97

  begin
    OldPal := SelectPalette(Canvas.Handle,FBmpNormal.Palette,False);            // RLV - 7/14/97
    try                                                                         // RLV - 7/14/97
      RealizePalette(Canvas.Handle);                                            // RLV - 7/14/97

      ARect := Rect(0,0,Width,Height);
      if (csDesigning in ComponentState) then

        //Design-time paint response
        if FBmpNormal.Empty then begin
          //add visibility when designing
          with Canvas.Pen do begin
            Style := psSolid;
            Color := clGray;
            Mode :=  pmXor;
            end;
          Canvas.Brush.Style := bsClear;
          Canvas.Rectangle(0, 0, Width, Height);
          end
        else
          Canvas.CopyRect(ARect, FBmpNormal.Canvas, ARect)

      else begin  //Run-time paint response

        // Check the button state & assign the appropriate bitmap
        if not Enabled then
          Src := FBmpDisabled
        else
          if not FOver then
            Src := FBmpNormal
          else
            if FDown then
              Src := FBmpPushed
            else
              Src := FBmpHiLight;

        // catch all if the Src bitmap is not valid at this point, paint
        // the normal bitmap.
        if Src.Empty and (Not FBmpNormal.Empty) then
          Src := FBmpNormal;

        // Paint the component's canvas
        if not Src.Empty then
          Canvas.CopyRect(ARect, Src.Canvas, ARect);

        end
    finally                                                                     // RLV - 7/14/97
      if OldPal <> 0 then                                                       // RLV - 7/14/97
        SelectPalette(Canvas.Handle,OldPal,False);                              // RLV - 7/14/97
    end;
  end; //Paint

end.
0
CourtneyB
Asked:
CourtneyB
  • 11
  • 5
  • 4
  • +4
1 Solution
 
dwwangCommented:
Hi, I have tested this component(a you pasted), and find no problem. So would you make it more specific that in what condition the OnMouseLeave does not work?
0
 
ThaddyCommented:
Just call 'invalidate' as the last statement when the event occurs.
Some video drivers try to 'smart cache' and fail to update.
0
 
MadshiCommented:
Delphi's OnMouseLeave does not always work. So if you look closer at Delphi's SpeedButtons in flat mode, they have the same problem as you have.
I've solved this problem by creating a little timer (one for all buttons) that is started when entering a button and stopped when leaving a button. Everytime it is called it checks if the mouse is still inside the button. Of course this timer method is quite ugly, but it works...   :-(

Regards, Madshi.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
CourtneyBAuthor Commented:
The problem is if you leave the button quickly and land upon another component (put two of these close to eachother).  Quickly move from one to another.  About half the time, the first one will stick in highlighted mode...
0
 
dwwangCommented:
I've tested again and again and can't find any problem.

As Madshi said, this may be a Delphi bug, but I think it is now solved by Delphi4(build 5.37) +update pack#2
0
 
MadshiCommented:
No, sorry, dwwang, I've Delphi 4 update pack 2 and it's still there. The problem is (as always): When you try to reproduce the errors they won't come. But if you don't want them, they'll hurry to occur...   :-(
Sometimes if you look in the toolbar of Delphi 4, you'll see that there's still a frame around one or more (flat) buttons.

Regards, Madshi.
0
 
dwwangCommented:
thanks, Madshi :-)
0
 
MadshiCommented:
Thanks for what?
0
 
CourtneyBAuthor Commented:
Well I am glad I am not the only one having this problem.  I have 3 or 4 mmbuttons real close to eachother on a panel and they stick on highlighted...
0
 
dwwangCommented:
Madshi:
Thanks for telling me D4+Pack2 also has the problem :)
and thanks for saying what all programmers want to say:
"The problem is (as always): When you try to reproduce the errors they won't come. But if you don't want them, they'll hurry to occur..."

CourtneyB:
Maybe there's some problem with version of Delphi as well as OS, what environment are you programming in? (Delphi/OS/...)

Regards,
Wang
0
 
williams2Commented:
I know exactly what the problem is!

The problems occur because the windows encapsulate the message behavior through WndProc's. If the Parent window (The form) encapsualtes the CM_MOUSELAVE or CM_MOUSEENTER messages, they will never arrive to the TMMButton component. It means, that a CM_MOUSEENTER event always will be triggered in the button component, while the CM_MOUSELEAVE event will be triggered only if the mouse is within the testfield.

Therefore we need an inheritance of the message event. I think the following changes to the MMButtonm component might do the trick.

(But I couldn't provoke the error, so you should test it)

procedure TMMButton.CMMouseEnter(var Message: TMessage);
  begin
    FOver := True;
    doSound(FSndOver);
    if (Not FBmpHiLight.Empty) or FDown then Paint;
    inherited;
  end; //CMMouseEnter

procedure TMMButton.CMMouseLeave(var Message: TMessage);
  begin
    FOver := False;
    if (Not FBmpHiLight.Empty) or FDown then Paint;
    inherited;
  end; //CMMouseLeave

To test this I made an application, that builds 100 buttons right next to each other, and I found no error what so ever (with the example above)

For the application you will need two bitmaps at leat 50x50 in size, and make OnCreate event that should look like this:

and remeber to have ..,MMButtons in your Uses clause.

procedure TForm1.FormCreate(Sender: TObject);
var
  But: TMMButton;
  i,j: Integer;
  B1,B2: TBitmap;
begin
  B1 := TBitmap.Create;
  B1.LoadFromFile('Calendar.bmp');
  B1.Width := 50;
  B1.Height:= 50;
  B2 := TBitmap.Create;
  B2.LoadFromFile('GreenBar.bmp');
  B2.Width := 50;
  B2.Height:= 50;
  For i:= 0 to 9 do
    For j:= 0 to 9 do
    Begin
      But:= TMMBUtton.Create(Self);
      But.SetBounds(i*50,j*50,50,50);
      But.PicNormal := B1;
      But.PicHiLight:= B2;
      But.SoundType := stAppResource;
      But.DLLInst   := 0;
      But.parent    := Self;
    End;
end;


Regards,
Williams
0
 
williams2Commented:
..By the way: The image examples were taken from the Delphi 3\Images folder.

Cheers,
Williams
0
 
CourtneyBAuthor Commented:
The problem is if you leave the button quickly and land upon another component (put two of these close to eachother).  Quickly move from one to another.  About half the time, the first one will stick in highlighted mode...
0
 
rwilson032697Commented:
The problem is actually a windows one - when windows sends a message such as a mouse up or a mouse down it sends it to the window under the mouse. So, if you are quick, or windows is preoccupied, you can move the mouse to another window before windows notices and sends an appropriate message.

This same effect serves to get in the road of the mouse enter and leave messages.

So, I think you have two options:

1. Live with it (though I suspect this is a non-starter for you :-)

2. Use a bit of a kludge to get around it. Madshi suggested a timer. My solution is for the button to send itself messages eg:

const
  WM_BUTTONWAKEUPCALL = WM_USER + 1000;

In your mouse enter envent handler do this:

PostMessage(Handle, WM_BUTTONWAKEUPCALL, 0, 0);

This will put a pending message in the message queue.

Define a handler for it:

  procedure WMBUTTONWAKEUPCALL(var Message : TMessage); message WM_BUTTONWAKEUPCALL;

In the implementation for the handler check if the mouse if still over the button, if so then send the message to yourself again, if not check the status of the button and if still highlighted unhiglight it.

 procedure TMYButton.WMBUTTONWAKEUPCALL(var Message : TMessage);
var
  CPos : TPoint;

begin
GetCursorPos(CPos);
CPos := Self.ScreenToClient(CPos);
if (CPos.x < 0) or (CPos.y < 0) or (CPos.x > width) or (CPos.y > Height) then
  begin
    if FOver then
      begin
        FOver := False;
        Paint;
      end;
    // We're outside the button
  end
else
  PostMessage(Handle, WM_BUTTONWAKEUPCALL, 0, 0);
end;

Let us know how this goes.

Cheers,

Raymond.

0
 
MadshiCommented:
Hi Raymond,

your code *should* work, but don't you think it consumes a lot of cpu time? I mean, there's no delay between the messages. If the mouse if above a button, the process will push the cpu to consume 100% time, right?

Regards, Madshi.
0
 
MadshiCommented:
CourtneyB,

perhaps you download Jordan Russell's Toolbar97 sources from "http://www.jordanr.ml.org/". He uses a timer for each button to solve the problem. However, for my button component (is not ready yet) I've enhanced Jordan's method - I'm using only one timer for ALL buttons.

Regards, Madshi.
0
 
williams2Commented:
I don't think that is what's needed. Id you use the inherited method, you will not have the problems you described. When the user leaves the button area, the message is also posted to other components through the parent component. The BIG problem is, that some componentwriters do not always remember to set the inherited command in their messagehandler, which makes the message end here.

I think you should try the example I wrote above, and you'll find, that even though the system is occupied, the event message is still queued until there is time to handle it.

Note: I'm testing this using Delphi 3 and 4 on WinNT Server, it might be that other Windows versions does not supply this feature., I don't know. :-)

Regards,
Williams
0
 
StevenBCommented:
 Regarding TB97:

  I've found that they suffer from this same problem anyway. (Which is why I'm evesdropping on this thread :o) )

  Steven
0
 
rwilson032697Commented:
Madshi - yes this will consume cpu time. Though it will be preempted by pretty much anything that wants the processor as it is only adding messages to the message queue. This would be solved with a 10-20 millesecond sleep period before sending the next message.

Cheers,

Raymond.

0
 
MadshiCommented:
Williams, I'll test your solution in the weekend, but I think, it won't work. If it would be that easy, why do Delphi speed buttons have the same problem? In TB97 Jordan Russell has written that this problem occurs only under win95/98, so you'll have probably no chance to reproduce the problem...

StevenB, are you sure? My own buttons don't have this problem. And I copied the method from TB97 (though I enhanced it). I will look at the TB97 buttons in the weekend, too.

Raymond, I don't like it, if I look at the system monitor and see the cpu running at 100% all the time, when my program is running. Such programs somehow look not quite professional, don't you think so?

Regards, Madshi.
0
 
StevenBCommented:
 Madshi:

  The specific problem I have with TB97 is that occasionally when I use a TB97 button to launch a modal dialog, the button remains "down" after the modal dialog has been closed.

  Steven
0
 
MadshiCommented:
Steven,

yes, that's right.
But the problem CourtneyB has is that the buttons stay in "mouseIn" state - that means they look as if the mouse would be still over them, though it is not. And TB97 doesn't have THIS problem...

Regards, Madshi.
0
 
StevenBCommented:
 Yeah, you're right. I've been a bit rushed and not been paying proper attention. I just thought I might get some info by listening in on this thread.

  Steven
0
 
rwilson032697Commented:
StevenB, if the sleep period was introduced as I suggested the CPU would not sit at 100%.

BTW, ever looked at your CPU usage while Access is running :-)

Cheers,

Raymond.

0
 
MadshiCommented:
Raymond, ok with the Sleep period it would be better. But I still doesn't like it that much... Now it won't push the cpu to 100%, but I think it will (at least a little bit) slow down your process.   :-(
P.S: Do you really orientate your programming level on a Microsoft program like Access???   :-)))

Regards... Madshi.
0
 
rwilson032697Commented:
Madshi - that you should suggest such a thing! :-)

 I was just pointing out what the 800 pound gorilla in this forest does...

Cheers,

Raymond.

0
 
MadshiCommented:
Hi Raymond,

800 pound gorilla?   :-)))
Hmmm. I still think that the timer method is better...
Perhaps CourtneyB should decide what he/she likes more.

CourtneyB,
are you still with us?

Williams,
have tested your code. Doesn't help. The problem occurs with your code, too.

Regards... Madshi.
0
 
rwilson032697Commented:
Eeek.. How did that happen - my comment appeared as an answer. Courtney, you had better reject it - It was only meant as a comment...

Cheers,

Raymond.
0
 
MadshiCommented:
Courtney, what's up?
0
 
williams2Commented:
I've noticed the bug now, it happens in programs running under window98, but it seems like a MS bug, because other programs seems to have the same bug as well.

Regards,
Williams
0
 
MadshiCommented:
Yes, probably it's a MS bug (since it seems that it doesn't occur on winNT).
However, you can fix it by using either "my" method with the timer or Raymond's method with the messages.

Regards, Madshi.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 11
  • 5
  • 4
  • +4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now