asked on

Using Keyboard and Mouse simulataneously with TImage?

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.

ASKER CERTIFIED SOLUTION

inthe

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

inthe

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;

perkley

ASKER

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.

inthe

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.

perkley

ASKER

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

inthe

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)

perkley

ASKER

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.

inthe

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..

perkley

ASKER

Thank you for your comments, I really appreciate them.