关于oleVariant(200分)

  • 主题发起人 主题发起人 迷惘的人
  • 开始时间 开始时间

迷惘的人

Unregistered / Unconfirmed
GUEST, unregistred user!
这个olevariant是在单元PView_TLB中声明的:
Unit PView_TLB;
..............
property Colors:OleVariant Read Get_Colors Write Set_colors;
..............
end;
PView_TLB是VB程序提供的一个可编程文件(是不是叫Pascal外套?),我想给属性colors
赋一个整数数组,请问怎么办?
 
OleVariant 可以是一个对象。
 
我这个问题是太简单了,还是太难了?为什么没人答复?
 
大家都来帮帮忙!
 
为什么没有人答复?
 
TLB是Delphi的类型库文件,
你需要先定义一个OleVariant变量,将数组的值赋给他,
然后再赋值给此属性
使用VarArrayCreate创建Variant数组变量,然后用循环将你的数组的值逐个复制
然后赋值给这个属性
var
tmp: Variant;
i: Integer;
begin
tmp := VarArrayCreate([100], varInteger); //100为数组大小,后面为元素类型
for i := 0 to 99 do tmp := mydata[i+1];
Colors := tmp;


 
OleVariant类型是一种只能包含COM兼容类型的Variant变量,当一个变量赋值给OleVariant变量时,不兼容的
类型系统会自动将其转换为兼容类型,比如将一个ansistring赋值给OleVarinat变量时将会被转换成widestring
类型.
 
to LiChaoHui,
运行时报错:
Access violation at address 01607028 in module 'pview1.dll' .Read of address
00002003
错就在Colors := tmp;这一句,这是什么问题呢?
 
大家都来看看吧!
 
呵呵,好象是geomedia的导入文件啊,在做GIS?
 
[:D]to menxin:
是啊!想必大哥也做过,能否告知小弟如何解决这个问题?在下感激不尽!
 
这种文件是由ACtiveX导入的类型库,GEOMEDIA的TLB有很多问题,很多单元要经过修改才能用。
方法不全等更是常有的事,好在不耽误什么大事。
我不知道你的这个colors是哪个控件的属性,GMMapview?一般的办法是参照geomedia的开发手册
如果相关的vb程序能做,delphi没有什么问题。你自己按照它的例子做一下翻译就可以了
 
呵呵,我也不知道,你自己再探索一下吧
 
to menxin:
我的目的是模仿Geomedia中的toolbar里的add Thematic Lengend Entry功能(就是按字段值
的范围显示不同的颜色),我参照的就是下面的例程(在help中搜索RangeLengendEntry可找
到),问题出在后面有一排问号的那行:
This example creates and displays a range legend entry in a Map View.
The entry displays annual snow fall for the United States in 5 ranges.
The example uses a customized color scheme, fonts, and enrty and
individual range characteristics. The example also uses a transformation
pipe to display the data in the Map View's cooridnate system.

Note: Change the database location to the correct directory on your machine.

TypeLibraries/OCXs required:
- Intergraph GeoMedia Client Support (PClient.tlb)
- Intergraph GeoMedia Database Pipes (PDBPipe.tlb)
- Intergraph GeoMedia Coordinate Systems (PCSS.tlb)
- Intergraph Geomedia Thematic Display (PAdvLgd.tlb)
- Intergraph GeoMedia Map Viewing (PView.tlb)
- Intergraph GeoMedia Map View Control (mapview.ocx).
Form controls: A GMMapView control (
GMMapView1).

Option Explicit
Dim objRLE As RangeLegendEntry, objConn As New Connection
Dim objOPipe As OriginatingPipe, objXformPipe As CSSTransformPipe

Private Sub Form_Load()

' Set Map View parameters
Set GMMapView1.CoordSystemsMgr = New CoordSystemsMgr
With GMMapView1.CoordSystemsMgr.CoordSystem
.BaseStorageType = csbsProjected

.RefSpaceMgr.ProjSpace.ProjAlgorithmVal
= cspaRobinson
End With
Set GMMapView1.Legend = New Legend

' Create connection and store spatial filter with connection
With objConn
.Location = "D:/Warehouses/USSampleData.mdb"
.Description = "US Sample Data"
.Mode = gmcModeReadOnly
.Type = "Access.GDatabase"
.ConnectionName = "Connect1"
Set .CoordSystemsMgr = GMMapView1.CoordSystemsMgr
.Connect
End With

' Create recordset of States
objConn.CreateOriginatingPipe objOPipe
objOPipe.Table = "States"

' Transform the recordset to the Map View projection

