Carets Package

Hi,

Trying to understand carets this last week, I created a 'carets' packages,
that is not dependant on my other packages. The packages is in Dolphin
4.01.3.
The package can certainly be improved upon, but it works (I tested it).

See the package commentary for some examples how to use a caret in a
TextEditorView.

The statement "bitmap := ButterflyBitmap bitmap" is dependant on my
own particular way to deal with Bitmaps, so should be replaced by your own
method of getting a (handle to a) Bitmap.

Regards
Rob Bonnema

----------------------------------------------------------------------
| package |

package := Package name: 'Carets'.

package paxVersion: 0;

basicComment: 'Put the following in the onSetFocus method of a
TextEditorView

caret := Caret handle: self handle width: 8 height: 24 gray: true. "(Gray
caret)"

caret := Caret handle: self handle width: 8 height: 24 gray: false. "(Black
caret)" bitmap := ButterflyBitmap bitmap.

caret := Caret handle: self handle bitmap: bitmap handle. "(Bitmap caret)"

Put the following in the onKillFocus method of a TextEditorView

caret destroy

To vary position and blinkTime.

caret position: 0@0.

caret blinkTime: 500 (half a second). '.

package basicPackageVersion: ''.

"Add the package scripts"

"Add the class names, loose method names, global names, resource names"

package classNames

add: #Caret;

yourself.

package methodNames

add: #UserLibrary -> #createCaret:bitmap:width:height:;

add: #UserLibrary -> #destroyCaret;

add: #UserLibrary -> #getCaretBlinkTime;

add: #UserLibrary -> #getCaretPos:;

add: #UserLibrary -> #hideCaret:;

add: #UserLibrary -> #setCaretBlinkTime:;

add: #UserLibrary -> #setCaretPosX:Y:;

add: #UserLibrary -> #showCaret:;

yourself.

package globalNames

yourself.

package resourceNames

yourself.

"Binary Global Names"

package binaryGlobalNames: (Set new

yourself).

"Resource Names"

package allResourceNames: (Set new

yourself).

"Add the prerequisite names"

package setPrerequisites: (IdentitySet new

add: 'Dolphin';

yourself).

package!

"Class Definitions"!

GraphicsTool subclass: #Caret

instanceVariableNames: 'bitmap width height gray'

classVariableNames: ''

poolDictionaries: ''

classInstanceVariableNames: ''!

"Loose Methods"!

!UserLibrary methodsFor!

createCaret: aHandleToAWindow bitmap: aHandleToABitmap width: aWidth height:
aHeight

"The CreateCaret function creates a new shape for the system caret and

assigns ownership of the caret to the specified window.

The caret shape can be a line, a block, or a bitmap.

BOOL
ateCaret(

HWND hWnd,

HBITMAP hBitmap,

int nWidth,

int nHeight

);"

<stdcall: handle CreateCaret handle handle sdword sdword>

^self invalidCall!

destroyCaret

"The DestroyCaret function destroys the caret's current shape, frees the caret from the window,

and removes the caret from the screen.

BOOL DestroyCaret(VOID); "

<stdcall: bool DestroyCaret >

^self invalidCall!

getCaretBlinkTime

"The GetCaretBlinkTime function returns the time required to invert the caret's pixels.

The user can set this value.

UINT GetCaretBlinkTime(VOID);"

<stdcall: dword GetCaretBlinkTime >

^self invalidCall!

getCaretPos: aPoint

"The GetCaretPos function copies the caret's position to the specified structure.

BOOL GetCaretPos(

LPPOINT lpPoint

);"

<stdcall: bool GetCaretPos POINT*>

^self invalidCall!

hideCaret: aHandleToAWindow

"The HideCaret function removes the caret from the screen.

Hiding a caret does not destroy its current shape or invalidate the insertion point.

BOOL HideCaret(

HWND hWnd

);"

<stdcall: bool HideCaret handle >

^self invalidCall!

setCaretBlinkTime: aMilliSeconds

"The SetCaretBlinkTime function sets the caret blink time to the specified number of milliseconds.

The blink time is the elapsed time, in milliseconds, required to inv
ert the caret's pixels.

