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
' Этот пример форматирования объекта Axis (ось) интерактивного графика с помощью объекта Axis Element.
' MyIGraph должна быть объектной переменной типа ISpssIGraph.
' Автор: Raynald Levesque, rlevesque@videotron.ca

Const SpssIGraphX1 As Integer = 0
Const SpssIGraphY As Integer  = 1
Const SpssIGraphGridLineAtMajorTicks As Integer = 0
Const spssAxisLabelAllCategories As Integer = 2
Const spssAxisLabelHorizontal As Integer = 1
Const SpssIGraphTickFormatFloating As Integer = 0
Const vbBlack As Long = 16777215
Public dblThick As Double, blnGrid As Boolean, strGraphName As String
Public intMaxX As Integer, intMaxY As Integer, intDeltaX As Integer, intDeltaY As Integer

Option Explicit

Sub main
Dim objOutputDoc 	As ISpssOutputDoc
Dim objOutputItems 	As ISpssItems
Dim objOutputItem 	As ISpssItem
Dim MyIgraph 		As ISpssIGraph
Dim intItemCount As Integer, intItemType As Integer, strLabel As String, intCtr As Integer
Dim strInput As String

Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Set objOutputItems = objOutputDoc.Items()
' получим параметры из синтаксиса
strInput = objSpssApp.ScriptParameter(0)
ParseInput(strInput)

'intDeltaX = 1
'intDeltaY = 4
intItemCount = objOutputItems.Count()

For intCtr=1 To intItemCount - 1
	Set objOutputItem = objOutputItems.GetItem(intCtr)
	intItemType = objOutputItem.SPSSType()
	strLabel = objOutputItem.Label
	'Найдём графики, подлежащие изменению, затем вызываем модифицирующие процедуры
	If strLabel = strGraphName Then
		Set MyIgraph = objOutputItem.Activate()
		Call DoTicks(MyIgraph, SpssIGraphX1, intDeltaX)
		Call DoTicks(MyIgraph, SpssIGraphY, intDeltaY)
		Call DoGrids (MyIgraph)
		objOutputItem.Deactivate
	End If
Next
End Sub


'******************************
' Этот пример показывает, как можно установить основные засечки
' на осях X и Y, используя объект Dimension.

' MyIGraph должна быть объектной переменной типа ISpssIGraph;
' DimensionSlot - та размерность, которую хотите форматировать

Sub DoTicks(MyIgraph As ISpssIGraph, DimensionSlot As Integer,intDelta As Integer)
' устанавливаем основные засечки
Dim MyVariableManager As ISpssIGraphVariablesMgr
Dim MyScaleDimension As ISpssIGraphDimension
Dim DimensionVariableName() As String
Dim iTick As Integer, intIndex As Integer, intMaxValue As Integer
Set MyVariableManager = MyIgraph.VariablesMgr

' Во-первых, надо убедиться, что размерность задана, по крайней мере, одной переменной и получить
' имена этих переменных. Свойство GetAssigned содержит False (ложь), если указанная размерность не содержит переменных
If MyVariableManager.GetAssigned(DimensionSlot, DimensionVariableName) = True Then

	' Теперь посмотрим, является ли первая переменная числовой.
	If MyVariableManager.Categorical(DimensionVariableName(0)) = False Then
		' Если числовая, установим ссылку на объект Dimension (размерность)
		Set MyScaleDimension = MyIgraph.VariablesMgr.GetDimension(DimensionSlot)
		With MyScaleDimension
			.TickFormat = SpssIGraphTickFormatFloating
			.NumberOfMajorTicksAutomatic =False
			intMaxValue=.ScaleMax
			intIndex = 0
			For iTick=0 To intMaxValue + intDelta Step intDelta
				.SetMajorTickLabel(intIndex,CStr(Fix(iTick)))
				Debug.Print intIndex & " " & .GetMajorTickLabel(intIndex)
				intIndex = intIndex + 1 
			Next
			.NumberOfMajorTicks = intIndex - 1
		End With
		' Всегда перерисовываем график после изменения
		MyIgraph.Redraw
	End If
End If
End Sub

'**************************************
Sub DoGrids(MyIgraph As ISpssIGraph)
' Объявим объекты осей
Dim MyYAxis As ISpssIGraphAxis
Dim MyXAxis As ISpssIGraphAxis
Dim MyArea As ISpssIGraphDataRegion
Set MyArea = MyIgraph.GetDataRegion

' Устанавливаем границу для графика
MyArea.GetArea.BorderTransparent = 0	
MyArea.GetArea.BackgroundColor = vbBlack
MyArea.GetArea.BorderWeight = dblThick

' Получаем ссылку на ось Y графика
Set MyYAxis = MyIgraph.GetAxis(0)
With MyYAxis
	' Включим отображение линий сетки и расположим их по основным засечкам
	.GridLines = blnGrid
	.GridLinesLocation = SpssIGraphGridLineAtMajorTicks
	.LabelFrequency = spssAxisLabelAllCategories
	.LabelOrientation = spssAxisLabelHorizontal
End With

' Получаем ссылку на ось X графика
Set MyXAxis = MyIgraph.GetAxis(1)
With MyXAxis
	' Включим отображение линий сетки и расположим их по основным засечкам
	.GridLines = blnGrid
	.GridLinesLocation = SpssIGraphGridLineAtMajorTicks
	.LabelFrequency = spssAxisLabelAllCategories
	.LabelOrientation = spssAxisLabelHorizontal
End With
' Всегда перерисовываем график после изменения
MyIgraph.Redraw
End Sub


'--------------------------------
Sub ParseInput(strInput As String)
' Разбор строки переданных в скрипт параметров
Dim intTemp1 As Integer, intTemp2 As Integer
'StrErr = "Error while parsing input:"

	intTemp1	=InStr(strInput,",")
	strGraphName=Mid(strInput,1,intTemp1-1)

	intTemp2	=InStr(intTemp1+1,strInput,",")
	intDeltaX	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intDeltaY	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	blnGrid		=CBool(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	dblThick	=CDbl(Mid(strInput,intTemp2+1,Len(strInput)-intTemp1))

End Sub