Solved

Using Keyboard and Mouse simulataneously with TImage?

Posted on 2000-03-14
9
419 Views
Last Modified: 2010-04-04
Ever used Photoshop?  When you have an image, you can press the spacebar and the cursor turns into a hand, then you can left click and drag the image.  If the SpaceBar is not pressed, then I do not want the image to move, but want to use the mouse to draw a box.

I can not figure out how to check for the Keyboard and the Left Mouse Button.  If I use GetAsyncKeyboardState(32) then it works normally, but not for TImage.  You see when I press the spacebar, it presses the active button and runs stuff.  When I am on something that doesn't cause a problem, it still doesn't seem to recognize it.  Any help would be appreciated.

Also, it should only be a hand when you are over the picture with the mouse, so that when you are not over the picture, then it is just like normal.
0
Comment
Question by:perkley
  • 5
  • 4
9 Comments
 
LVL 17

Accepted Solution

by:
inthe earned 50 total points
ID: 2618179
hi,
for capturing the key on the timage  you can still use the forms keydown event and set a boolean if the key is space.
then on mouse click check the boolean and the button and if left button then do wwhatever:

try this example to see what i mean:


var
  Form1: TForm1;
  space : boolean = false;
implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (button = mbleft) and (space = true) then
form1.caption := 'space and left button are pressed'
else
form1.caption := 'Form1';
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (key = vk_space) then
space := true
else space := false;

end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
space := false;
end;


Regards Barry
0
 
LVL 17

Expert Comment

by:inthe
ID: 2618190
oh and about the cursor just add these lines to change only when over image:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
screen.Cursor := crHandPoint;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
screen.cursor := crDefault;
end;
0
 

Author Comment

by:perkley
ID: 2618587
Since you seem to be the only one answering my questions, I ought to just give you my program and let you write it.  lol.

I accept your answer on the basis that you will still give me some comments on some proper methods of coding.

First of all, I still have the problem that if they are on a button, it won't take the form's keypress.

Should I have OnMouseMove - Set the focus to some other control that I have hidden in a corner, or is their a better way to achieve this.  Also, I have panels on my form, and so when I leave my picture, the Form.OnMouseMove doesn't change the cursor back, and I know I can do each individual panel, but is their a simple way to just say that if the mouse is not over the picture, then default it back?  You see I can do most of this stuff, but I am interested in the best way possible.

Thanks for any comments you can give me.
0
 
LVL 17

Expert Comment

by:inthe
ID: 2618599
right now im going to sleep ,tommorrow i have do some test see what ideas i find to help.
it is more awqward as we have the buttons to deal with and panels(although the cursor probelm should take much fixing i hope)

do you mind pasting here the "view as text" of your form so i know exactly what im dealing with.
it would be a help,but i understand if you dont want to.

0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:perkley
ID: 2618633
Okay, here is my form, but remember, it is only in design mode, so it is not very pretty right now.  Also, the reason for the TImage on the TPanel is so that I can move the panel with the Image, because I place other components on top of the Image, and if I just move the image, then they don't stay on the picture in the correct place, so I had to use a panel.  Hopefully that made sense.

