1 Cevaplayan cetinbasoz

  • cetinbasoz
  • Moderatör
  • Offline
  • Kayıt Tarihi: 07.10.2006
  • İleti: 2,314

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

Yen yaz 1907'ye yolla FB gelsin evinde yensin.
(sonra salaklar ciksin alin terine şike desin)

cetinbasoz's Website

2 Cevaplayan erdalyalcin

  • erdalyalcin
  • Üye
  • Offline
  • Yer: İstanbul
  • Kayıt Tarihi: 09.10.2006
  • İleti: 224

Re: grid üzerinde sağtıklama

gridin RightClickEvent ında shortcut menu çalıştırabilirsin.
değer atama konusunu anlayamadım

erdalyalcin's Website

3 Cevaplayan cetinyasar

  • cetinyasar
  • Üye
  • Offline
  • Yer: İstanbul
  • Kayıt Tarihi: 09.10.2006
  • İleti: 116

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
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

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

4 Cevaplayan cetinyasar

  • cetinyasar
  • Üye
  • Offline
  • Yer: İstanbul
  • Kayıt Tarihi: 09.10.2006
  • İleti: 116

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
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

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