Compiling a program with visual Cobol 5.0, i become the warning in the subject.
What is missing in Special names?
Who can help?
Thanks
Page 1 / 1
Compiling a program with visual Cobol 5.0, i become the warning in the subject.
What is missing in Special names?
Who can help?
Thanks
Searching the product documentation for "COBCH1068" returns this page:
https://www.microfocus.com/documentation/enterprise-developer/ed50/ED-VS2017/HRERRHSERRM9.html
which says:
A common cause of this error is the omission of the word "type" in an inherit statement
Without more information about the program which is producing this warning, that's all I can tell you.
Searching the product documentation for "COBCH1068" returns this page:
https://www.microfocus.com/documentation/enterprise-developer/ed50/ED-VS2017/HRERRHSERRM9.html
which says:
A common cause of this error is the omission of the word "type" in an inherit statement
Without more information about the program which is producing this warning, that's all I can tell you.
*=================================================================
* gxcHKey - Klasse gxcHotkey
*=================================================================
*-----------------------------------------------------------------
* Prototypen, Typedefs und Vocabulary
*-----------------------------------------------------------------
copy "windows.cpy".
/-----------------------------------------------------------------
* gxcHotkey
*-----------------------------------------------------------------
class-id. gxcHotkey data is protected
inherits from gadget with data.
class-control.
Font is class "font"
EventManager is class "p2emgr"
gxcHotkey is class "gxchkey".
copy "callconv.cpy".
/=================================================================
* K l a s s e n o b j e k t
*=================================================================
class-object.
object-storage section.
/=================================================================
* Klassenobjekt : GetXBorderOffSet
*=================================================================
* Returns the offset from the left side of a text entry field to
* the leftmost internal area of the entry field's display.
*=================================================================
method-id. "GetXBorderOffSet".
local-storage section.
01 dwY DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwX-l DWORD.
procedure division returning dwX-l.
invoke Font "getDefaultFontWidthHeight" using dwX-l dwY
add 1 to dwX-l
divide 4 into dwX-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke odesktop "scaleXUp" using dwX-l
exit method.
end method "GetXBorderOffSet".
/=================================================================
* Klassenobjekt : GetYBorderOffSet
*=================================================================
* Returns the offset from the top side of a text entry field to
* the topmost internal area of the entry field's display.
*=================================================================
method-id. "GetYBorderOffSet".
local-storage section.
01 dwX DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwY-l DWORD.
procedure division returning dwY-l.
invoke Font "getDefaultFontWidthHeight" using dwX dwY-l
add 1 to dwY-l
divide 4 into dwY-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke oDesktop "scaleYUp" using dwY-l
exit method.
end method "GetYBorderOffSet".
end class-object.
/=================================================================
* E i n z e l o b j e k t
*=================================================================
Object.
object-storage section.
01 dwKeycode-o DWORD value zero.
/=================================================================
* Einzelobjekt : CreatePanels
*=================================================================
* GUI-Objekt erzeugen.
*=================================================================
method-id. "CreatePanels".
local-storage section.
01 dwX DWORD.
01 dwY DWORD.
procedure division.
if notCreated
invoke super "CreatePanels"
invoke self "SetHotkey" using dwKeycode-o
end-if
exit method.
end method "CreatePanels".
/=================================================================
* Einzelobjekt : setEmpty
*=================================================================
* Inhalt des Controls löschen.
*=================================================================
method-id. "setEmpty".
procedure division.
move zero to dwKeycode-o
invoke self "SetHotkey" using dwKeycode-o
exit method.
end method "setEmpty".
/=================================================================
* Einzelobjekt : exgetBaseLineOffset
*=================================================================
* Return the offset for this control to be baselined.
*=================================================================
method-id. "exgetBaseLineOffset".
copy "winflags.cpy".
local-storage section.
01 lsFont HFONT.
01 lsTextMetric TEXTMETRIC.
01 lsDC HDC.
01 lsOldFont HFONT.
01 lsFontObj usage object reference.
01 lsMask pic x(4) comp-5.
01 lsDefFontY pic x(4) comp-5.
linkage section.
01 lnkOffset pic x(4) comp-5.
procedure division returning lnkOffset.
invoke Font "getDefaultFontHeight" returning lsDefFontY
invoke self "getFont" returning lsfontObj
invoke lsFontObj "getId" returning lsFont
call WAPI GetDC using by value 0 size 4
returning lsDC
call WAPI SelectObject using by value lsDC
by value lsFont
returning lsOldFont
call WAPI GetTextMetrics using by value lsDC
by reference lsTextMetric
call WAPI SelectObject using by value lsDC
by value lsOldFont
call WAPI ReleaseDC using by value 0 size 4
by value lsDC
move ws-border to lsMask
call logical "CBL_AND" using dwstyle
lsMask
by value 4
if lsMask = ws-border
move lsdefFontY to lnkOffset
divide 4 into lnkOffset
add tmHeight of lsTextMetric to lnkOffset
else
move tmHeight of lsTextMetric to lnkOffset
end-if
exit method
end method "exgetBaseLineOffset".
/=================================================================
* Einzelobjekt : getClassNameZ
*=================================================================
* Name der Windows-Fensterklasse nullterminiert zurückgeben.
*=================================================================
method-id. "getClassNameZ".
linkage section.
01 xClassName-l pic x(255).
procedure division returning xClassName-l.
move HOTKEY-CLASS & x"00" to xClassName-l
exit method
end method "getClassNameZ".
/=================================================================
* Einzelobjekt : SetHotkey
*=================================================================
* Angegebenen Keycode im Control anzeigen.
*=================================================================
method-id. "SetHotkey".
local-storage section.
01 wKeycode WORD.
01 filler redefines wKeycode.
03 wKeycode-High BYTE.
03 wKeycode-Low BYTE.
01 bHelp BYTE.
linkage section.
01 dwKeycode-l DWORD.
procedure division using dwKeycode-l.
if isCreated
move dwKeycode-l to wKeycode
move wKeycode-High to bHelp
move wKeycode-Low to wKeycode-High
move bHelp to wKeycode-Low
call WAPI SendMessage using by value p2-id
by value HKM-SETHOTKEY
by value wKeycode
by value 0
else
move dwKeycode-l to dwKeycode-o
end-if
exit method
end method "SetHotkey".
/=================================================================
* Einzelobjekt : GetHotkey
*=================================================================
* Aktuellen Keycode zurückliefern.
*=================================================================
method-id. "GetHotkey".
local-storage section.
01 wkKeycode pic 9(4) comp-x.
linkage section.
01 dwKeycode-l DWORD.
procedure division returning dwKeycode-l.
if isCreated
call WAPI SendMessage using by value p2-id
by value HKM-GETHOTKEY
by value 0
by value 0
returning wkKeycode
move wkKeycode to dwKeycode-l
else
move zero to dwKeycode-l
end-if
exit method
end method "GetHotkey".
end object.
end class gxcHotkey.
Here the source file:
*=================================================================
* gxcHKey - Klasse gxcHotkey
*=================================================================
*-----------------------------------------------------------------
* Prototypen, Typedefs und Vocabulary
*-----------------------------------------------------------------
copy "windows.cpy".
/-----------------------------------------------------------------
* gxcHotkey
*-----------------------------------------------------------------
class-id. gxcHotkey data is protected
inherits from gadget with data.
class-control.
Font is class "font"
EventManager is class "p2emgr"
gxcHotkey is class "gxchkey".
copy "callconv.cpy".
/=================================================================
* K l a s s e n o b j e k t
*=================================================================
class-object.
object-storage section.
/=================================================================
* Klassenobjekt : GetXBorderOffSet
*=================================================================
* Returns the offset from the left side of a text entry field to
* the leftmost internal area of the entry field's display.
*=================================================================
method-id. "GetXBorderOffSet".
local-storage section.
01 dwY DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwX-l DWORD.
procedure division returning dwX-l.
invoke Font "getDefaultFontWidthHeight" using dwX-l dwY
add 1 to dwX-l
divide 4 into dwX-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke odesktop "scaleXUp" using dwX-l
exit method.
end method "GetXBorderOffSet".
/=================================================================
* Klassenobjekt : GetYBorderOffSet
*=================================================================
* Returns the offset from the top side of a text entry field to
* the topmost internal area of the entry field's display.
*=================================================================
method-id. "GetYBorderOffSet".
local-storage section.
01 dwX DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwY-l DWORD.
procedure division returning dwY-l.
invoke Font "getDefaultFontWidthHeight" using dwX dwY-l
add 1 to dwY-l
divide 4 into dwY-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke oDesktop "scaleYUp" using dwY-l
exit method.
end method "GetYBorderOffSet".
end class-object.
/=================================================================
* E i n z e l o b j e k t
*=================================================================
Object.
object-storage section.
01 dwKeycode-o DWORD value zero.
/=================================================================
* Einzelobjekt : CreatePanels
*=================================================================
* GUI-Objekt erzeugen.
*=================================================================
method-id. "CreatePanels".
local-storage section.
01 dwX DWORD.
01 dwY DWORD.
procedure division.
if notCreated
invoke super "CreatePanels"
invoke self "SetHotkey" using dwKeycode-o
end-if
exit method.
end method "CreatePanels".
/=================================================================
* Einzelobjekt : setEmpty
*=================================================================
* Inhalt des Controls löschen.
*=================================================================
method-id. "setEmpty".
procedure division.
move zero to dwKeycode-o
invoke self "SetHotkey" using dwKeycode-o
exit method.
end method "setEmpty".
/=================================================================
* Einzelobjekt : exgetBaseLineOffset
*=================================================================
* Return the offset for this control to be baselined.
*=================================================================
method-id. "exgetBaseLineOffset".
copy "winflags.cpy".
local-storage section.
01 lsFont HFONT.
01 lsTextMetric TEXTMETRIC.
01 lsDC HDC.
01 lsOldFont HFONT.
01 lsFontObj usage object reference.
01 lsMask pic x(4) comp-5.
01 lsDefFontY pic x(4) comp-5.
linkage section.
01 lnkOffset pic x(4) comp-5.
procedure division returning lnkOffset.
invoke Font "getDefaultFontHeight" returning lsDefFontY
invoke self "getFont" returning lsfontObj
invoke lsFontObj "getId" returning lsFont
call WAPI GetDC using by value 0 size 4
returning lsDC
call WAPI SelectObject using by value lsDC
by value lsFont
returning lsOldFont
call WAPI GetTextMetrics using by value lsDC
by reference lsTextMetric
call WAPI SelectObject using by value lsDC
by value lsOldFont
call WAPI ReleaseDC using by value 0 size 4
by value lsDC
move ws-border to lsMask
call logical "CBL_AND" using dwstyle
lsMask
by value 4
if lsMask = ws-border
move lsdefFontY to lnkOffset
divide 4 into lnkOffset
add tmHeight of lsTextMetric to lnkOffset
else
move tmHeight of lsTextMetric to lnkOffset
end-if
exit method
end method "exgetBaseLineOffset".
/=================================================================
* Einzelobjekt : getClassNameZ
*=================================================================
* Name der Windows-Fensterklasse nullterminiert zurückgeben.
*=================================================================
method-id. "getClassNameZ".
linkage section.
01 xClassName-l pic x(255).
procedure division returning xClassName-l.
move HOTKEY-CLASS & x"00" to xClassName-l
exit method
end method "getClassNameZ".
/=================================================================
* Einzelobjekt : SetHotkey
*=================================================================
* Angegebenen Keycode im Control anzeigen.
*=================================================================
method-id. "SetHotkey".
local-storage section.
01 wKeycode WORD.
01 filler redefines wKeycode.
03 wKeycode-High BYTE.
03 wKeycode-Low BYTE.
01 bHelp BYTE.
linkage section.
01 dwKeycode-l DWORD.
procedure division using dwKeycode-l.
if isCreated
move dwKeycode-l to wKeycode
move wKeycode-High to bHelp
move wKeycode-Low to wKeycode-High
move bHelp to wKeycode-Low
call WAPI SendMessage using by value p2-id
by value HKM-SETHOTKEY
by value wKeycode
by value 0
else
move dwKeycode-l to dwKeycode-o
end-if
exit method
end method "SetHotkey".
/=================================================================
* Einzelobjekt : GetHotkey
*=================================================================
* Aktuellen Keycode zurückliefern.
*=================================================================
method-id. "GetHotkey".
local-storage section.
01 wkKeycode pic 9(4) comp-x.
linkage section.
01 dwKeycode-l DWORD.
procedure division returning dwKeycode-l.
if isCreated
call WAPI SendMessage using by value p2-id
by value HKM-GETHOTKEY
by value 0
by value 0
returning wkKeycode
move wkKeycode to dwKeycode-l
else
move zero to dwKeycode-l
end-if
exit method
end method "GetHotkey".
end object.
end class gxcHotkey.
*=================================================================
* gxcHKey - Klasse gxcHotkey
*=================================================================
*-----------------------------------------------------------------
* Prototypen, Typedefs und Vocabulary
*-----------------------------------------------------------------
copy "windows.cpy".
/-----------------------------------------------------------------
* gxcHotkey
*-----------------------------------------------------------------
class-id. gxcHotkey data is protected
inherits from gadget with data.
class-control.
Font is class "font"
EventManager is class "p2emgr"
gxcHotkey is class "gxchkey".
copy "callconv.cpy".
/=================================================================
* K l a s s e n o b j e k t
*=================================================================
class-object.
object-storage section.
/=================================================================
* Klassenobjekt : GetXBorderOffSet
*=================================================================
* Returns the offset from the left side of a text entry field to
* the leftmost internal area of the entry field's display.
*=================================================================
method-id. "GetXBorderOffSet".
local-storage section.
01 dwY DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwX-l DWORD.
procedure division returning dwX-l.
invoke Font "getDefaultFontWidthHeight" using dwX-l dwY
add 1 to dwX-l
divide 4 into dwX-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke odesktop "scaleXUp" using dwX-l
exit method.
end method "GetXBorderOffSet".
/=================================================================
* Klassenobjekt : GetYBorderOffSet
*=================================================================
* Returns the offset from the top side of a text entry field to
* the topmost internal area of the entry field's display.
*=================================================================
method-id. "GetYBorderOffSet".
local-storage section.
01 dwX DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwY-l DWORD.
procedure division returning dwY-l.
invoke Font "getDefaultFontWidthHeight" using dwX dwY-l
add 1 to dwY-l
divide 4 into dwY-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke oDesktop "scaleYUp" using dwY-l
exit method.
end method "GetYBorderOffSet".
end class-object.
/=================================================================
* E i n z e l o b j e k t
*=================================================================
Object.
object-storage section.
01 dwKeycode-o DWORD value zero.
/=================================================================
* Einzelobjekt : CreatePanels
*=================================================================
* GUI-Objekt erzeugen.
*=================================================================
method-id. "CreatePanels".
local-storage section.
01 dwX DWORD.
01 dwY DWORD.
procedure division.
if notCreated
invoke super "CreatePanels"
invoke self "SetHotkey" using dwKeycode-o
end-if
exit method.
end method "CreatePanels".
/=================================================================
* Einzelobjekt : setEmpty
*=================================================================
* Inhalt des Controls löschen.
*=================================================================
method-id. "setEmpty".
procedure division.
move zero to dwKeycode-o
invoke self "SetHotkey" using dwKeycode-o
exit method.
end method "setEmpty".
/=================================================================
* Einzelobjekt : exgetBaseLineOffset
*=================================================================
* Return the offset for this control to be baselined.
*=================================================================
method-id. "exgetBaseLineOffset".
copy "winflags.cpy".
local-storage section.
01 lsFont HFONT.
01 lsTextMetric TEXTMETRIC.
01 lsDC HDC.
01 lsOldFont HFONT.
01 lsFontObj usage object reference.
01 lsMask pic x(4) comp-5.
01 lsDefFontY pic x(4) comp-5.
linkage section.
01 lnkOffset pic x(4) comp-5.
procedure division returning lnkOffset.
invoke Font "getDefaultFontHeight" returning lsDefFontY
invoke self "getFont" returning lsfontObj
invoke lsFontObj "getId" returning lsFont
call WAPI GetDC using by value 0 size 4
returning lsDC
call WAPI SelectObject using by value lsDC
by value lsFont
returning lsOldFont
call WAPI GetTextMetrics using by value lsDC
by reference lsTextMetric
call WAPI SelectObject using by value lsDC
by value lsOldFont
call WAPI ReleaseDC using by value 0 size 4
by value lsDC
move ws-border to lsMask
call logical "CBL_AND" using dwstyle
lsMask
by value 4
if lsMask = ws-border
move lsdefFontY to lnkOffset
divide 4 into lnkOffset
add tmHeight of lsTextMetric to lnkOffset
else
move tmHeight of lsTextMetric to lnkOffset
end-if
exit method
end method "exgetBaseLineOffset".
/=================================================================
* Einzelobjekt : getClassNameZ
*=================================================================
* Name der Windows-Fensterklasse nullterminiert zurückgeben.
*=================================================================
method-id. "getClassNameZ".
linkage section.
01 xClassName-l pic x(255).
procedure division returning xClassName-l.
move HOTKEY-CLASS & x"00" to xClassName-l
exit method
end method "getClassNameZ".
/=================================================================
* Einzelobjekt : SetHotkey
*=================================================================
* Angegebenen Keycode im Control anzeigen.
*=================================================================
method-id. "SetHotkey".
local-storage section.
01 wKeycode WORD.
01 filler redefines wKeycode.
03 wKeycode-High BYTE.
03 wKeycode-Low BYTE.
01 bHelp BYTE.
linkage section.
01 dwKeycode-l DWORD.
procedure division using dwKeycode-l.
if isCreated
move dwKeycode-l to wKeycode
move wKeycode-High to bHelp
move wKeycode-Low to wKeycode-High
move bHelp to wKeycode-Low
call WAPI SendMessage using by value p2-id
by value HKM-SETHOTKEY
by value wKeycode
by value 0
else
move dwKeycode-l to dwKeycode-o
end-if
exit method
end method "SetHotkey".
/=================================================================
* Einzelobjekt : GetHotkey
*=================================================================
* Aktuellen Keycode zurückliefern.
*=================================================================
method-id. "GetHotkey".
local-storage section.
01 wkKeycode pic 9(4) comp-x.
linkage section.
01 dwKeycode-l DWORD.
procedure division returning dwKeycode-l.
if isCreated
call WAPI SendMessage using by value p2-id
by value HKM-GETHOTKEY
by value 0
by value 0
returning wkKeycode
move wkKeycode to dwKeycode-l
else
move zero to dwKeycode-l
end-if
exit method
end method "GetHotkey".
end object.
end class gxcHotkey.
The documentation I cited says a common cause of this error is the omission of the "type" keyword in an inherit statement.
Your code has an inherit statement ("inherits from gadget with data"). It does not have the "type" keyword.
That suggests it should be:
inherits from type gadget with data.
I don't know whether that's actually the issue. This appears to be native OO COBOL, which I have very little experience with, and which is different from managed OO COBOL in a number of ways.
Here the source file:
*=================================================================
* gxcHKey - Klasse gxcHotkey
*=================================================================
*-----------------------------------------------------------------
* Prototypen, Typedefs und Vocabulary
*-----------------------------------------------------------------
copy "windows.cpy".
/-----------------------------------------------------------------
* gxcHotkey
*-----------------------------------------------------------------
class-id. gxcHotkey data is protected
inherits from gadget with data.
class-control.
Font is class "font"
EventManager is class "p2emgr"
gxcHotkey is class "gxchkey".
copy "callconv.cpy".
/=================================================================
* K l a s s e n o b j e k t
*=================================================================
class-object.
object-storage section.
/=================================================================
* Klassenobjekt : GetXBorderOffSet
*=================================================================
* Returns the offset from the left side of a text entry field to
* the leftmost internal area of the entry field's display.
*=================================================================
method-id. "GetXBorderOffSet".
local-storage section.
01 dwY DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwX-l DWORD.
procedure division returning dwX-l.
invoke Font "getDefaultFontWidthHeight" using dwX-l dwY
add 1 to dwX-l
divide 4 into dwX-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke odesktop "scaleXUp" using dwX-l
exit method.
end method "GetXBorderOffSet".
/=================================================================
* Klassenobjekt : GetYBorderOffSet
*=================================================================
* Returns the offset from the top side of a text entry field to
* the topmost internal area of the entry field's display.
*=================================================================
method-id. "GetYBorderOffSet".
local-storage section.
01 dwX DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwY-l DWORD.
procedure division returning dwY-l.
invoke Font "getDefaultFontWidthHeight" using dwX dwY-l
add 1 to dwY-l
divide 4 into dwY-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke oDesktop "scaleYUp" using dwY-l
exit method.
end method "GetYBorderOffSet".
end class-object.
/=================================================================
* E i n z e l o b j e k t
*=================================================================
Object.
object-storage section.
01 dwKeycode-o DWORD value zero.
/=================================================================
* Einzelobjekt : CreatePanels
*=================================================================
* GUI-Objekt erzeugen.
*=================================================================
method-id. "CreatePanels".
local-storage section.
01 dwX DWORD.
01 dwY DWORD.
procedure division.
if notCreated
invoke super "CreatePanels"
invoke self "SetHotkey" using dwKeycode-o
end-if
exit method.
end method "CreatePanels".
/=================================================================
* Einzelobjekt : setEmpty
*=================================================================
* Inhalt des Controls löschen.
*=================================================================
method-id. "setEmpty".
procedure division.
move zero to dwKeycode-o
invoke self "SetHotkey" using dwKeycode-o
exit method.
end method "setEmpty".
/=================================================================
* Einzelobjekt : exgetBaseLineOffset
*=================================================================
* Return the offset for this control to be baselined.
*=================================================================
method-id. "exgetBaseLineOffset".
copy "winflags.cpy".
local-storage section.
01 lsFont HFONT.
01 lsTextMetric TEXTMETRIC.
01 lsDC HDC.
01 lsOldFont HFONT.
01 lsFontObj usage object reference.
01 lsMask pic x(4) comp-5.
01 lsDefFontY pic x(4) comp-5.
linkage section.
01 lnkOffset pic x(4) comp-5.
procedure division returning lnkOffset.
invoke Font "getDefaultFontHeight" returning lsDefFontY
invoke self "getFont" returning lsfontObj
invoke lsFontObj "getId" returning lsFont
call WAPI GetDC using by value 0 size 4
returning lsDC
call WAPI SelectObject using by value lsDC
by value lsFont
returning lsOldFont
call WAPI GetTextMetrics using by value lsDC
by reference lsTextMetric
call WAPI SelectObject using by value lsDC
by value lsOldFont
call WAPI ReleaseDC using by value 0 size 4
by value lsDC
move ws-border to lsMask
call logical "CBL_AND" using dwstyle
lsMask
by value 4
if lsMask = ws-border
move lsdefFontY to lnkOffset
divide 4 into lnkOffset
add tmHeight of lsTextMetric to lnkOffset
else
move tmHeight of lsTextMetric to lnkOffset
end-if
exit method
end method "exgetBaseLineOffset".
/=================================================================
* Einzelobjekt : getClassNameZ
*=================================================================
* Name der Windows-Fensterklasse nullterminiert zurückgeben.
*=================================================================
method-id. "getClassNameZ".
linkage section.
01 xClassName-l pic x(255).
procedure division returning xClassName-l.
move HOTKEY-CLASS & x"00" to xClassName-l
exit method
end method "getClassNameZ".
/=================================================================
* Einzelobjekt : SetHotkey
*=================================================================
* Angegebenen Keycode im Control anzeigen.
*=================================================================
method-id. "SetHotkey".
local-storage section.
01 wKeycode WORD.
01 filler redefines wKeycode.
03 wKeycode-High BYTE.
03 wKeycode-Low BYTE.
01 bHelp BYTE.
linkage section.
01 dwKeycode-l DWORD.
procedure division using dwKeycode-l.
if isCreated
move dwKeycode-l to wKeycode
move wKeycode-High to bHelp
move wKeycode-Low to wKeycode-High
move bHelp to wKeycode-Low
call WAPI SendMessage using by value p2-id
by value HKM-SETHOTKEY
by value wKeycode
by value 0
else
move dwKeycode-l to dwKeycode-o
end-if
exit method
end method "SetHotkey".
/=================================================================
* Einzelobjekt : GetHotkey
*=================================================================
* Aktuellen Keycode zurückliefern.
*=================================================================
method-id. "GetHotkey".
local-storage section.
01 wkKeycode pic 9(4) comp-x.
linkage section.
01 dwKeycode-l DWORD.
procedure division returning dwKeycode-l.
if isCreated
call WAPI SendMessage using by value p2-id
by value HKM-GETHOTKEY
by value 0
by value 0
returning wkKeycode
move wkKeycode to dwKeycode-l
else
move zero to dwKeycode-l
end-if
exit method
end method "GetHotkey".
end object.
end class gxcHotkey.
*=================================================================
* gxcHKey - Klasse gxcHotkey
*=================================================================
*-----------------------------------------------------------------
* Prototypen, Typedefs und Vocabulary
*-----------------------------------------------------------------
copy "windows.cpy".
/-----------------------------------------------------------------
* gxcHotkey
*-----------------------------------------------------------------
class-id. gxcHotkey data is protected
inherits from gadget with data.
class-control.
Font is class "font"
EventManager is class "p2emgr"
gxcHotkey is class "gxchkey".
copy "callconv.cpy".
/=================================================================
* K l a s s e n o b j e k t
*=================================================================
class-object.
object-storage section.
/=================================================================
* Klassenobjekt : GetXBorderOffSet
*=================================================================
* Returns the offset from the left side of a text entry field to
* the leftmost internal area of the entry field's display.
*=================================================================
method-id. "GetXBorderOffSet".
local-storage section.
01 dwY DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwX-l DWORD.
procedure division returning dwX-l.
invoke Font "getDefaultFontWidthHeight" using dwX-l dwY
add 1 to dwX-l
divide 4 into dwX-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke odesktop "scaleXUp" using dwX-l
exit method.
end method "GetXBorderOffSet".
/=================================================================
* Klassenobjekt : GetYBorderOffSet
*=================================================================
* Returns the offset from the top side of a text entry field to
* the topmost internal area of the entry field's display.
*=================================================================
method-id. "GetYBorderOffSet".
local-storage section.
01 dwX DWORD.
01 oEventManager object reference.
01 oDesktop object reference.
linkage section.
01 dwY-l DWORD.
procedure division returning dwY-l.
invoke Font "getDefaultFontWidthHeight" using dwX dwY-l
add 1 to dwY-l
divide 4 into dwY-l
invoke EventManager "new" returning oEventManager
invoke oEventManager "getDesktop" returning oDesktop
invoke oDesktop "scaleYUp" using dwY-l
exit method.
end method "GetYBorderOffSet".
end class-object.
/=================================================================
* E i n z e l o b j e k t
*=================================================================
Object.
object-storage section.
01 dwKeycode-o DWORD value zero.
/=================================================================
* Einzelobjekt : CreatePanels
*=================================================================
* GUI-Objekt erzeugen.
*=================================================================
method-id. "CreatePanels".
local-storage section.
01 dwX DWORD.
01 dwY DWORD.
procedure division.
if notCreated
invoke super "CreatePanels"
invoke self "SetHotkey" using dwKeycode-o
end-if
exit method.
end method "CreatePanels".
/=================================================================
* Einzelobjekt : setEmpty
*=================================================================
* Inhalt des Controls löschen.
*=================================================================
method-id. "setEmpty".
procedure division.
move zero to dwKeycode-o
invoke self "SetHotkey" using dwKeycode-o
exit method.
end method "setEmpty".
/=================================================================
* Einzelobjekt : exgetBaseLineOffset
*=================================================================
* Return the offset for this control to be baselined.
*=================================================================
method-id. "exgetBaseLineOffset".
copy "winflags.cpy".
local-storage section.
01 lsFont HFONT.
01 lsTextMetric TEXTMETRIC.
01 lsDC HDC.
01 lsOldFont HFONT.
01 lsFontObj usage object reference.
01 lsMask pic x(4) comp-5.
01 lsDefFontY pic x(4) comp-5.
linkage section.
01 lnkOffset pic x(4) comp-5.
procedure division returning lnkOffset.
invoke Font "getDefaultFontHeight" returning lsDefFontY
invoke self "getFont" returning lsfontObj
invoke lsFontObj "getId" returning lsFont
call WAPI GetDC using by value 0 size 4
returning lsDC
call WAPI SelectObject using by value lsDC
by value lsFont
returning lsOldFont
call WAPI GetTextMetrics using by value lsDC
by reference lsTextMetric
call WAPI SelectObject using by value lsDC
by value lsOldFont
call WAPI ReleaseDC using by value 0 size 4
by value lsDC
move ws-border to lsMask
call logical "CBL_AND" using dwstyle
lsMask
by value 4
if lsMask = ws-border
move lsdefFontY to lnkOffset
divide 4 into lnkOffset
add tmHeight of lsTextMetric to lnkOffset
else
move tmHeight of lsTextMetric to lnkOffset
end-if
exit method
end method "exgetBaseLineOffset".
/=================================================================
* Einzelobjekt : getClassNameZ
*=================================================================
* Name der Windows-Fensterklasse nullterminiert zurückgeben.
*=================================================================
method-id. "getClassNameZ".
linkage section.
01 xClassName-l pic x(255).
procedure division returning xClassName-l.
move HOTKEY-CLASS & x"00" to xClassName-l
exit method
end method "getClassNameZ".
/=================================================================
* Einzelobjekt : SetHotkey
*=================================================================
* Angegebenen Keycode im Control anzeigen.
*=================================================================
method-id. "SetHotkey".
local-storage section.
01 wKeycode WORD.
01 filler redefines wKeycode.
03 wKeycode-High BYTE.
03 wKeycode-Low BYTE.
01 bHelp BYTE.
linkage section.
01 dwKeycode-l DWORD.
procedure division using dwKeycode-l.
if isCreated
move dwKeycode-l to wKeycode
move wKeycode-High to bHelp
move wKeycode-Low to wKeycode-High
move bHelp to wKeycode-Low
call WAPI SendMessage using by value p2-id
by value HKM-SETHOTKEY
by value wKeycode
by value 0
else
move dwKeycode-l to dwKeycode-o
end-if
exit method
end method "SetHotkey".
/=================================================================
* Einzelobjekt : GetHotkey
*=================================================================
* Aktuellen Keycode zurückliefern.
*=================================================================
method-id. "GetHotkey".
local-storage section.
01 wkKeycode pic 9(4) comp-x.
linkage section.
01 dwKeycode-l DWORD.
procedure division returning dwKeycode-l.
if isCreated
call WAPI SendMessage using by value p2-id
by value HKM-GETHOTKEY
by value 0
by value 0
returning wkKeycode
move wkKeycode to dwKeycode-l
else
move zero to dwKeycode-l
end-if
exit method
end method "GetHotkey".
end object.
end class gxcHotkey.
greiner,
You need to add
gadget is class "gadget"
to the class-control
Gael
Sign up
Already have an account? Login
Welcome to the Rocket Forum!
Please log in or register:
Employee Login | Registration Member Login | RegistrationEnter your E-mail address. We'll send you an e-mail with instructions to reset your password.
77 4th Avenue
Waltham, MA 02451 USA