object AMainForm: TAMainForm
  Left = 212
  Top = 180
  Width = 696
  Height = 479
  Caption = 'My Program'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  KeyPreview = True
  OldCreateOrder = False
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnKeyUp = FormKeyUp
  OnMouseMove = FormMouseMove
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 688
    Height = 41
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 0
    object btnLoad: TButton
      Left = 8
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Load Picture'
      TabOrder = 0
      OnClick = btnLoadClick
    end
    object btnCreate: TButton
      Left = 336
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Create File'
      TabOrder = 1
      OnClick = btnCreateClick
    end
    object btnLoadFile: TButton
      Left = 416
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Load File'
      TabOrder = 2
      OnClick = btnLoadFileClick
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 41
    Width = 129
    Height = 391
    Align = alLeft
    BevelOuter = bvNone
    TabOrder = 1
    object Label1: TLabel
      Left = 26
      Top = 12
      Width = 19
      Height = 13
      Caption = 'Top'
    end
    object Label2: TLabel
      Left = 27
      Top = 44
      Width = 18
      Height = 13
      Caption = 'Left'
    end
    object Label3: TLabel
      Left = 17
      Top = 76
      Width = 28
      Height = 13
      Caption = 'Width'
    end
    object Label4: TLabel
      Left = 14
      Top = 109
      Width = 31
      Height = 13
      Caption = 'Height'
    end
    object eWidth: TEdit
      Left = 48
      Top = 72
      Width = 57
      Height = 21
      TabOrder = 0
    end
    object eLeft: TEdit
      Left = 48
      Top = 40
      Width = 57
      Height = 21
      TabOrder = 1
    end
    object eTop: TEdit
      Left = 48
      Top = 8
      Width = 57
      Height = 21
      TabOrder = 2
      OnChange = eTopChange
    end
    object eHeight: TEdit
      Left = 48
      Top = 104
      Width = 57
      Height = 21
      TabOrder = 3
    end
    object btnPlay: TButton
      Left = 14
      Top = 136
      Width = 35
      Height = 25
      Caption = 'Play'
      TabOrder = 4
      TabStop = False
    end
    object btnStop: TButton
      Left = 54
      Top = 136
      Width = 35
      Height = 25
      Caption = 'Stop'
      TabOrder = 5
      TabStop = False
    end
    object lbSettings: TListBox
      Left = 0
      Top = 192
      Width = 121
      Height = 153
      ItemHeight = 13
      Items.Strings = (
        'PIC.TITLE = DEFAULT'
        ETC. . .  ')
      TabOrder = 7
    end
  end
  object pBitmapDisplay: TPanel
    Left = 129
    Top = 41
    Width = 540
    Height = 391
    Align = alClient
    BevelInner = bvLowered
    BevelOuter = bvLowered
    Color = clBtnShadow
    TabOrder = 2
    OnResize = pBitmapDisplayResize
    object pDisplay: TPanel
      Left = 8
      Top = 8
      Width = 321
      Height = 233
      BevelOuter = bvNone
      Color = clBtnShadow
      FullRepaint = False
      TabOrder = 0
      object iDisplay: TImage
        Left = 0
        Top = 0
        Width = 321
        Height = 233
        Align = alClient
        AutoSize = True
        OnClick = iDisplayClick
        OnMouseDown = iDisplayMouseDown
        OnMouseMove = iDisplayMouseMove
        OnMouseUp = iDisplayMouseUp
      end
      object bPlay: TShape
        Left = 8
        Top = 2
        Width = 25
        Height = 25
        Brush.Style = bsClear
        OnMouseDown = bPlayMouseDown
      end
      object bStop: TShape
        Left = 35
        Top = 2
        Width = 24
        Height = 25
        Brush.Style = bsClear
        OnMouseDown = bPlayMouseDown
      end
    end
  end
  object pSBVert: TPanel
    Left = 669
    Top = 41
    Width = 19
    Height = 391
    Align = alRight
    TabOrder = 3
    object sbVert: TScrollBar
      Left = 2
      Top = 1
      Width = 16
      Height = 389
      Align = alRight
      Kind = sbVertical
      PageSize = 0
      TabOrder = 0
      OnChange = sbVertChange
    end
  end
  object pSBHorz: TPanel
    Left = 0
    Top = 432
    Width = 688
    Height = 20
    Align = alBottom
    TabOrder = 4
    object Panel3: TPanel
      Left = 1
      Top = 1
      Width = 129
      Height = 18
      Align = alLeft
      BevelOuter = bvNone
      TabOrder = 0
      object lblTitle: TStaticText
        Left = 0
        Top = 0
        Width = 129
        Height = 18
        Align = alClient
        Alignment = taCenter
        Caption = 'Buttons'
        Color = clNavy
        Font.Charset = ANSI_CHARSET
        Font.Color = clWhite
        Font.Height = -13
        Font.Name = 'Arial'
        Font.Style = [fsBold]
        ParentColor = False
        ParentFont = False
        TabOrder = 0
      end
    end
    object Panel4: TPanel
      Left = 669
      Top = 1
      Width = 18
      Height = 18
      Align = alRight
      BevelOuter = bvNone
      TabOrder = 1
    end
    object Panel5: TPanel
      Left = 130
      Top = 1
      Width = 539
      Height = 18
      Align = alClient
      TabOrder = 2
      object sbHorz: TScrollBar
        Left = 1
        Top = 1
        Width = 537
        Height = 16
        Align = alBottom
        PageSize = 0
        TabOrder = 0
        OnChange = sbHorzChange
        OnScroll = sbHorzScroll
      end
    end
  end
  object OpenPicture: TOpenPictureDialog
    Left = 184
    Top = 8
  end
  object SaveFile: TSaveDialog
    Left = 272
    Top = 8
  end
  object LoadFile: TOpenDialog
    Left = 304
    Top = 8
  end
end
0
 
LVL 17

Expert Comment

by:inthe
ID: 2622624
just so you know
i hav'nt forgot this question.

Life story-->
i work 13 hr shifts + 1 hr driving
so with sleep time is not on my side :-(
the good side is i get either 3 or 4 days off each week and tommorrow is last shift day then i spend more time on this one.
i had a quick look and see the basic troubles and have a few idea's to look into.

just thought i let you know in case your were thinking i've flew away :-)
now must sleep soon (again)
ps
catching the keyboard globaly may require a small hook(not dll just application wide)this saves putting all component keydown events to catch the spacebar.)
hope you understand what i mean.
i dont know how you feel about hook as it is not a nesesity but should make it easier.

back in about 24 hrs(ish)





0
 

Author Comment

by:perkley
ID: 2622905
BTW, I decided to put the image in a ScrollBox instead of using the Panel and TScrollBar components.  It is much easier to layout.  So maybe in your attempts to try you can try with the ScrollBox.
0
 
LVL 17

Expert Comment

by:inthe
ID: 2630494
alrighty then

this s rough example ofcatching the spcae bar no matter what control  has focus for the purposes of setting a global bool to use later.


var
  AMainForm: TAMainForm;
  HGetSpaceHook : THandle = 0;
  space : boolean = false;
  mousey : boolean;
  dummycaption : string = 'space is up and mouse is up';
implementation

{$R *.DFM}

function GetSpaceHook(Code, wParam, lParam: Integer): Integer; stdcall;
var
 keyup : bool;
  begin
  Result:= 0;
   if (Code >= 0) and Assigned(Application)
  and Application.Active and (not IsIconic(GetActiveWindow))
  Then begin
  case Code of HC_ACTION :
  begin
    KeyUp := ((lParam AND (1 shl 31)) <> 0);
    case wParam of
         VK_SPACE : begin
        if (KeyUp <> FALSE) then
         begin
          space := false;
          dummyCaption := 'space is up';
          amainform.caption := dummycaption;
         end
         else begin
         space := true;
         if mousey then
         dummycaption := 'space is down and mouse is down'
         else
         dummycaption := 'space is down';
         amainform.caption := dummycaption;
         exit;
        end;
        end;
      end;
     end;
    end;
    end;
  Result := CallNextHookEx(HGetSpaceHook, Code, wParam, lParam);
  end;

procedure TAMainForm.iDisplayMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (button = mbleft) and (space = true)  then
begin
amainform.caption := 'space is down and mouse is down';
mousey := true;
end
else  begin
amainform.caption := dummycaption;
mousey := false;
end;
end;

procedure TAMainForm.FormCreate(Sender: TObject);
begin
amainform.caption := dummycaption;
if HGetSpaceHook = 0
then
HGetSpaceHook:= SetWindowsHookEx(WH_KEYBOARD, @GetSpaceHook, 0, GetCurrentThreadID);
end;

procedure TAMainForm.FormDestroy(Sender: TObject);
begin
if HGetSpaceHook <> 0
  then UnhookWindowsHookEx(HGetSpaceHook);
  HGetSpaceHook:= 0;
end;

end.


because mousedown only fires once youll only see the 'and mouse is down' bit on caption for a short period.yet the 'space is down' part will stay there while space bar is help down as message is constinly being sent.
to do same for mouse you can adda wh_getmessagehook to it:

var
  Form1: TForm1;
  HGetMessageHook : THandle = 0;
implementation

{$R *.DFM}

function GetMessageHook(Code, wParam, lParam: Integer): Integer; stdcall; var
  M: TMsg;
  Msg: Integer;
begin
  Result:= 0;
  if (Code >= 0)
  and Assigned(Application)
  and Application.Active
  and (not IsIconic(GetActiveWindow))
  then begin
    M:= PMsg(lParam)^;
    Msg:= PMsg(lParam)^.Message;
    if ((Msg >= wm_LButtonDblClk) and (Msg <= wm_MButtonDblClk))
    or ((Msg >= wm_NCRButtonDblClk) and (Msg <= wm_NCMButtonDblClk))
    or (Msg = wm_LButtonDown)
    or (Msg = wm_NCLButtonDown)
    or (Msg = wm_NCRButtonDown)
    then begin
    Form1.label1.caption := 'hello';
    //dont do showmessage cause you wont be able to close
    //message the dialog :-)
      Exit;
    end;
  end;
  Result:= CallNextHookEx(HGetMessageHook, Code, wParam, lParam);
  end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if HGetMessageHook = 0
then HGetMessageHook:= SetWindowsHookEx(wh_GetMessage, @GetMessageHook, 0, GetCurrentThreadID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if HGetMessageHook <> 0
  then UnhookWindowsHookEx(HGetMessageHook);
  HGetMessageHook:= 0;
end;

end.


if you do the 2 together you can then use the space and mouse thing for more than one function ,by checking what control the mouse is over using getcursorpos() etc..
if over imag edo image thing
if over some button do some button thing..
well some idea's anyway..


0
 

Author Comment

by:perkley
ID: 2631709
Thank you for your comments, I really appreciate them.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

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…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

757 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

18 Experts available now in Live!

Get 1:1 Help Now