OOP: Add scroll wheel support to Icetips Previewer 2004-11-30 -- David S Beggs Newsgroups: softvelocity.clarion.third_party
Due to time constraints, I am not going to be able to make a class out of this at the
moment. Just back from 2 weeks off and a pile on my desk a mile high.
Here is the code I use to add wheel mouse support and "MS Word" like scrolling to Arnor's
Previewer. It even makes a "tick" sound when pages are scrolled using the attached file,
which belongs in the application folder.
If you would like to see it in action, deonlad a demo copy of DOS Printer and preview a
text file. www.dsbglobal.com/dosprinter
The limitation is that if you open 2 or more previewer windows at once, mouse support only
works for the most recently opened instance.
You need to subclass the window, not the client area, and check for wm mousewheel event.
Instructions follow.
Cheers!
Dave Beggs
Copy the attachment into your app folder.
EDITOR NOTE: I have not included this attachment. It is a wav file that plays a tick
when the wheel scrolls. I have commented out the code that uses it.
--------------------------------------------------------
1. This code in Global Data
Savedproc1 LONG
MyPreviewewrThread LONG
--------------------------------------------------------
2. This code inside Global Map
SubClassProc(unsigned, unsigned, unsigned,long),long,pascal
Module('api')
CallWindowProc(long,unsigned, unsigned,
unsigned,long),long,pascal,name('callwindowprocA')
End
MODULE('WINAPI')
dbPlaySound(*cstring,UNSIGNED),BOOL,PROC,pascal,raw,NAME('sndPlaySoundA')
END
--------------------------------------------------------
3. This Code in Global Program Procedures
SubClassProc procedure(unsigned hwnd,unsigned msg1, unsigned wparam,long lparam)
Code
If msg1=115H !wm vscroll ! for windows 95
Post(event:user+1,,MyPreviewerThread)
End
If msg1= 522 !wm mousewheel
If wparam > 0
Post(event:user+2,,MyPreviewerThread)
End
If wparam < 0
Post(event:user+3,,MyPreviewerThread)
End
End
Return callwindowproc(savedproc1, hwnd, msg1, wparam, lparam)
----------------------------------------------------------------------------
then, in the previwer procedure
----------------------------------------------------------------------------
Firstly, define
!dbsoundfile as a cstring(255)
dbint as an unsigned
then ...
1. This code after opening window
savedproc1 = 0{prop:wndProc}
MyPreviewerthread = Thread()
0{prop:wndProc} = Address(SubClassProc)
!dbsoundfile = 'tick.wav'
dbint = 1
--------------------------------------------------------
2. I added 2 procedure routines
ScrollUpabit ROUTINE
Data
NewS LONG
Code
NewS = ITPreviewWindow{Prop:VScrollPos} - 50
If ITP:CurrentPage > 1
If ITP:ClientAreaWidth < (ITP:ImageHeight * (ITP:ZoomValue/100))
If NewS > 0
ITPreviewWindow{Prop:VScrollPos} = NewS
Else
ITP:CurrentPage -= 1
!dbplaysound(dbsoundfile,dbint)
Do DrawPage
ITPreviewWindow{Prop:VScrollPos} = 255
End
Else
ITP:CurrentPage -= 1
!dbplaysound(dbsoundfile,dbint)
Do DrawPage
End
Else
ITPreviewWindow{Prop:VScrollPos} = 0
End
ScrollDownabit ROUTINE
Data
NewS LONG
Code
NewS = ITPreviewWindow{Prop:VScrollPos} + 50
If ITP:CurrentPage < ITP:TotalPages
If ITP:ClientAreaWidth < (ITP:ImageHeight * (ITP:ZoomValue/100))
If NewS < 255
ITPreviewWindow{Prop:VScrollPos} = NewS
Else
ITP:CurrentPage += 1
!dbplaysound(dbsoundfile,dbint)
Do DrawPage
ITPreviewWindow{Prop:VScrollPos} = 0
End
Else
ITP:CurrentPage += 1
!dbplaysound(dbsoundfile,dbint)
Do DrawPage
End
Else
ITPreviewWindow{Prop:VScrollPos} = 255
End
--------------------------------------------------------
3. This code in the accept loop (I've got it at the bottom just under your "resizing"
embed code
If Event() = event:user+1
If ITPreviewWindow{prop:vscrollpos} = 255
If ITP:CurrentPage < ITP:TotalPages
If ITP:ClientAreaWidth < (ITP:ImageHeight * (ITP:ZoomValue/100))
If ITPreviewWindow{Prop:VScrollPos} < 255
ITPreviewWindow{Prop:VScrollPos} = 255
Else
ITP:CurrentPage += 1
Do DrawPage
ITPreviewWindow{Prop:VScrollPos} = 2
End
Else
ITP:CurrentPage += 1
Do DrawPage
End
Else
ITPreviewWindow{Prop:VScrollPos} = 255
End
End
If ITPreviewWindow{prop:vscrollpos} = 0
If ITP:CurrentPage > 1
If ITP:ClientAreaWidth < (ITP:ImageHeight * (ITP:ZoomValue/100))
If ITPreviewWindow{Prop:VScrollPos} > 0
ITPreviewWindow{Prop:VScrollPos} = 0
Else
ITP:CurrentPage -= 1
Do DrawPage
ITPreviewWindow{Prop:VScrollPos} = 254
End
Else
ITP:CurrentPage -= 1
Do DrawPage
End
Else
ITPreviewWindow{Prop:VScrollPos} = 0
End
End
End
If Event() = event:user+2
Do SCROLLUPABIT
End
If Event() = event:user+3
Do SCROLLdownABIT
End
--------------------------------------------------------
4. I alerted upkey and downkey for the window and replaced your elert code with this:
Case KeyCode()
Of PgUpKey
Do ScrollUpPage
Of PgDnKey
Do ScrollDownPage
Of UpKey
Do ScrollUpabit
Of DownKey
Do ScrollDownabit
End
--------------------------------------------------------
(Dr) David S. Beggs BVSc MVS Warrnambool Veterinary Clinic
Printed April 28, 2024, 9:27 am This article has been viewed/printed 35110 times. Google search has resulted in 30 hits on this article since January 25, 2004. |