Set objXformPipe = CreateObject("Geomedia.CSSTransformPipe")
Set objXformPipe.InputRecordset = objOPipe.OutputRecordset
objXformPipe.
InputGeometryFieldName = "Geometry"
Set objXformPipe.CoordSystemsMgr = GMMapView1.CoordSystemsMgr

' Create range legend entry for states
Set objRLE = CreateObject("Geomedia.RangeLegendEntry")

' Define standard color scheme for thematic entry
Dim objColor As ColorScheme, objColors As ColorSchemes

Dim Colors(5) As Long
Set objColors = CreateObject("Geomedia.ColorSchemes")
Set objColor = CreateObject("Geomedia.ColorScheme")
Colors(0) = RGB(188, 188, 65)
Colors(1) = RGB(213, 204, 187)
Colors(2) = RGB(255, 255, 65)
Colors(3) = RGB(128, 180, 128)
Colors(4) = RGB(144, 127, 97)

With objColor
.Colors = Colors() ?????????????????
.Name = "Autumn"
.Type = gmcsStandard
End With
objColors.Append objColor
Set objRLE.ColorSchemes = objColors

objRLE.ColorSchemeIndex = objRLE.ColorSchemes.Count
Set objColors = Nothing
Set objColor = Nothing

' Set Range legend entry characteristics
With objRLE
.GeometryFieldName = "Geometry"
Set .Recordset = objXformPipe.OutputRecordset
Set .Style = New AreaStyle
.ContentsMode = gmalContentsModeDescription
.DisplayMode = gmlDisplayModeOn
.Selected = False
.StatisticsMode = gmalStatisticsModeRange

.Visible = True
.AttributeFieldName = "ANNULSNOW"
.SetRanges gmalRangeByEqualCount, 5
End With
Set objOPipe = Nothing
Set objXformPipe = Nothing

Dim objRange As Range

For Each objRange In objRLE.Ranges
objRange.Description = objRange.
RangeMinimum & " to " _
& objRange.RangeMaximum & " inches"
objRange.Include = True
Next
Set objRange = Nothing


' Set title font
Dim objFont As Font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 10
.Bold = True
End With

Set objRLE.TitleFont = objFont
objRLE.TitleFontColor = RGB(0, 0, 100)
objRLE.Title = "States by Annual Snow Fall"
Set objFont = Nothing

' Set subtitle font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 8
.Italic = True

End With

Set objRLE.SubtitleFont = objFont
objRLE.SubtitleFontColor = RGB(0, 0, 200)

Dim dblMin As Double, dblMax As Double
objRLE.GetDisplayScaleRange dblMin, dblMax
objRLE.Subtitle = "Display Scale Range = " & dblMin & " to " & dblMax
Set objFont = Nothing

' Set range heading font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 8
End With

Set objRLE.HeadingFont = objFont

objRLE.HeadingFontColor = RGB(0, 100, 100)
Set objFont = Nothing

' Append legend entry to Map View legend
If objRLE.ValidateSource Then

GMMapView1.Legend.LegendEntries.Append
objRLE
objRLE.LoadData
End If

GMMapView1.Legend.Fit
GMMapView1.Legend.Visible = True
GMMapView1.Fit

Set objRLE = Nothing

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set objConn = Nothing
End Sub
 
我手头没有Geomedia也没有那个单元,从程序上看,转换应该不会有什么问题,你去pview_tlb看
看colors的原型吧
 
这个olevariant是在单元PView_TLB中声明的:
Unit PView_TLB;
..............
property Colors:OleVariant Read Get_Colors Write Set_colors;
..............
end;
 
还有没有人答复?
 
问题应该是出在那个set_colors,我的导入程序是这样写的
PVIEW_TLB.PAS

_DGMColorScheme = interface(IDispatch)
['{8BEF86E0-366F-11D0-A5F7-080036534602}']
function Get_Type_: Integer; safecall;
procedure Set_Type_(plType: Integer); safecall;
function Get_Parent: IDispatch; safecall;
procedure _Set_Parent(const ppParent: IDispatch); safecall;
function Get_Name: WideString; safecall;
procedure Set_Name(const pbstrName: WideString); safecall;
function Get_Colors: OleVariant; safecall;
procedure Set_Colors(pvsaColorScheme: POleVariant1); safecall;
property Type_: Integer read Get_Type_;
property Parent: IDispatch read Get_Parent;
property Name: WideString read Get_Name;
property Colors: OleVariant read Get_Colors;
end;

想必是你自己加入的set_colors,不过我的PAS不全,再向下找时pvsaColorScheme: POleVariant1都找不到了
这个导入单元没有,我就没办法了。只能找到全的系统时再说
 
多人接受答案了。
 
后退
顶部