BOOL
CaretBlinkT
ime(

UINT uMSeconds

;"

<stdcall: bool SetCaretBlinkTime dword>

^self invalidCall!

setCaretPosX: anX Y: anY

"The SetCaretPos function moves the caret to the specified coordinates. If the window that

owns the caret was created with the CS_OWNDC class style, then the specified coordinates are subject

to the mapping mode of the device context associated with that window.

BOOL SetCaretPos(

int X,

int Y

);"

<stdcall: bool SetCaretPos sdword sdword>

^self invalidCall!

showCaret: aHandleToAWindow

"The ShowCaret function makes the caret visible on the screen at the caret's current position.

When the caret becomes visible, it begins flashing automatically.

BOOL ShowCaret(

HWND hWnd

);"

<stdcall: bool ShowCaret handle >

^self invalidCall! !

!UserLibrary categoriesFor: #createCaret:bitmap:width:height:!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #destroyCaret!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #getCaretBlinkTime!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #getCaretPos:!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #hideCaret:!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #setCaretBlinkTime:!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #setCaretPosX:Y:!*-primitives!public!win32 functions-carets! !

!UserLibrary categoriesFor: #showCaret:!*-primitives!public!win32 functions-carets! !

"End of package definition"!





Caret comment: ''!

Caret guid: (GUID fromString: '{511CFA3A-5105-4CC8-B64C-3B3FD7CD4556}')!

!Caret categoriesForClass!Unclassified! !

!Caret methodsFor!

basicFree

"Private - Free up the Caret. "

UserLibrary default destroyCaret!

bitmap

"Private - Answer the value of the receiver's ''bitmap'' instance variable."

^bitmap!

bitmap: anObject

"Private - Set
 the value of the receiver's ''bitmap'' insta
nce variable to the argument,
anObject."

bitmap := anObject!

blinkTime

"Private - Answer the value of the receiver's ''blinkTime'' instance
variable."

^UserLibrary default getCaretBlinkTime

!

blinkTime: aNrOfMilliseconds

"Private - Answer the value of the receiver's ''blinkTime'' instance
variable."

^UserLibrary default setCaretBlinkTime: aNrOfMilliseconds

!

createCaret: aHandle bitmap: aBitmap

"Private - Set the receiver as the current caret."

UserLibrary default createCaret: aHandle bitmap: aBitmap width: 0 height: 0.

self show.

^self.

!

createCaret: aHandle width: aWidth height: aHeight

"Private - Set the receiver as the current caret. "

UserLibrary default createCaret: aHandle bitmap: nil width: aWidth height:
aHeight.

self show.

^self.!

createCaret: aHandle width: aWidth height: aHeight gray: aBoolean

"Private - Set the receiver as the current caret. "

| bitmapHandle |

aBoolean ifTrue: [ bitmapHandle := 1 asParameter ];

ifFalse: [ bitmapHandle := 0 asParameter ].

UserLibrary default createCaret: aHandle bitmap: bitmapHandle width: aWidth
height: aHeight.

self show.

^self.!

destroy

"Private - Free up the Caret. "

self basicFree.!

gray

"Private - Answer the value of the receiver's ''gray'' instance variable."

^gray!

gray: anObject

"Private - Set the value of the receiver's ''gray'' instance variable to the
argument, anObject."

gray := anObject!

height

"Private - Answer the value of the receiver's ''height'' instance variable."

^height!

height: anObject

"Private - Set the value of the receiver's ''height'' instance variable to
the argument, anObject."

height := anObject!

hide

"Hide the caret"

UserLibrary default hideCaret: self handle asParameter.

!

position

"Get the position of the caret."


| pt |

pt := Point new.

UserLibrary default getCaretPos: pt asParameter.

^pt.!

position: aPoint

"Set the position of the caret."

^UserLibrary default setCaretPosX: aPoint x Y: aPoint y.!

show

"Show the caret. "

UserLibrary default showCaret: self handle asParameter.

!

width

"Private - Answer the value of the receiver's ''width'' instance variable."

^width!

width: anObject

"Private - Set the value of the receiver's ''width'' instance variable to
the argument, anObject."

width := anObject! !

!Caret categoriesFor: #basicFree!private!realizing/unrealizing! !

!Caret categoriesFor: #bitmap!accessing!private! !

!Caret categoriesFor: #bitmap:!accessing!private! !

!Caret categoriesFor: #blinkTime!accessing!public! !

!Caret categoriesFor: #blinkTime:!accessing!public! !

!Caret categoriesFor: #createCaret:bitmap:!operations!private! !

!Caret categoriesFor: #createCaret:width:height:!operations!private! !

!Caret categoriesFor: #createCaret:width:height:gray:!operations!private! !

!Caret categoriesFor: #destroy!public!realizing/unrealizing! !

!Caret categoriesFor: #gray!accessing!private! !

!Caret categoriesFor: #gray:!accessing!private! !

!Caret categoriesFor: #height!accessing!private! !

!Caret categoriesFor: #height:!accessing!private! !

!Caret categoriesFor: #hide!*-unclassified!public! !

!Caret categoriesFor: #position!accessing!public! !

!Caret categoriesFor: #position:!accessing!public! !

!Caret categoriesFor: #show!*-unclassified!public! !

!Caret categoriesFor: #width!accessing!private! !

!Caret categoriesFor: #width:!accessing!private! !

!Caret class methodsFor!

handle: aHandle bitmap: aBitmap

"Answer a new instance of the caret with the specified bitmap."


^self new

handle: aHandle;

bitmap: aBitmap;

width: 0;

height: 0;

gray: false;

position: 0@0;

blinkTime: 500;

createCaret: aHandle bitmap: aBitmap.

!

handle: aHandle width: aWidth height: aHeight

"Answer a new instance of the caret with the specified width and height."


^self new

handle: aHandle;

bitmap: 0;

width: aWidth;

height: aHeight;

gray: false;

position: 0@0;

blinkTime: 500;

createCaret: aHandle width: aWidth height: aHeight.

!

handle: aHandle width: aWidth height: aHeight gray: aBoolean

"Answer a new instance of the gray caret with the specified width and
height."


^self new

handle: aHandle;

bitmap: 1;

width: aWidth;

height: aHeight;

gray: true;

position: 0@0;

blinkTime: 500;

createCaret: aHandle width: aWidth height: aHeight gray: aBoolean

! !

!Caret class categoriesFor: #handle:bitmap:!*-unclassified!public! !

!Caret class categoriesFor: #handle:width:height:!*-unclassified!public! !

!Caret class categoriesFor:
#handle:width:height:gray:!*-unclassified!public! !


"Binary Globals"!

"Resources"!