* Program..: XbpGet.prg * Author...: Jeremy Suiter * Date.....: 19/03/2003 * * Notice...: Copyright (c) 2003, Jeremy Suiter, All Rights Reserved * Notes....: Visual DbEditor get functions (modified from ATSAG samples) #include "Appevent.ch" #include "Common.ch" #include "Gra.ch" #include "Xbp.ch" #include "Font.ch" /* * InvisibleGet service class * */ CLASS InvisibleGet FROM Get EXPORTED: METHOD init METHOD display ENDCLASS METHOD InvisibleGet:Init(nRow, nCol, bVarBlock, cVarName, cPicture, cColor, bValid, bWhen) cColor := cColor; nRow := nRow; nCol := nCol Return ::Sle:Init(bVarBlock, cVarName, cPicture, bValid, bWhen) METHOD InvisibleGet:display() Return Self /* * XbpGet class */ CLASS XbpGet FROM XbpSLE PROTECTED: CLASS VAR oContextMenu SHARED // Popup menu for XbpGet objects CLASS METHOD enableMenuItems VAR Get // The embedded invisible service GET VAR original // The original value before editing EXPORTED: CLASS METHOD initClass VAR value // The current value during editing ** creation flags VAR Picture // The picture mask VAR preBlock // Code blocks for pre- and VAR postBlock // postvalidation VAR controller // The XbpGetController object ** overloaded from XbpSle METHOD Init, Create // Lifecycle METHOD Clear // Clear edit buffer METHOD Keyboard // Overloaded keyboard handling METHOD LbUp // inquire mark METHOD RbDown // focus change or context menu display METHOD RbUp // Display context menu METHOD CutMarked // Methods for Copy, Delete, Insert METHOD PasteMarked // operations METHOD DeleteMarked // METHOD itemSelected // context menu selection ** Overloaded from DataRef METHOD SetData, GetData // Overloaded SetData, GetData METHOD Undo // Overloaded Undo to Get METHOD SetEditBuffer // Change edit buffer METHOD home // Set position in Get and XbpSle ** Focus change methods METHOD setInputFocus // Input focus is obtained METHOD killInputFocus // Input focus is lost METHOD preValidate // Validation before input focus is obtained METHOD postValidate // Validation before input focus is lost METHOD badDate // Overloaded Date validation ACCESS ASSIGN METHOD picture ENDCLASS /* * Create the context menu for XbpGet objects */ CLASS METHOD XbpGet:InitClass ::oContextMenu:=XbpMenu():new(AppDesktop()):create() ::oContextMenu:title:="XbpGet Popup" ::oContextMenu:addItem({ "~Validate" , }) ::oContextMenu:addItem({ "~Undo" , }) ::oContextMenu:addItem({NIL, NIL , XBPMENUBAR_MIS_SEPARATOR, 0}) ::oContextMenu:addItem({ "Cu~t" , }) ::oContextMenu:addItem({ "~Copy" , }) ::oContextMenu:addItem({ "~Paste" , }) ::oContextMenu:addItem({ "~Delete" , }) ::oContextMenu:addItem({NIL, NIL , XBPMENUBAR_MIS_SEPARATOR, 0}) ::oContextMenu:addItem({ "Select ~All" , }) #define MENU_ITEM_VALIDATE 1 #define MENU_ITEM_UNDO 2 #define MENU_ITEM_CUT 4 #define MENU_ITEM_COPY 5 #define MENU_ITEM_PASTE 6 #define MENU_ITEM_DELETE 7 #define MENU_ITEM_SELECTALL 9 Return Self /* * Enable all applicable menu items */ CLASS METHOD XbpGet:enableMenuItems(oXbpGet) LOCAL i, imax:=::oContextMenu:numItems() LOCAL xTemp FOR i:=1 TO imax ::oContextMenu:enableItem(i) NEXT If oXbpGet:postBlock == NIL If oXbpGet:Get:type<>"D" ::oContextMenu:disableItem(MENU_ITEM_VALIDATE) EndIf EndIf If .NOT. oXbpGet:changed ::oContextMenu:disableItem(MENU_ITEM_UNDO) EndIf xTemp:=oXbpGet:queryMarked() If xTemp[1] == xTemp[2] ::oContextMenu:disableItem(MENU_ITEM_CUT) ::oContextMenu:disableItem(MENU_ITEM_COPY) ::oContextMenu:disableItem(MENU_ITEM_DELETE) EndIf If Abs(xTemp[1] - xTemp[2]) == Len(oXbpGet:editBuffer()) ::oContextMenu:disableItem(MENU_ITEM_SELECTALL) EndIf xTemp:=XbpClipboard():New():Create() xTemp:open() If xTemp:getBuffer(XBPCLPBRD_TEXT) == NIL ::oContextMenu:disableItem(MENU_ITEM_PASTE) EndIf xTemp:close() xTemp:destroy() Return Self /* * Initialize the object */ METHOD XbpGet:Init(oParent, oOwner, aPos, aSize, aPP, lVisible) ::XbpSle:init(oParent, oOwner, aPos, aSize, aPP, lVisible) ::tabStop:=.T. Return Self /* * Create method */ METHOD XbpGet:Create(oParent, oOwner, aPos, aSize, aPP, lVisible) LOCAL bBlock:={|x| IIf(x==NIL, ::value, ::value:=x) } /* * ::dataLink code block must be defined already */ ::value :=; ::original:=Eval(::dataLink) /* * now initialize the text mode get object as picture server */ ::Get:=InvisibleGet():New(,, bBlock, "", ::picture) ::Get:setFocus() ::BufferLength:=Len(::Get:buffer) ::Get:killFocus() ::Get:reset() /* * create the GUI SLE */ ::XbpSle:Create(oParent, oOwner, aPos, aSize, aPP, lVisible) Return Self /* * This method accepts data of type C,D,L,N and transfers a Picture * formatted string to the edit buffer of the XbpSLE. */ METHOD XbpGet:SetData(xData) LOCAL cBuffer If PCount() == 1 ::value:=xData Else ::value:=Eval(::dataLink) EndIf ::original:=::value ::changed:=.F. cBuffer :=Transform (::value, IIf(::Get:Picture==NIL, "", ::Get:picture)) /* * update the buffer of the XbpSLE */ ::SetEditBuffer(cBuffer) /* * update the buffer of the picture server Get */ If ::Get:hasFocus ::Get:UpdateBuffer() /* * XbpGet has focus, set the initial mark */ If Set(_SET_INSERT) ::SetMarked ({ ::Get:Pos, ::Get:Pos }) Else ::SetMarked ({ ::Get:Pos, ::Get:Pos + 1 }) EndIf EndIf Return Self /* * The method Returns the edited value and passes * it to the :dataLink code block. */ METHOD XbpGet:GetData(lSetOriginal) DEFAULT lSetOriginal TO .T. If ::Get:hasFocus ::Get:assign() ::Get:pos:=::queryMarked()[1] EndIf ::value:=Eval(::DataLink, ::value) If lSetOriginal ::original:=::value ::changed:=.F. EndIf Return ::value /* * Undo changes made in the edit buffer. */ METHOD XbpGet:Undo() LOCAL cBuffer ::value :=::original ::changed:=.F. If ::Get:hasFocus ::Get:Reset() cBuffer:=::Get:buffer Else cBuffer:=Transform (::value, IIf(::Get:Picture==NIL, "", ::Get:picture)) EndIf Return ::SetEditBuffer(cBuffer) /* * Change the edit buffer of the XbpSle. */ METHOD XbpGet:SetEditBuffer(cBuffer) ::XbpSle:SetData(cBuffer) Return Self /* * Clears the edit buffer. */ METHOD XbpGet:clear ::get:clear:=.T. ::xbpSle:clear() Return .T. /* * Move the caret to the first editable character in the edit buffer. */ METHOD XbpGet:home LOCAL aMarked, lClear:=::get:clear If ::Get:hasFocus ::get:home() Else ::Get:pos:=1 EndIf ::get:clear:=lClear ::XbpSle:setFirstChar(::get:pos) If Set(_SET_INSERT) aMarked:={ ::Get:Pos, ::Get:Pos } Else aMarked:={ ::Get:Pos, ::Get:Pos + 1 } EndIf ::SetMarked(aMarked) Return Self /* * XbpGet obtains input focus. A prevalidation is performed by the * Controller object. If the prevalidation fails, the Controller object * sets focus to the next XbpGet. */ METHOD XbpGet:setInputFocus If ::controller:preValidate(Self) /* * The Controller object checks wether or not Self * may obtain input focus (it calls Self:preValidate()). */ ::get:setFocus() ::xbpSLE:setInputFocus() ::get:buffer:=::editBuffer() If ::controller:setHome ::home() ::controller:setHome:=.F. Else ::Get:pos:=::QueryMarked()[1] EndIf EndIf ::changed:=.NOT. (::original == ::value) Return Self /* * XbpGet looses input focus. A postvalidation is performed by the * Controller object. If the postvalidation fails, the focus remains * with the XbpGet. */ METHOD XbpGet:killInputFocus If ::postValidate(Self) /* * The Controller object checks wether or not Self * may loose input focus (it calls Self:postValidate()). */ If ::Get:hasFocus If ::Get:Type == "N" ::Get:ToDecPos() ::SetEditBuffer(Trim(::Get:Buffer)) EndIf ::Get:killFocus() EndIf ::xbpSLE:killInputFocus() Else /* * Postvalidation failed. Mark all characters in the edit buffer. */ ::home() ::setMarked({1, Len(::editBuffer())+1 }) EndIf Return Self /* * Overloaded Keyboard handling. Marking is performed by the XbpSLE. * Cursor movement is taken from the invisible Get because it knows * how to navigate in a Picture formatted string. */ METHOD XbpGet:Keyboard(nKey) LOCAL aMarked, cChar LOCAL lSetPos:=.T., lHandled:=.T. aMarked:=::QueryMarked() DO CASE CASE .NOT. ::get:hasFocus /* * Delegate keyboard events to the Controller object If XbpGet * does not have focus (this can happen after a failed validation). */ ::controller:keyboard(nKey) Return Self CASE nKey == xbeK_SH_RIGHT aMarked[2]:=Min(aMarked[2] + 1, ::Bufferlength + 1) If .NOT. Set(_SET_INSERT) .And. aMarked[1]==aMarked[2] aMarked[1] -- aMarked[2]:=Min(aMarked[2] + 1, ::Bufferlength + 1) EndIf ::XbpSle:setMarked(aMarked) If aMarked[2] < aMarked[1] /* * The caret is on the left side of the mark */ ::Get:pos:=aMarked[2] Else ::Get:pos:=aMarked[2] - 1 EndIf lSetPos:=.F. CASE nKey == xbeK_SH_LEFT aMarked[2]:=Max(aMarked[2] - 1, 1) If .NOT. Set(_SET_INSERT) .And. aMarked[1]==aMarked[2] aMarked[1] ++ aMarked[2]:=Max(aMarked[2] - 1, 1) EndIf ::XbpSle:setMarked(aMarked) If aMarked[2] < aMarked[1] /* * The caret is on the left side of the mark */ ::Get:pos:=aMarked[2] Else ::Get:pos:=aMarked[2] - 1 EndIf lSetPos :=.F. CASE nKey == xbeK_SH_END If ::Get:Type == "N" ::Get:ToDecPos() ::Get:_End() EndIf aMarked[2]:=::Bufferlength + 1 ::Get:Pos:=::Bufferlength lSetPos :=.F. ::setMarked(aMarked) CASE nKey == xbeK_SH_HOME If aMarked[2]-aMarked[1] == 1 aMarked[1]:=aMarked[2] EndIf ::home() aMarked[2]:=::Get:Pos lSetPos :=.F. ::SetMarked(aMarked) CASE nKey == xbeK_CTRL_U ::Undo() CASE nKey == xbeK_CTRL_LEFT /* * In overstrike mode, the caret is on the right side of the marked * character. Set the caret to the left side before the XbpSLE * handles the key. */ ::setMarked({ ::Get:pos, ::Get:pos }) ::XbpSle:Keyboard(nKey) ::Get:pos:=::querymarked()[2] CASE nKey == xbeK_CTRL_RIGHT ::XbpSle:Keyboard(nKey) ::Get:pos:=::querymarked()[2] CASE nKey == xbeK_LEFT If aMarked[2] > aMarked[1] ::Get:Pos:=Min(::get:pos, aMarked[1]) EndIf ::Get:Left() CASE nKey == xbeK_RIGHT If aMarked[1] > aMarked[2] ::Get:Pos:=Max(::get:pos, aMarked[1] - 1) EndIf ::Get:Right() If ::get:typeOut .And. ::get:type<>"L" ::get:Pos ++ EndIf CASE nKey == xbeK_HOME ::Home() CASE nKey == xbeK_END If ::Get:Type == "N" ::Get:ToDecPos() EndIf ::Get:_End() ::XbpSle:SetFirstChar(Len(::Get:Buffer)) If Set(_SET_INSERT) /* * We're behind the last character */ ::Get:Pos ++ EndIf CASE nKey == xbeK_INS Set(_SET_INSERT, ! Set(_SET_INSERT)) CASE nKey == xbeK_CTRL_INS ::CopyMarked() lSetPos:=.F. CASE .NOT. ::editable /* * XbpGet is Read only. No other editing keys are processed. * Check If there is a navigation key pressed */ lHandled:=::controller:keyboard(nKey) CASE nKey == xbeK_SH_INS ::PasteMarked() CASE nKey == xbeK_BS ::Get:BackSpace() CASE nKey == xbeK_DEL If Set(_SET_INSERT) .And. aMarked[1] == aMarked[2] aMarked[2]:=aMarked[1] + 1 ::SetMarked(aMarked) EndIf ::DeleteMarked() CASE nKey == xbeK_SH_DEL ::CutMarked() CASE nKey == xbeK_CTRL_T ::Get:DelWordRight() CASE nKey == xbeK_CTRL_Y ::Get:DelEnd() CASE nKey == xbeK_CTRL_BS ::Get:DelWordLeft() CASE nKey >= 32 .And. nKey <= 255 cChar:=Chr(nKey) If ::Get:Type == "N" .And. cChar $ ".," ::Get:CondClear() ::Get:ToDecPos() Else If Set(_SET_INSERT) If Abs(aMarked[2]-aMarked[1]) > 0 ::deleteMarked() EndIf ::Get:Insert(cChar) Else If Abs(aMarked[2]-aMarked[1]) > 1 ::deleteMarked() ::Get:Insert(cChar) Else ::Get:Overstrike(cChar) EndIf EndIf If ::Get:typeOut .And. ::get:type<>"L" ::Get:pos ++ EndIf EndIf OTHERWISE /* * Check If a key is pressed that navigates between XbpGets */ lHandled:=::controller:keyboard(nKey) ENDCASE If ! ::EditBuffer() == ::Get:Buffer If ::Get:Type == "N" ::SetEditBuffer(Trim(::Get:Buffer)) Else ::SetEditBuffer(::Get:Buffer) EndIf /* * assign internal ::value */ ::Get:assign() ::changed:=.NOT. (::original == ::value) EndIf If lSetPos If Set(_SET_INSERT) aMarked:={ ::Get:Pos, ::Get:Pos } Else aMarked:={ ::Get:Pos, ::Get:Pos+1 } EndIf ::SetMarked(aMarked) EndIf If ! lHandled Return ::XbpSle:Keyboard(nKey) EndIf Return Self /* * Overloaded LbUp() method. When the left mouse button is released, * the position of the caret must be determined. */ METHOD XbpGet:LbUp(mp1, mp2) LOCAL aMarked If ::get:type == "L" ::XbpSle:LbUp(mp1, mp2) Return ::home() EndIf /* * Tell the server Get where the cursor is */ aMarked :=::queryMarked() ::Get:Pos:=aMarked[1] If aMarked[2] - aMarked[1] == 0 .And. ! Set(_SET_INSERT) /* * Mark the current character when overstrike mode is active */ ::SetMarked({ aMarked[1], aMarked[1]+1 }) EndIf Return ::XbpSle:LbUp(mp1, mp2) /* * Overloaded :rbDown() method. When the right button is pressed, an XbpGet * must gain input focus. This triggers the post validation for the XbpGet * that currently has focus. */ METHOD XbpGet:rbDown(mp1, mp2) If .NOT. ::hasInputFocus() SetAppFocus(Self) Else ::XbpSle:rbDown(mp1, mp2) EndIf Return Self /* * Overloaded :rbDown() method. When the right button is pressed, an XbpGet * must gain input focus. This triggers the post validation for the XbpGet * that currently has focus. */ METHOD XbpGet:rbUp(mp1) If ::hasInputFocus() ::enableMenuItems(Self) ::oContextMenu:itemSelected:={|nItem| ::itemSelected(nItem) } ::oContextMenu:popUp(Self, mp1) EndIf Return Self /* * Overloaded :cutMarked() method. Copy the marked characters to the * clipboard and delete them from the edit buffer. */ METHOD XbpGet:CutMarked() ::CopyMarked() ::DeleteMarked() Return Self /* * Overloaded :PasteMarked() method. Insert the clipboard contents * into the edit buffer. */ METHOD XbpGet:PasteMarked() LOCAL aMarked:=::QueryMarked() LOCAL cString, oClipboard, i, nPaste, cChar /* * Get clipboard contents */ oClipboard:=XbpClipboard():New():Create() oClipboard:open() cString:=oClipboard:getBuffer(XBPCLPBRD_TEXT) oClipboard:close() oClipboard:destroy() /* * Do not paste when the clipboard does not contain a valid string. */ If cString == NIL Tone(1000) Return Self EndIf /* * delete the marked string and * insert the current contents of the clipboard */ ::deleteMarked() ::Get:Pos:=Min(aMarked[1], aMarked[2]) If Abs(aMarked[2] - aMarked[1]) <= 1 nPaste:=Len(cString) Else nPaste:=Min(Len(cString), Abs(aMarked[2] - aMarked[1])) EndIf FOR i:=1 TO nPaste If i <= Len(cString) cChar:=SubStr(cString, i, 1) Else cChar:=" " EndIf ::Get:Insert(cChar) NEXT If Set(_SET_INSERT) .And. Max(aMarked[1], aMarked[2]) + nPaste > ::bufferLength /* * Edit buffer is full. Set the Get cursor behind the last character. */ ::get:pos:=::bufferLength + 1 EndIf Return Self /* * Overloaded :deleteMarked() method */ METHOD XbpGet:DeleteMarked() LOCAL aMarked:=::QueryMarked(), i LOCAL nMarked:=Abs(aMarked[2] - aMarked[1]) If nMarked == 0 /* * We're in insert mode and nothing is marked -> delete nothing. */ ElseIf nMarked == 1 ::Get:Delete() Else ::Get:Pos:=Max(aMarked[1], aMarked[2]) FOR i:=1 TO nMarked ::Get:BackSpace() NEXT EndIf Return Self /* * Selection in context menu */ METHOD XbpGet:itemSelected(nItem) DO CASE CASE nItem == MENU_ITEM_VALIDATE If .NOT. ::postValidate() MsgBox("Illegal data") SetAppFocus(Self) EndIf CASE nItem == MENU_ITEM_UNDO ; ::undo() CASE nItem == MENU_ITEM_CUT ; ::cutMarked() CASE nItem == MENU_ITEM_COPY ; ::copyMarked() CASE nItem == MENU_ITEM_PASTE ; ::pasteMarked() CASE nItem == MENU_ITEM_DELETE ; ::deleteMarked() CASE nItem == MENU_ITEM_SELECTALL ; ::setMarked({1, Len(::editBuffer())+1 }) ENDCASE If ! ::EditBuffer() == ::Get:Buffer If ::Get:Type == "N" ::SetEditBuffer(Trim(::Get:Buffer)) Else ::SetEditBuffer(::Get:Buffer) EndIf /* * assign internal ::value */ ::Get:assign() ::changed:=.NOT. (::original == ::value) EndIf Return Self /* * Picture mask is changed. Tell it to the service Get. */ METHOD XbpGet:picture(cPict) If Valtype(cPict) == "C" ::picture:=cPict If ::Get<>NIL ::Get:picture:=cPict ::Get:reset() EndIf EndIf Return ::picture /* * Perform a postvalidation. */ METHOD XbpGet:postValidate LOCAL lValid:=.T. If ::badDate() ::undo() Return .F. EndIf /* * Assign value to edited variable to assure a proper * postvalidation context, but keep the original value. * Passing .F. assures that an :undo() is possible during * editing for all XbpGets contained in a dialog window, even if * focus changes (dialog wide :undo()) */ ::getData(.F.) If Valtype(::postBlock) == "B" lValid:=Eval(::postBlock, Self) EndIf Return lValid /* * Perform a prevalidation. */ METHOD XbpGet:preValidate LOCAL lValid:=.T. If Valtype(::preBlock) == "B" lValid:=Eval(::preBlock, Self) EndIf Return lValid /* * Validate a date value. */ METHOD XbpGet:badDate If ::Get:type<>"D" Return .F. ElseIf ::Get:hasFocus /* * When an illegal date is entered * - Get:badDate() is .T. during editing * - Get:buffer is set to " / / " due to :undo() in :postValidate() * - After postvalidation we have ::Get:buffer<>::editBuffer() == .T. */ Return ::Get:badDate() .Or. ::Get:buffer<>::editBuffer() EndIf /* * An empty date is valid */ Return IIf(.NOT. (::original == ::value), Empty(::value), .F.)