Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Kill a message

Posted on 2001-06-05
12
Medium Priority
?
208 Views
Last Modified: 2010-04-06
Hi,

I display a MessageDlg asking the user if he really wants to cancel any edits if he moves off the current unsaved node in a trees OnChanging event. Problem is, the MouseDown is processed after this event in the Trees OnMouseDown event. The result is a drag image. I need to cancel(kill) the mouse down message as it is not needed.

Regards,
Dion.
0
Comment
Question by:Diono
  • 5
  • 3
  • 3
  • +1
12 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6156082
? cannot recognize your problem with this sample

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    ImageList1: TImageList;
    CheckBox1: TCheckBox;
    procedure TreeView1Changing(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
var box_result : Integer;
begin
  if checkbox1.checked then //to simulate a changed-Status
  begin
    box_result := messagedlg('Data changed!'+#10+'Save ?',mtConfirmation,mbYesNoCancel,0);
    case box_result of
      mrYes    : Begin
                   //Code for Saving
                   AllowChange := True;
                 end;
      mrNo     : Begin
                   //Code for Cancel Saving, if needed
                   AllowChange := True;
                 end;
      mrCancel : Begin
                   //Abort Node-change
                   AllowChange := False;
                 end;
    end;
  end;
end;

end.

Did i miss something?

meikl ;-)

0
 
LVL 3

Expert Comment

by:MarcG
ID: 6156167
To kill an event just assign nil to it, in your example:
TreeView1.OnMouseDown := nil;
If you need it again: TreeView1.OnMouseDown := TreeView1MouseDown;//Or whatever your Procedure is called
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6156183
hmm,
i see know your problem, guessing you the the drgamode of your tree set to dmAutomatic,

i've enhanced my sample to avoid this

procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
var box_result : Integer;
begin
  if checkbox1.checked then //to simulate a changed-Status
  begin
    box_result := messagedlg('Data changed!'+#10+'Save ?',mtConfirmation,mbYesNoCancel,0);
    If TreeView1.Dragging then   //Discard any Uneeded Drag here
      TreeView1.EndDrag(False);
    case box_result of
      mrYes    : Begin
                   //Code for Saving
                   AllowChange := True;
                 end;
      mrNo     : Begin
                   //Code for Cancel Saving, if needed
                   AllowChange := True;
                 end;
      mrCancel : Begin
                   //Abort Node-change
                   AllowChange := False;
                 end;
    end;
  end;
end;

hope this helps

meikl ;-)
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.

 

Author Comment

by:Diono
ID: 6156296
Meikl, the OnChanging event is fired first(ie not dragging yet!), then the OnMouseDown is fired; I don't want it to fire. By the way, I have already tried you last solution.

Thanks,
Dion.

0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6158926
hmm,

just set the dragmode back to dmManual,
and use the mousemove-event to initiate dragging like

procedure TForm1.TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If ssleft in shift then
    TreeView1.BeginDrag(False); //or TreeView1.BeginDrag(False,10)
end;

meikl ;-)
0
 

Author Comment

by:Diono
ID: 6160087
If I dont display a MessageDlg box, everything behaves normally. Displaying the MessageDlg seems to cause the mouse to be in 'MouseDown' mode. After clicking the MessageDlg box, if I move the mouse(without holding any button down), it changes to a drag image. I must click elsewhere to cancel the drag.

Cheers,
Dion.
0
 
LVL 1

Expert Comment

by:vorisek
ID: 6162633
Try call
 PostMessage (ActiveControl.Handle,wm_LButtonUp,0,0);
before you call the message box.
0
 

Author Comment

by:Diono
ID: 6164425
Hi,

Here is a snippet of the code - excuse all the commenting.


procedure TPupilForm.tvFamilyMembersChanging(Sender: TObject;
  Node: TTreeNode; var AllowChange: Boolean);
var
  MouseDownMSG: TagMSG;
begin
  AllowChange := true;

  if dmPupil.tblFTPerson.State in dsEditModes then
  begin
    if PupilForm.miSaveOnExit.Checked then
    begin
      if CheckFamilyTreeInput then
        bbtPupilInfoSaveClick(Sender)
      else
      begin
        MessageDlg('Please ensure all Data is entered...', mtWarning, [mbOK], 0);
        AllowChange := false;
      end;
    end

    else
    begin
//      Perform(WM_LBUTTONUP, 0, 0);
  //    PostMessage(tvFamilyMembers.Handle,wm_LButtonUp,0,0);
      if MessageDlg('Are you sure you want to CANCEL all Changes!!', mtWarning, [mbYes, mbNo], 0) = mrYes then
      begin
        DoRelativeInfoCancels;
//        Perform(WM_LBUTTONUP, 0, 0);
      end;
//      else
      begin
        AllowChange := false;
      //  KillMessage(tvFamilyMembers.Handle, WM_LBUTTONDOWN);
      end;
    end;
  end

  else if pcFamilyDetails.ActivePage = tsCorrespond then
  begin
  end

  else if pcFamilyDetails.ActivePage = tsAccountPayee then
  begin
  end;

end;
0
 
LVL 1

Expert Comment

by:vorisek
ID: 6166666
Does not raise your problem anything else ?
If I put to OnChanging only the message no problem occurs.

procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
if MessageDlg('Are you sure you want to CANCEL all Changes!!', mtWarning, [mbYes, mbNo], 0) =
mrYes then
     begin  
       sysutils.beep;
     end;
end;

Try to simplify your code as much as possible.
0
 

Author Comment

by:Diono
ID: 6181396
Vorisek, try the same bit of code , but add an OnMouseDown event that looks like this:-

procedure TPupilForm.tvFamilyMembersMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  TreeHitTest: THitTests;
  PopupPT: TPoint;
begin
  { Allow the drag to start if not on the button. }
  TreeHitTest := TTreeView(Sender).GetHitTestInfoAt(X, Y);

  if (htOnItem in TreeHitTest) then
  begin
    if (Button <> mbRight) then
    begin
      { Only allow to drag from nodes on level 2, or 3 in the case of 'other parent'. }
      if (TTreeView(Sender).Selected.Level = 2) then
        TTreeView(Sender).BeginDrag(false, 5);
    end

The only I have managed to get the app to ignore the mouse down is by doing what MarcG suggested. Is there not a more elegant solution?

Cheers,
Dion.
 
0
 
LVL 1

Accepted Solution

by:
vorisek earned 900 total points
ID: 6184866
You can disable dragging by additional variable like this:

var CanDrag:boolean=true;

procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 TreeHitTest: THitTests;
 PopupPT: TPoint;
begin
 { Allow the drag to start if not on the button. }
 TreeHitTest := TTreeView(Sender).GetHitTestInfoAt(X, Y);

 if (htOnItem in TreeHitTest) then
 begin
   if (Button <> mbRight)then
   begin
     { Only allow to drag from nodes on level 2, or 3 in the case of 'other parent'. }
     if (TTreeView(Sender).Selected.Level = 2) then
       if CanDrag then TTreeView(Sender).BeginDrag(false, 5);
       candrag:=true;
   end
 end;(* *)

end;

procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
if MessageDlg('Are you sure you want to CANCEL all Changes!!', mtWarning, [mbYes, mbNo], 0) =
mrYes then
    begin
           candrag:=false;
    end;
end;
0
 

Author Comment

by:Diono
ID: 6186398
Thanks guys!
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Screencast - Getting to Know the Pipeline
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses
Course of the Month20 days, 23 hours left to enroll

810 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