Solved

Button Component Problem

Posted on 1998-12-14
31
209 Views
Last Modified: 2010-04-04
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
Comment
Question by:CourtneyB
  • 11
  • 5
  • 4
  • +4
31 Comments
 
LVL 4

Expert Comment

by:dwwang
ID: 1351022
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
 
LVL 2

Expert Comment

by:Thaddy
ID: 1351023
Just call 'invalidate' as the last statement when the event occurs.
Some video drivers try to 'smart cache' and fail to update.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351024
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
 

Author Comment

by:CourtneyB
ID: 1351025
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
 
LVL 4

Expert Comment

by:dwwang
ID: 1351026
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351027
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
 
LVL 4

Expert Comment

by:dwwang
ID: 1351028
thanks, Madshi :-)
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351029
Thanks for what?
0
 

Author Comment

by:CourtneyB
ID: 1351030
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
 
LVL 4

Expert Comment

by:dwwang
ID: 1351031
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
 
LVL 3

Expert Comment

by:williams2
ID: 1351032
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
 
LVL 3

Expert Comment

by:williams2
ID: 1351033
..By the way: The image examples were taken from the Delphi 3\Images folder.

Cheers,
Williams
0
 

Author Comment

by:CourtneyB
ID: 1351034
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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1351035
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351036
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 20

Expert Comment

by:Madshi
ID: 1351037
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
 
LVL 3

Expert Comment

by:williams2
ID: 1351038
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
 
LVL 4

Expert Comment

by:StevenB
ID: 1351039
 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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1351040
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351041
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
 
LVL 4

Expert Comment

by:StevenB
ID: 1351042
 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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351043
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
 
LVL 4

Expert Comment

by:StevenB
ID: 1351044
 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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1351045
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351046
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
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 200 total points
ID: 1351047
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351048
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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1351049
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351050
Courtney, what's up?
0
 
LVL 3

Expert Comment

by:williams2
ID: 1351051
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
 
LVL 20

Expert Comment

by:Madshi
ID: 1351052
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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now