#include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Font.ch" #include "Nls.ch" #include "Dmlb.ch" #include "Dbstruct.ch" #pragma library ("Xppui2.lib") #pragma library ("odbcut10.lib") #pragma library( "ADAC20B.LIB" ) /* * Including odbcdbe.ch includes requests to ODBCUTIL.LIB. * Please see odbcdbe.ch for details. */ #include "odbcdbe.ch" #define CRLF chr(13)+chr(10) PROCEDURE AppSys() RETURN PROCEDURE MAIN * doenne: hauptmenu-bestattungen LOCAL nEvent:=0, mp1:=0, mp2:=0, oParent LOCAL oXbp, oListBox, oTxt, oDlg LOCAL aTables, n LOCAL oSession LOCAL cDbsName LOCAL bErr LOCAL lExit /////////////////// IF Len(DbeList()) < 6 // DbeBuild( "SDFNTX", "SDFDBE", "NTXDBE" ) // DbeSetDefault( "SDFNTX" ) // DbeInfo( COMPONENT_DATA , DBE_EXTENSION, "TAK" ) // DbeInfo( COMPONENT_ORDER, DBE_EXTENSION, "XAK" ) // DbeSetDefault( "DBFNTX" ) // DbeInfo( COMPONENT_ORDER, DBE_EXTENSION, "NTX" ) DbeLoad( "ODBCDBE" ) DbeSetDefault( "ODBCDBE" ) ENDIF //////////////////// //DO DecPublic // ="EUROV" //DO ineux //** bei sql geREMt set bell off set confirm off set delete on ***set default to c set safety off set talk off //IF cLon = "N" // set exclusive OFF // KUELLx ist eine Netzwerk-Version (seit Oktober 2002!!) //ELSE // set exclusive ON // Doennex ist keine Netzwerk-Version //ENDIF SET EPOCH TO (Year(date())-98) set date format to "dd.mm.yyyy" set century on cTitle := "MS-SQL Server Northwind browser" oDlg := XbpDialog():new(AppDesktop() ,,{300,300}, {10,50},, .F. ) oDlg:icon := 1 oDlg:taskList := .T. oDlg:title := cTitle oDlg:drawingArea:ClipChildren := .T. oDlg:create() oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL ) oDlg:show() oDlg:close := {|u1,u2,self| lExit := .T.} oParent := oDlg:drawingArea DbeInfo(COMPONENT_DICTIONARY, ODBCDBE_PROMPT_MODE, ODBC_PROMPT_COMPLETE) DbeInfo(COMPONENT_DICTIONARY, ODBCDBE_WIN_HANDLE, oDlg:getHwnd()) oSession := dacSession():New("DBE=ODBCDBE") oSession:setProperty(ODBCSSN_INDEX_AUTOOPEN) DO DecPublic // ="EUROV" select 1 use best //INDEX xauftrnr // SET INDEX TO xauftrnr,xname,xanspnam,xstrasse select 2 use vv //index xvvauf select 3 use auftr //index xaufauf // select 4 // use arb index xarbauf select 5 use vers //index xverskz select 6 use art //index xart_lei select 7 use lzu //index xlzu SELECT 1 bestp( "Bestattungs-Verwaltungs-Regie - Bestattungen A.A.A. - A.-Stadt" ) RETURN *** *** *** //================================================================================== PROCEDURE DecPublic *********** PUBLIC NurWindows PUBLIC upfehl PUBLIC vnetz public schalt public vara upfehl=0 schalt=" " vara=".F." DO eurov cFirma := "Bestattungen A.A.A. - A.-Stadt" RETURN //=========================== //========================================================================================== *dbupges *GESamtes UnterProgramm fr DatenBanken im Netz *zum Ausfhren von USE, Recordlock, Recorddelete, Append FUNCTION Satzdelete upfehl:=0 If rlock() dbdelete() else dbdelete() endif RETURN upfehl FUNCTION Satzrecall upfehl:=0 If rlock() dbrecall() else dbrecall() endif RETURN upfehl * dbupro Unterprog Datenbanken lesen und Verarbeiten *set procedure to dbupro //procedure dbupro //parameters dat,ind,upfehl,schalt,upfunk //if vnetz = 'J' && netz j,n ************************************************************************ //*FUNCTION DBaufmachen(cDat, cInd, cSchalt) //*dat:=cDat ; ind:=cInd ; schalt:=cSchalt FUNCTION DBaufmachen parameters dat,ind,schalt // if upfunk = 1 && 1 = use,2=Satzsperren,3=append if Schalt = 'E' && E= exclusive (z.B. bei reorg wenn upfunk=1) stor .T. to vara else stor .F. to vara endif stor 0 to upfehl stor '1' to schleife do while schleife = '1' if net_use("&dat",vara,.5) if ind # NIL set index to &ind endif stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Weitermachen?", ; "Datensatz ist schon gesperrt", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Die Datenbank wird zur Zeit von einem anderen Benutzer" @ 6,10 say "des Netzwerkes ge„ndert." @ 7,10 say "Die Benutzung ist daher zur Zeit nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datenbankname = " + dat SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif **--> clear stor 0 to upfehl restore screen endif enddo // endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ********************************************************************* FUNCTION Satzsperren // if upfunk = 2 && 2 = Satzsperren stor 0 to upfehl stor '1' to schleife do while schleife = '1' if REC_LOCK(.5) stor 0 to upfehl stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Weitermachen?", ; "Datensatz ist schon gesperrt", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Der angeforderte Datensatz wird zur Zeit " @ 6,10 say "von einem anderen Benutzer des Netzwerkes ge„ndert." @ 7,10 say "Die Benutzung ist daher z. Zt. fr Sie nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datensatz = " + str(recno()) SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif *--> clear stor 0 to upfehl restore screen endif enddo // endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ************************************************************************ FUNCTION Satzentsperren Dbunlock() RETURN (.T.) ************************************************************************ FUNCTION Satzappend // if upfunk = 3 && 3 = einfgen stor 0 to upfehl stor '1' to schleife do while schleife = '1' if ADD_REC(.5) stor 0 to upfehl stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Weitermachen?", ; "Datensatz ist schon gesperrt", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Der angeforderte Datensatz wird zur Zeit " @ 6,10 say "von einem anderen Benutzer des Netzwerkes eingefgt." @ 7,10 say "Eine Einfgung ist daher z. Zt. fr Sie nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datensatz = " + str(recno()) SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif *--> clear stor 0 to upfehl restore screen endif enddo // endif //endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ****--------------------------------- FUNCTION Net_use PARAMETERS file, ex_use, wait PRIVATE forever forever = (wait = 0) DO WHILE (forever .OR. wait > 0) IF ex_use && exclusive dbUseArea(,, file,,.F.) ELSE dbUseArea(,, file ) && shared ENDIF IF .NOT. NETERR() && USE succeeds RETURN (.T.) ENDIF INKEY(1) && wait 1 second wait = wait - 1 ENDDO RETURN (.F.) && USE fails *****------------------ FUNCTION REC_LOCK PARAMETERS wait PRIVATE forever IF RLOCK() RETURN (.T.) && locked ENDIF forever = (wait = 0) DO WHILE (forever .OR. wait > 0) IF RLOCK() RETURN (.T.) && locked ENDIF INKEY(.5) && wait 1/2 second wait = wait - .5 ENDDO RETURN (.F.) && not locked * End - REC_LOCK ******--------------------------------- * ADD_REC function * * Returns true if record appended. The new record is current * and locked. * Pass the following parameter * 1. Numeric - seconds to wait (0 = wait forever) * FUNCTION ADD_REC PARAMETERS wait PRIVATE forever DBAPPEND() IF .NOT. NETERR() RETURN (.T.) ENDIF forever = (wait = 0) DO WHILE (forever .OR. wait > 0) DBAPPEND() IF .NOT. NETERR() RETURN .T. ENDIF INKEY(.5) && wait 1/2 second wait = wait - .5 ENDDO RETURN (.F.) && not locked //------------------------------------------------------------------------- FUNCTION __SETFUNCTION( nFKey, cString ) nFKey := IIf( nFKey==1, 28, 1-nFKey ) RETURN SetKey( nFKey, { || _Keyboard( cString ) } ) //------------------------------------------------------------------------- //////FUNCTION BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// nChoice, cBoxChars, cMenuColor ) ////// ////// LOCAL i ////// LOCAL nMenuRow ////// LOCAL nMenuCol ////// LOCAL cOldColor ////// LOCAL nLength := 0 ////// LOCAL lArrNotChar := .F. ////// ////// // Wird kein Array bergeben, oder ist Array zu groá fr Bildschirm , ////// // dann NIL zurckgeben. ////// IF aMenuItems == NIL .OR. LEN( aMenuItems ) > ( MAXROW() - 3 ) ////// RETURN ( NIL ) // *NOTE* ////// ENDIF ////// ////// // šberprfung eines optionalen Startelementes (nChoice) ////// nChoice := IF( nChoice == NIL, 1, nChoice ) ////// ////// // Suchen des l„ngsten Arrayelementes fr das Menuprompt ////// // und šberprfung des Datentypes des Arrays ////// ASCAN( aMenuItems, { |str| nLength := MAX( nLength, LEN( str ) ), ; ////// lArrNotChar := ( VALTYPE( str ) <> "C" ) } ) ////// ////// // Rckgabe von NIL, wenn ein Element nicht vom Datentyp Character ist ////// IF lArrNotChar ////// RETURN ( NIL ) ////// ENDIF ////// ////// // Initialisierung der 4 Eck-Koordinaten ////// nTop := IF( nTop == NIL, 0, nTop ) ////// nLeft := IF( nLeft == NIL, 0, nLeft ) ////// ////// nBottom := MIN( MAX( nTop + LEN( aMenuItems ) + 2,; ////// IF( nBottom == NIL, MAXROW(), nBottom ) ), MAXROW() ) ////// ////// nRight := MIN( MAX( nLeft + nLength + 3, ; ////// IF( nRight == NIL, MAXCOL(), nRight ) ), MAXCOL() ) ////// ////// // šberprfen ob Rahmen-Zeichen und Farbeinstellungen bergeben wurden ////// cBoxChars := IF( cBoxChars == NIL, "ÉÍ»º¼ÍȺ", cBoxChars ) ////// cMenuColor := IF( cMenuColor == NIL, SETCOLOR(), cMenuColor ) ////// ////// // Sichern der alten Farbeinstellung und setzen der neuen Farbe ////// cOldColor := SETCOLOR( cMenuColor ) ////// ////// // Zeichnen der Box ////// @ nTop, nLeft CLEAR TO nBottom, nRight ////// @ nTop, nLeft, nBottom, nRight BOX cBoxChars ////// ////// //** MenuTitel zentriert (ak): ////// IF cMenuTitle != NIL ////// @ nTop, nLeft + int((nRight-nLeft-len(cMenuTitle))/2) SAY "[" + cMenuTitle + "]" ////// ENDIF ////// ////// // Zeichnen des Schattens ////// BoxShadow( nTop, nLeft, nBottom, nRight ) ////// ////// // Ermitteln der Zeile und Spalte fr das erste Menuprompt ////// // damit das Menu zentriert wird ////// nMenuRow := nTop + INT( (( nBottom - nTop ) - LEN( aMenuItems )) / 2 ) + 1 ////// nMenuCol := nLeft + INT( (( nRight - nLeft ) - nLength ) / 2 ) + 1 ////// ////// // Aktivieren des Menus ////// FOR i := 1 TO LEN( aMenuItems ) ////// @ nMenuRow++, nMenuCol ; ////// PROMPT LEFT( aMenuItems[i] + SPACE(nLength), nLength ) ////// NEXT //////// @22,30 say nChoice ////// MENU TO nChoice //////// @22,10 say nChoice ////// ////// // Alte Farbeinstellung wiederherstellen ////// SETCOLOR( cOldColor ) ////// ////// RETURN nChoice ////// ////// ////// ///////*** //////* //////* BoxShadow( , , , ) --> NIL //////* //////* Zeichnet eine Schattenbox //////* //////*/ //////FUNCTION BoxShadow( nTop, nLeft, nBottom, nRight ) ////// ////// LOCAL nShadTop ////// LOCAL nShadLeft ////// LOCAL nShadBottom ////// LOCAL nShadRight ////// ////// nShadTop := nShadBottom := MIN( nBottom + 1, MAXROW() ) ////// nShadLeft := nLeft + 1 ////// nShadRight := MIN( nRight + 1, MAXCOL() ) ////// ////// // Der Eindruck eines Schattens wird durch das Ersetzen des aktuellen ////// // Farbattributs durch "" ( CHR(7), Grau auf Schwarz ) entlang dem ////// // rechten und unterem Rand der Box erzeugt. ////// RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight, ; ////// TRANSFORM( SAVESCREEN(nShadTop, nShadLeft, nShadBottom, nShadRight), ; ////// REPLICATE("X", nShadRight - nShadLeft + 1 ) ) ) ////// ////// nShadTop := nTop + 1 ////// nShadLeft := nShadRight := MIN( nRight + 1, MAXCOL() ) ////// nShadBottom := nBottom ////// ////// RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight, ; ////// TRANSFORM( SAVESCREEN(nShadTop, nShadLeft, nShadBottom, nShadRight), ; ////// REPLICATE("X", nShadBottom - nShadTop + 1 ) ) ) ////// ////// RETURN ( NIL ) ////// /////////=======================================================********//// ////// ////////----------------------------------------------------------------------- //////FUNCTION AalMenu() //////aMenuItems := { "1 Anlegen ", ; ////// "2 Ansehen / Žndern ", ; ////// "L L”schen ", ; ////// "- ", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) //////RETURN (cFunk) //////// so war es frher: ////////FUNCTION AalMenu(aMenuItems, cMenuTitle) ////////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////////cMenuTitle := " " + cUeb + " " ////////cBoxChars := " " ; cMenuColor := "N/W" ////////// "W+/B,W+/R,R/GR+,,W+/W" //////// ////////SET WRAP ON //////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; //////// , cBoxChars, cMenuColor ) //////// ////////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) ////////RETURN (cFunk) ////////----------------------------------------------------------------------- ////////***folgende Mens mssten noch implementiert werden: ////////----------------------------------------------------------------------- //////FUNCTION AdMenu() //////aMenuItems := { "1 Ansehen ", ; ////// "2 Drucken ", ; ////// "- ", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<4, str(nChoice,1,0), "!" ) //////RETURN (cFunk) ////////----------------------------------------------------------------------- //////FUNCTION Aal2Menu() //////aMenuItems := { "1 Anlegen ", ; ////// "2 Ansehen / Žndern ", ; ////// "L L”schen ", ; ////// "- ", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) //////RETURN (cFunk) ////////----------------------------------------------------------------------- //////FUNCTION AalnMenu() //////aMenuItems := { "1 Anlegen (alt) ", ; ////// "2 Ansehen / Žndern (alt)", ; ////// "L L”schen (alt) ", ; ////// "N Neue Maske ", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) //////RETURN (cFunk) ////////----------------------------------------------------------------------- //////FUNCTION AaluMenu() //////aMenuItems := { "1 Anlegen ", ; ////// "2 Ansehen / Žndern ", ; ////// "L L”schen ", ; ////// "4 šbersicht ", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) //////RETURN (cFunk) ////////----------------------------------------------------------------------- //////FUNCTION AaludMenu() //////aMenuItems := { "1 Anlegen ", ; ////// "2 Ansehen / Žndern ", ; ////// "L L”schen ", ; ////// "4 šbersicht und Drucken", ; ////// "!, F10 oder ESC = Ende "} //////nTop := 6 ; nLeft := 20 ; nBottom := 15 ; nRight := 60 //////cMenuTitle := " Bitte Funktion eingeben : " //////cBoxChars := " " ; cMenuColor := "N/W" //////// "W+/B,W+/R,R/GR+,,W+/W" ////// //////SET WRAP ON ////// nChoice := BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ; ////// , cBoxChars, cMenuColor ) ////// //////cFunk := IIF(nChoice<5, str(nChoice,1,0), "!" ) //////RETURN (cFunk) ////////----------------------------------------------------------------------- ////////Die Drucker-Funktionen sind ab 20.2.2003 in BlattDrVG.PRG ! ////////----------------------------------------------------------------------- ////// ////// FUNCTION ClearFlex(oDlg) FOR I = 1 TO LEN(oDlg:ChildList()) IF oDlg:ChildList()[I]:IsDerivedFrom("FlexStatic") oDlg:ChildList()[I]:Destroy() ENDIF NEXT I RETURN NIL #define EDGESIZE 3 #define NOSIZE 0 #define BOTTOMLEFT 1 #define LEFTEDGE 2 #define TOPLEFT 3 #define TOPEDGE 4 #define TOPRIGHT 5 #define RIGHTEDGE 6 #define BOTTOMRIGHT 7 #define BOTTOMEDGE 8 CLASS FlexStatic FROM XbpStatic EXPORTED: METHOD Init,Create,Destroy,lbDown,lbUp,Motion VAR Child,Parent PROTECTED: VAR lbIsDown,mPos,Sizetype ENDCLASS METHOD FlexStatic:Init(oChild,lSelectGroup) LOCAL I IF EMPTY(oChild) MSGBOX("ERROR- No Child object defined!") RETURN Self ENDIF IF lSelectGroup = NIL lSelectGroup := .F. ENDIF ::Child := oChild ::Parent := oChild:SetParent() IF !lSelectGroup // be sure we only have one selected object FOR I = 1 TO LEN(::Parent:ChildList()) IF ::Parent:ChildList()[I]:IsDerivedFrom("FlexStatic") ::Parent:ChildList()[I]:Destroy() ENDIF NEXT I ENDIF ::XbpStatic:Init(oChild:SetParent(),,{oChild:CurrentPos()[1]-EDGESIZE,oChild:CurrentPos()[2]-EDGESIZE},{oChild:CurrentSize()[1]+2*EDGESIZE,oChild:CurrentSize()[2]+2*EDGESIZE}) ::Type := XBPSTATIC_TYPE_BGNDFRAME ::lbIsDown := .F. ::SizeType := NOSIZE ::mPos := {0,0} RETURN Self METHOD FlexStatic:Create() ::XbpStatic:Create(::Child:SetParent(),,{::Child:CurrentPos()[1]-EDGESIZE,::Child:CurrentPos()[2]-EDGESIZE},{::Child:CurrentSize()[1]+2*EDGESIZE,::Child:CurrentSize()[2]+2*EDGESIZE}) // ::SetColorBG(XBPSYSCLR_TRANSPARENT) ::Child:SetParent(Self) ::Child:SetPos({EDGESIZE,EDGESIZE}) ::Child:Motion := {|x|::Motion(x,.F.)} ::Child:lbDown := {|x|::lbDown(x,.F.)} ::Child:lbUp := {|x|::lbUp(x,.F.)} ::Child:lbDblClick := NIL ::InvalidateRect() RETURN Self METHOD FlexStatic:Destroy() ::Child:SetParent(::Parent) ::Child:SetPos({::CurrentPos()[1]+EDGESIZE,::CurrentPos()[2]+EDGESIZE}) ::Child:Motion := NIL ::Child:lbDown := NIL ::Child:lbUp := NIL ::Child:lbDblClick := {|x,y,o| SelectPart(o)} ::XbpStatic:Destroy() RETURN Self METHOD FlexStatic:lbDown(aPos,lNotchild) LOCAL aCSize aCSize := ::CurrentSize() ::lbIsDown := .T. ::mPos := aPos IF lNotchild = NIL ::CaptureMouse(.T.) DO CASE CASE aPos[1]<=EDGESIZE .AND. aPos[2] >= aCSize[2]-EDGESIZE //topleft ::SIZETYPE := TOPLEFT CASE aPos[1]>=aCSize[1]-EDGESIZE .AND. aPos[2] >= aCSize[2]-EDGESIZE //topright ::SIZETYPE := TOPRIGHT CASE aPos[1]>=aCSize[1]-EDGESIZE .AND. aPos[2] <= EDGESIZE //bottomright ::SIZETYPE := BOTTOMRIGHT CASE aPos[2]<=EDGESIZE .AND. aPos[1] <= EDGESIZE //bottomleft ::SIZETYPE := BOTTOMLEFT CASE aPos[1]>=aCSize[1]-EDGESIZE //right ::SIZETYPE := RIGHTEDGE CASE aPos[1]<=EDGESIZE //left ::SIZETYPE := LEFTEDGE CASE aPos[2] >= aCSize[2]-EDGESIZE //top ::SIZETYPE := TOPEDGE CASE aPos[2]<=EDGESIZE //Bottom ::SIZETYPE := BOTTOMEDGE ENDCASE ELSE ::Child:CaptureMouse(.T.) ENDIF RETURN Self METHOD FlexStatic:lbUp(aPos) ::lbIsDown := .F. ::CaptureMouse(.F.) ::Child:CaptureMouse(.F.) RETURN Self METHOD FlexStatic:Motion(aPos,lNotchild) LOCAL aCSize,aCPos,nDif aCSize := ::CurrentSize() aCPos := ::CurrentPos() nDif := {::mPos[1]-aPos[1],::mPos[2]-aPos[2]} IF ::lbIsDown .AND. lNotChild != NIL // comes from child move ::SetPos({aCPos[1]-nDif[1],aCPos[2]-nDif[2]}) ELSEIF ::lbIsDown // comes from self resize DO CASE CASE ::SIZETYPE = TOPLEFT //topleft ::SetPosandSize({aCPos[1]-nDif[1],aCPos[2]},{aCSize[1]+nDif[1],aCSize[2]-nDif[2]}) ::mPos[2] := aPos[2] CASE ::SIZETYPE = TOPRIGHT //topright ::SetSize({aCSize[1]-nDif[1],aCSize[2]-nDif[2]}) ::mPos := aPos CASE ::SIZETYPE = BOTTOMRIGHT //bottomright ::SetPosAndSize({aCPos[1],aCPos[2]-nDif[2]},{aCSize[1]-nDif[1],aCSize[2]+nDif[2]}) ::mPos[1] := aPos[1] CASE ::SIZETYPE = BOTTOMLEFT //bottomleft ::SetPosAndSize({aCPos[1]-nDif[1],aCPos[2]-nDif[2]},{aCSize[1]+nDif[1],aCSize[2]+nDif[2]}) CASE ::SIZETYPE = RIGHTEDGE //right ::SetSize({aCSize[1]-nDif[1],aCSize[2]}) ::mPos := aPos CASE ::SIZETYPE = LEFTEDGE //left ::SetPosAndSize({aCPos[1]-nDif[1],aCPos[2]},{aCSize[1]+nDif[1],aCSize[2]}) CASE ::SIZETYPE = TOPEDGE //top ::SetSize({aCSize[1],aCSize[2]-nDif[2]}) ::mPos := aPos CASE ::SIZETYPE = BOTTOMEDGE //Bottom ::SetPosAndSize({aCPos[1],aCPos[2]-nDif[2]},{aCSize[1],aCSize[2]+nDif[2]}) ENDCASE ::Child:SetSize({::CurrentSize()[1]-2*EDGESIZE,::CurrentSize()[2]-2*EDGESIZE}) ELSE DO CASE CASE aPos[1]<=EDGESIZE .AND. aPos[2] >= aCSize[2]-EDGESIZE //topleft ::SetPointer(,XBPSTATIC_SYSICON_SIZENWSE,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[1]>=aCSize[1]-EDGESIZE .AND. aPos[2] >= aCSize[2]-EDGESIZE //topright ::SetPointer(,XBPSTATIC_SYSICON_SIZENESW,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[1]>=aCSize[1]-EDGESIZE .AND. aPos[2] <= EDGESIZE //bottomright ::SetPointer(,XBPSTATIC_SYSICON_SIZENWSE,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[2]<=EDGESIZE .AND. aPos[1] <= EDGESIZE //bottomleft ::SetPointer(,XBPSTATIC_SYSICON_SIZENESW,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[1]>=aCSize[1]-EDGESIZE //right ::SetPointer(,XBPSTATIC_SYSICON_SIZEWE,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[1]<=EDGESIZE //left ::SetPointer(,XBPSTATIC_SYSICON_SIZEWE,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[2] >= aCSize[2]-EDGESIZE //top ::SetPointer(,XBPSTATIC_SYSICON_SIZENS,XBPWINDOW_POINTERTYPE_SYSPOINTER) CASE aPos[2]<=EDGESIZE //Bottom ::SetPointer(,XBPSTATIC_SYSICON_SIZENS,XBPWINDOW_POINTERTYPE_SYSPOINTER) OTHERWISE ::SetPointer(,XBPSTATIC_SYSICON_ARROW,XBPWINDOW_POINTERTYPE_SYSPOINTER) ENDCASE ENDIF RETURN Self FUNCTION SelectPart(o) LOCAL oFS oFS := FlexStatic():New(o):Create() RETURN NIL