Re: grid üzerinde sağtıklama
1) Gridin icindeki default textbox yerine kendi textboxini kullanarak yapabilirsin.
2) Grid onune bir container koyarak yapabilirsin
3) MSHierarchicalFlexGrid gibi activex gridle yapabilirsin
- cetinbasoz
- Uzman Üye
- Offline
- erdalyalcin
- Uzman Üye
- Offline
Re: grid üzerinde sağtıklama
gridin RightClickEvent ında shortcut menu çalıştırabilirsin.
değer atama konusunu anlayamadım
Re: grid üzerinde sağtıklama
Menu sağ fare için güzel bir örnek var sağ fareye bastığında menü oluşturabiliyorsun. Hazır menu kullanmana gerek kalmıyor.
Bildiğim kadarıyla fare ile birden fazla hücreyi seçemiyorsun. Oluyorsada duymak isterim. nasıl olacak.
Visual Fox Pro
LOCAL lForm
lForm = CREATEOBJECT("form1")
lform.Show(1)
DEFINE CLASS form1 AS form
Top = 0
Left = 0
Height = 330
Width = 519
DoCreate = .T.
Caption = "Form1"
Name = "Form1"
ADD OBJECT grid1 AS grid WITH ;
Height = 300, ;
Left = 12, ;
Top = 12, ;
Width = 492, ;
BackColor = RGB(255,255,255), ;
HighlightStyle = 2, ;
AllowCellSelection = .F., ;
Name = "Grid1"
PROCEDURE Init
thisform.grid1.RecordSource = "lCursor"
ENDPROC
PROCEDURE Load
CREATE CURSOR lCursor (fAlan1 C(10), fAlan2 C(10))
INSERT INTO lCursor (fAlan1, fAlan2) VALUES ("bir", "iki")
INSERT INTO lCursor (fAlan1, fAlan2) VALUES ("üç", "dört")
GO TOP IN lCursor
ENDPROC
PROCEDURE grid1.RightClick
LPARAMETERS nRow, nCol
LOCAL loMenu
loMenu = CREATEOBJECT("_shortcutmenu")
WITH loMenu
.AddMenuBar("Birinci kolonu BİN yap", [replace fAlan1 with 'BİN'])
.AddMenuSeparator()
.AddMenuBar("İkinci kolonu İKİBİN yap", [replace fAlan2 with 'İKİBİN'])
.ShowMenu()
ENDWITH
ENDPROC
ENDDEFINE
DEFINE CLASS _shortcutmenu AS _custom
Height = 22
Width = 24
*-- Menu bar selection routine.
conselection = ""
*-- Name of shortcut menu.
cmenu = ""
Name = "_shortcutmenu"
DIMENSION amenu[1]
*-- Deactivates existing shortcut menu.
PROCEDURE deactivatemenu
IF EMPTY(this.cMenu)
RETURN
ENDIF
DEACTIVATE POPUP (this.cMenu)
this.cMenu=""
DOEVENTS
ENDPROC
*-- Activates existing shortcut menu.
PROCEDURE activatemenu
LPARAMETERS tcParentMenu
LOCAL lnArrayColumns,llMultiArray,lnBar,lnSkipCount,lnCount,lnMRow,lnMCol
LOCAL lnMenuCount,lcMenu,lcMenu2,lcMenuItem,luMenuSelection,llSetMark,lcClauses
lnMRow=MAX(MROW(),0)
lnMCol=MAX(MCOL(),0)
IF TYPE("this.aMenu")#"C"
RETURN .F.
ENDIF
lnMenuCount=ALEN(this.aMenu,1)
IF lnMenuCount=0
RETURN .F.
ENDIF
lcMenu=IIF(EMPTY(tcParentMenu),SYS(2015),ALLTRIM(tcParentMenu))
this.cMenu=lcMenu
lnArrayColumns=ALEN(this.aMenu,2)
llMultiArray=(lnArrayColumns>0)
DEACTIVATE POPUP (lcMenu)
CLEAR TYPEAHEAD
IF EMPTY(tcParentMenu)
DEFINE POPUP (lcMenu) ;
FROM lnMRow,lnMCol ;
MARGIN ;
SHORTCUT
ON SELECTION POPUP (lcMenu) DEACTIVATE MENU (lcMenu)
ENDIF
lnSkipCount=0
FOR lnCount = 1 TO lnMenuCount
lcMenuItem=IIF(llMultiArray,this.aMenu[lnCount,1],this.aMenu[lnCount])
IF TYPE("lcMenuItem")#"C" OR EMPTY(lcMenuItem) OR ;
((lnCount=1 OR lnCount=lnMenuCount) AND ALLTRIM(lcMenuItem)=="\-")
lnSkipCount=lnSkipCount+1
LOOP
ENDIF
lnBar=lnCount-lnSkipCount
llSetMark=.F.
IF LEFT(lcMenuItem,1)=="^"
lcMenuItem=SUBSTR(lcMenuItem,2)
llSetMark=.T.
ENDIF
IF lnArrayColumns>=3 AND NOT EMPTY(this.aMenu[lnCount,3])
lcClauses=ALLTRIM(this.aMenu[lnCount,3])
ELSE
lcClauses=""
ENDIF
IF EMPTY(lcClauses)
DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem)
ELSE
DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem) &lcClauses
ENDIF
IF llSetMark
SET MARK OF BAR (lnBar) OF (lcMenu) TO .T.
ENDIF
IF NOT llMultiArray
LOOP
ENDIF
luMenuSelection=this.aMenu[lnCount,2]
IF TYPE("luMenuSelection")=="O" AND NOT ISNULL(luMenuSelection)
lcMenu2=SYS(2015)
DEFINE POPUP (lcMenu2) ;
MARGIN ;
SHORTCUT
ON SELECTION POPUP (lcMenu2) DEACTIVATE MENU (lcMenu2)
ON BAR lnBar OF (lcMenu) ACTIVATE POPUP (lcMenu2)
IF EMPTY(luMenuSelection.cOnSelection)
luMenuSelection.cOnSelection=this.cOnSelection
ENDIF
luMenuSelection.ActivateMenu(lcMenu2)
LOOP
ENDIF
IF EMPTY(luMenuSelection)
luMenuSelection=ALLTRIM(this.cOnSelection)
ENDIF
IF NOT EMPTY(luMenuSelection)
ON SELECTION BAR lnBar OF (lcMenu) &luMenuSelection
ENDIF
ENDFOR
IF lnSkipCount>=lnMenuCount OR NOT EMPTY(tcParentMenu)
RETURN
ENDIF
ACTIVATE POPUP (lcMenu)
IF NOT EMPTY(this.cMenu)
DEACTIVATE POPUP (this.cMenu)
ENDIF
this.cMenu=""
ENDPROC
*-- Releases existing shortcut menu.
PROCEDURE clearmenu
DIMENSION this.aMenu[1]
this.aMenu=""
this.cOnSelection=""
ENDPROC
*-- Creates new menu popup for shortcut menu.
PROCEDURE newmenu
LOCAL toObject
LOCAL oNewObject,lcClass,lcClassLibrary,lcBaseClass,lcAlias,llAddLibrary
IF TYPE("toObject")#"O" OR ISNULL(toObject)
toObject=this
ENDIF
lcClass=LOWER(toObject.Class)
lcClassLibrary=LOWER(toObject.ClassLibrary)
lcBaseClass=LOWER(toObject.BaseClass)
IF EMPTY(lcClassLibrary)
oNewObject=CREATEOBJECT(lcBaseClass)
RETURN oNewObject
ENDIF
lcAlias=LOWER(SYS(2015))
llAddLibrary=(ATC(lcClassLibrary,SET("CLASSLIB"))=0)
IF llAddLibrary
SET CLASSLIB TO (lcClassLibrary) ALIAS (lcAlias) ADDITIVE
ENDIF
oNewObject=CREATEOBJECT(lcClass)
IF llAddLibrary
RELEASE CLASSLIB ALIAS (lcAlias)
ENDIF
RETURN oNewObject
ENDPROC
*-- Adds new menu bar to shortcut menu.
PROCEDURE addmenubar
LPARAMETERS tcPrompt,tcOnSelection,tcClauses,tnElementNumber,tlMark,tlDisabled,tlBold
LOCAL lcPrompt,lcClauses,lnElementNumber,lnMenuCount,lnArrayColumns,lnIndex,oShortCutMenu
IF EMPTY(tcPrompt)
RETURN .F.
ENDIF
IF TYPE("tcPrompt")=="O" AND NOT ISNULL(tcPrompt)
oShortCutMenu=tcPrompt
tcPrompt=.NULL.
FOR lnIndex = 1 TO ALEN(oShortCutMenu.aMenu,1)
this.AddMenuBar(oShortCutMenu.aMenu[lnIndex,1],oShortCutMenu.aMenu[lnIndex,2], ;
oShortCutMenu.aMenu[lnIndex,3])
ENDFOR
RETURN
ENDIF
lcPrompt=tcPrompt
lcClauses=IIF(EMPTY(tcClauses),"",tcClauses)
IF tlMark
lcPrompt="^"+lcPrompt
ENDIF
IF tlDisabled
lcClauses=lcClauses+[ SKIP FOR .T.]
ENDIF
IF tlBold
lcClauses=lcClauses+[ STYLE "B"]
ENDIF
lnMenuCount=ALEN(this.aMenu,1)
lnArrayColumns=ALEN(this.aMenu,2)
IF lnMenuCount<=1 AND EMPTY(this.aMenu[1])
lnMenuCount=1
lnArrayColumns=3
ELSE
lnMenuCount=lnMenuCount+1
ENDIF
lnIndex=lnMenuCount
DIMENSION this.aMenu[lnIndex,lnArrayColumns]
IF TYPE("tnElementNumber")=="N"
lnElementNumber=MAX(INT(tnElementNumber),1)
IF lnElementNumber<lnMenuCount
IF AINS(this.aMenu,lnElementNumber)#1
RETURN .F.
ENDIF
lnIndex=lnElementNumber
ENDIF
ENDIF
IF lnArrayColumns<=1
this.aMenu[lnIndex]=lcPrompt
RETURN
ENDIF
this.aMenu[lnIndex,1]=lcPrompt
this.aMenu[lnIndex,2]=tcOnSelection
IF lnArrayColumns>=3
this.aMenu[lnIndex,3]=lcClauses
ENDIF
ENDPROC
*-- Adds separator to shortcut menu.
PROCEDURE addmenuseparator
LPARAMETERS tnElementNumber
this.AddMenuBar("\-",,,tnElementNumber)
ENDPROC
*-- Show existing shortcut menu.
PROCEDURE showmenu
RETURN this.ActivateMenu()
ENDPROC
*-- Releases current shortcut menu to create new one.
PROCEDURE setmenu
LPARAMETERS toObject
this.ClearMenu
RETURN .F.
ENDPROC
PROCEDURE Init
this.ClearMenu
ENDPROC
ENDDEFINE
Re: grid üzerinde sağtıklama
Pardon yaaaa, aşağıdaki koduda aynı prg içine yapıştırırsan olması gerekiyor.
Visual Fox Pro
DEFINE CLASS _custom AS custom
Height = 22
Width = 24
*-- Version property.
cversion = ""
*-- Bulder property.
builder = ""
*-- BuilderX property.
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
*-- Returns the number of items in the object reference array property aObjectRefs.
nobjectrefcount = 0
*-- Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
ohost = .NULL.
*-- Variant result property for internal usage when calling programs in PRGs and a return file is required.
vresult = .T.
*-- Program to be called when when setting an object references via the SetObjectRef method.
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
*-- Number of instances.
ninstances = 0
Name = "_custom"
*-- Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
lautobuilder = .F.
*-- Specifiies if the SetObjectRefs method is automatically called from the Init method.
lautosetobjectrefs = .F.
*-- Indicates the object's Release method has been executed and the object is in the process of being released from memory.
lrelease = .F.
*-- Specifies if the default FFC error handler is executed when an error occurs.
lignoreerrors = .F.
*-- Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
lsethost = .F.
*-- Array of object references properties.
DIMENSION aobjectrefs[1,3]
*-- Releases object from memory.
PROCEDURE release
LOCAL lcBaseClass
IF this.lRelease
NODEFAULT
RETURN .F.
ENDIF
this.lRelease=.T.
lcBaseClass=LOWER(this.BaseClass)
this.oHost=.NULL.
this.ReleaseObjRefs
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
RELEASE this
ENDIF
ENDPROC
*-- Set object reference to specific property.
PROCEDURE setobjectref
LPARAMETERS tcName,tvClass,tvClassLibrary
LOCAL lvResult
this.vResult=.T.
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
lvResult=this.vResult
this.vResult=.T.
RETURN lvResult
ENDPROC
*-- Place holder method for listing SetObjectRef method calls.
PROCEDURE setobjectrefs
LPARAMETERS toObject
RETURN
ENDPROC
*-- Releases all object references of aObjectRefs array.
PROCEDURE releaseobjrefs
LOCAL lcName,oObject,lnCount
IF this.nObjectRefCount=0
RETURN
ENDIF
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
lcName=this.aObjectRefs[lnCount,1]
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
LOOP
ENDIF
oObject=this.&lcName
IF ISNULL(oObject)
LOOP
ENDIF
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
oObject.Release
ENDIF
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
oObject.oHost=.NULL.
ENDIF
this.&lcName=.NULL.
oObject=.NULL.
ENDFOR
DIMENSION this.aObjectRefs[1,3]
this.aObjectRefs=""
ENDPROC
*-- Access method for nObjectRefCount property.
PROCEDURE nobjectrefcount_access
LOCAL lnObjectRefCount
lnObjectRefCount=ALEN(this.aObjectRefs,1)
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
lnObjectRefCount=0
ENDIF
RETURN lnObjectRefCount
ENDPROC
*-- Assign method for nObjectRefCount property.
PROCEDURE nobjectrefcount_assign
LPARAMETERS m.vNewVal
ERROR 1743
ENDPROC
*-- Set oHost property to form reference object.
PROCEDURE sethost
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
ENDPROC
*-- Returns new instance of object.
PROCEDURE newinstance
LPARAMETERS tnDataSessionID
LOCAL oNewObject,lnLastDataSessionID
lnLastDataSessionID=SET("DATASESSION")
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
SET DATASESSION TO tnDataSessionID
ENDIF
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
SET DATASESSION TO (lnLastDataSessionID)
RETURN oNewObject
ENDPROC
*-- Dummy code for adding files to project.
PROTECTED PROCEDURE addtoproject
*-- Dummy code for adding files to project.
RETURN
DO SetObjRf.prg
ENDPROC
*-- Access method for nInstances property.
PROCEDURE ninstances_access
LOCAL laInstances[1]
RETURN AINSTANCE(laInstances,this.Class)
ENDPROC
*-- Assign method for nInstances property.
PROCEDURE ninstances_assign
LPARAMETERS vNewVal
ERROR 1743
ENDPROC
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
IF this.lIgnoreErrors OR _vfp.StartMode>0
RETURN .F.
ENDIF
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
IF NOT EMPTY(lcOnError)
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
"PROGRAM()","cMethod"),"LINENO()","nLine")
&lcOnError
RETURN
ENDIF
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
"Method: "+LOWER(ALLTRIM(cMethod))
lcCodeLineMsg=MESSAGE(1)
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
IF NOT EMPTY(lcCodeLineMsg)
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
ENDIF
ENDIF
WAIT CLEAR
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
ERROR nError
ENDPROC
PROCEDURE Init
IF this.lSetHost
this.SetHost
ENDIF
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
RETURN .F.
ENDIF
ENDPROC
PROCEDURE Destroy
IF this.lRelease
RETURN .F.
ENDIF
this.lRelease=.T.
this.ReleaseObjRefs
this.oHost=.NULL.
ENDPROC
ENDDEFINE