Re: DC another Problem

From: christophe-pasde<> (_at_wanadoo.fr)
Date: 11/18/04 

Date: Thu, 18 Nov 2004 20:31:58 +0100

Simply copy the code in a project and look how it runs
What is important for you is metricDC

What do you think ?
I use AUtocad since 1987 , what you called "just want to know" is a
little more complicated and need learn and work.

The example I send , need me two year of learn, reading, and so ...

Have a look on ACAD model object and think on what Mike teach you,
normaly you will begin to think that it's not so easy.

And know one think, autocad is very close to API function,; so when Mike
said read the MSDN about coordinates and so one , do it .

NB: the code is very long but answered to many of your questions during
this last month.
If you take time to test it I give you answer back if you need some.

Christophe

Amrit a écrit :

> Hi Christophe
>
> Thanks for reply. The Code is very long. and it was very diffcult to
> understand for me.
>
> I just want to know how to set Viewport Area with in given Rectangle size.
> Such Like Zoom In AutoCAD.
>
> Thanks
> Amrit
>
> "christophe-pasde<> @wanadoo.fr>" <"christophe-pasde<> wrote in message
> news:419c73d7$0$30941$8fcfb975@news.wanadoo.fr...
>
>>Hello,
>>
>>Here is an example
>>
>>The comments are only on the form code
>>no time enougth to comment the class module
>>
>>On a form named form1 put
>>label 1
>>Picture1 as picturebox
>>6 command button
>>
>>the 1 to 4 are like a cross
>>command1 on North, 2 on East 3 on South, 4 on West
>>
>>two other where you want.
>>
>>Christophe
>>
>>
>>*************
>>*************
>>'form1 code
>>
>>Private mdc As metricDC
>>Private PointsDraw As ClassPoints
>>Private p As ClassPointLiaison
>>Private X1 As Double
>>Private Y1 As Double
>>Private X2 As Double
>>Private Y2 As Double
>>'******
>>
>>
>>Private Sub Command1_Click()
>>
>>'Move the viewport from 1 meter in Y>0 axis
>>
>>mdc.OffsetReal 0, 0, 0, 1
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Command2_Click()
>>mdc.OffsetReal 0, 0, 1, 0
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Command3_Click()
>>mdc.OffsetReal 0, 0, 0, -1
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Command4_Click()
>>mdc.OffsetReal 0, 0, -1, 0
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Command5_Click()
>>
>>'Make a zoom*4
>>' you could translate "Espacereel" as RealSpace
>>
>>X1 = mdc.Espacereelleft
>>X2 = mdc.Espacereelright
>>Y2 = mdc.Espacereeltop
>>Y1 = mdc.Espacereelbottom
>>
>>mdc.zoomReel X1 / 2, Y1 / 2, X2 / 2, Y2 / 2
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Command6_Click()
>>'make a zoom /4
>>X1 = mdc.Espacereelleft
>>X2 = mdc.Espacereelright
>>Y2 = mdc.Espacereeltop
>>Y1 = mdc.Espacereelbottom
>>
>>mdc.zoomReel X1 * 2, Y1 * 2, X2 * 2, Y2 * 2
>>mdc.Refresh
>>End Sub
>>
>>Private Sub Form_Load()
>>Dim i&
>>
>>'Call init proc to give hwnd and hdc from picturebox
>>'implements cls, refresh methode from picturebox
>>Set mdc = New metricDC
>>mdc.Init Picture1
>>'fix viewport
>>'the picturebox will represent this real area (-10 meter, -10 meter
>>'+10 meter, + 10 meter in the picturebox clientrect
>>
>>mdc.zoomReel 0, -50, 100, 50
>>' init points to be draw collection
>>
>>Set PointsDraw = New ClassPoints
>>
>>' fill collection
>>
>>For i& = 0 To 1000
>>
>>Set p = New ClassPointLiaison
>>
>>p.Classpoint_Nom = "A" & Str(i&)
>>p.Classpoint_ID = i&
>>p.Classpoint_X = i& / 10
>>p.Classpoint_Y = 10 * Sin(i& / 100)
>>p.Classpoint_Taille = 0.2
>>PointsDraw.Add p
>>
>>Set p = Nothing
>>
>>Next i&
>>
>>End Sub
>>
>>Private Sub Form_Unload(Cancel As Integer)
>>
>>Set PointsDraw = Nothing
>>Set mdc = Nothing
>>
>>End Sub
>>
>>Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As
>>Single, Y As Single)
>>
>>' how to convert pointer coordinates
>>' in meter coordinates in the real space
>>' translate PeriphReel as DevicetoReal
>>
>>mdc.PeriphReel X, Y
>>
>>' each time you make a coordinate transformation
>>' Xencours (translate as currentX) contain the result in real space
>>' XencoursLog in logical space
>>' Xencoursph in device space
>>
>>X1 = mdc.Xencours
>>Y1 = mdc.Yencours
>>Label1.Caption = "X = " & Str(Round(X1, 2)) & " m ; Y = " &
>>Str(Round(Y1, 2)) & " m"
>>
>>End Sub
>>
>>Private Sub Picture1_Paint()
>>Dim p As Classpoint
>>
>>For Each p In PointsDraw
>>p.Dessine mdc
>>Next p
>>
>>
>>End Sub
>>
>>
>>'*****************
>>'Christophe Vergon
>>'18/11/2004
>>'Projet1.vbp
>>'Classpoint
>>'*****************
>>'Don't use it without the author agreement
>>'*****************
>>
>>Option Explicit
>>
>>Private mX As Double
>>Private mY As Double
>>Private mnom As String
>>Private mKey As Long
>>
>>Private mColor As Long
>>Private mTaille As Double
>>
>>'Private dummy&
>>
>>Private Type POINTGEO
>> X As Double
>> Y As Double
>>End Type
>>Private Type POINTAPI
>>X As Long
>>Y As Long
>>End Type
>>
>>
>>Private Type RECTGEO
>> Left As Double
>> Top As Double
>> Right As Double
>> Bottom As Double
>>End Type
>>'**********************************
>>'** Constant Definitions:
>>
>>
>>Private Const PS_SOLID& = 0
>>
>>Public Property Get X() As Double
>>X = mX
>>End Property
>>
>>Public Property Let X(ByVal vNewValue As Double)
>>mX = vNewValue
>>End Property
>>
>>Public Property Get Y() As Double
>>Y = mY
>>End Property
>>
>>Public Property Let Y(ByVal vNewValue As Double)
>>mY = vNewValue
>>End Property
>>
>>Public Property Get nom() As String
>>nom = mnom
>>End Property
>>
>>Public Property Let nom(ByVal vNewValue As String)
>>mnom = vNewValue
>>End Property
>>
>>Public Property Get id() As Long
>>id = mKey
>>End Property
>>
>>Public Property Let id(ByVal vNewValue As Long)
>>mKey = vNewValue
>>End Property
>>
>>Public Sub translate(dx As Double, dy As Double)
>>mX = mX + dx
>>mY = mY + dy
>>End Sub
>>
>>Public Sub rotate(X As Double, Y As Double, deltagis As Double)
>>Dim p1 As POINTGEO
>>Dim centre As POINTGEO
>>Dim anglerd As Double
>>
>>centre.X = X
>>centre.Y = Y
>>
>>anglerd = deltagis
>>If anglerd < 0 Then anglerd = anglerd + 400
>>anglerd = (pi / 200 * anglerd) + 2 * pi
>>anglerd = (anglerd - (anglerd \ (2 * pi)) * 2 * pi)
>>
>>'on ramene au centre
>>p1.X = mX - centre.X
>>p1.Y = mY - centre.Y
>>
>>'on tourne
>>mX = p1.X * Cos(anglerd) + p1.Y * Sin(anglerd) + centre.X
>>mY = -p1.X * Sin(anglerd) + p1.Y * Cos(anglerd) + centre.Y
>>
>>End Sub
>>
>>Private Function pi() As Double
>>pi = 4 * Atn(1)
>>End Function
>>Public Sub Dessine(mdc As metricDC)
>>
>>End Sub
>>
>>
>>Public Property Get Color() As Long
>>
>> Color = mColor
>>
>>End Property
>>
>>Public Property Let Color(ByVal Color As Long)
>>
>> mColor = Color
>>
>>End Property
>>
>>Public Property Get taille() As Double
>>
>> taille = mTaille
>>
>>End Property
>>
>>Public Property Let taille(ByVal taille As Double)
>>
>> mTaille = taille
>>
>>End Property
>>
>>'*****************
>>'Christophe Vergon
>>'18/11/2004
>>'Projet1.vbp
>>'ClassPointLiaison
>>'*****************
>>'Don't use it without the author agreement
>>'*****************
>>
>>
>>Option Explicit
>>
>>Implements Classpoint
>>
>>Private mclasspoint As Classpoint
>>Private mptrfeuille As Long
>>
>>Private Const PS_SOLID& = 0
>>
>>Private Type POINTAPI
>>X As Long
>>Y As Long
>>End Type
>>
>>Private Type RECTGEO
>> Left As Double
>> Top As Double
>> Right As Double
>> Bottom As Double
>>End Type
>>Private Type POINTGEO
>> X As Double
>> Y As Double
>>End Type
>>Private Declare Function LineTo& Lib "gdi32" (ByVal hdc As Long, ByVal X
>>As Long, ByVal Y As Long)
>>Private Declare Function MoveToEx& Lib "gdi32" (ByVal hdc As Long, ByVal
>>X As Long, ByVal Y As Long, lpPoint As POINTAPI)
>>Private Declare Function Ellipse& Lib "gdi32" (ByVal hdc As Long, ByVal
>>X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
>>Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As
>>Long, ByVal nWidth As Long, ByVal crColor As Long)
>>Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long,
>>ByVal hObject As Long)
>>Private Declare Function BeginPath& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function EndPath& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function StrokePath& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function StrokeAndFillPath& Lib "gdi32" (ByVal hdc As
>
> Long)
>
>>Private Declare Function AbortPath& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function CloseFigure& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function FillPath& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function PathToRegion& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
>>
>>
>>Private Sub Class_Initialize()
>>Set mclasspoint = New Classpoint
>>mclasspoint.taille = 10
>>mclasspoint.Color = RGB(0, 0, 255)
>>End Sub
>>
>>Private Sub Class_Terminate()
>>Set mclasspoint = Nothing
>>End Sub
>>Private Function PinRealRegion(rgn As RECTGEO) As Boolean
>>Dim t As Double
>>If rgn.Left > rgn.Right Then
>>t = rgn.Left
>>rgn.Left = rgn.Right
>>rgn.Right = t
>>End If
>>
>>If rgn.Bottom > rgn.Top Then
>>t = rgn.Bottom
>>rgn.Bottom = rgn.Top
>>rgn.Top = t
>>End If
>>
>>If mclasspoint.X < rgn.Left Then
>>PinRealRegion = False
>>Exit Function
>>Else
>> If mclasspoint.X > rgn.Right Then
>> PinRealRegion = False
>> Exit Function
>> Else
>> If mclasspoint.Y < rgn.Bottom Then
>> PinRealRegion = False
>> Exit Function
>> Else
>> If mclasspoint.Y > rgn.Top Then
>> PinRealRegion = False
>> Exit Function
>> Else
>>
>> PinRealRegion = True
>>
>> End If
>> End If
>> End If
>>
>>End If
>>
>>End Function
>>
>>Private Sub Classpoint_Dessine(mdc As metricDC)
>>Dim p1 As POINTAPI
>>Dim p2 As POINTAPI
>>Dim dummy&
>>Dim OldPen&
>>Dim UsePen&
>>Dim r As RECTGEO
>>Dim p As POINTGEO
>>Dim t&
>>Dim PR As Double
>>
>>r.Bottom = mdc.Espacereelbottom
>>r.Left = mdc.Espacereelleft
>>r.Right = mdc.Espacereelright
>>r.Top = mdc.Espacereeltop
>>
>>p.X = mclasspoint.X
>>p.Y = mclasspoint.X
>>
>>If PinRealRegion(r) Then
>> PR = mdc.DefiniPasReal
>> t& = CLng(mclasspoint.taille / PR)
>> mdc.setmetrique
>> UsePen& = CreatePen(PS_SOLID, 1, mclasspoint.Color)
>> OldPen& = SelectObject(mdc.hdc, UsePen&)
>>
>> p1.X = CLng(((mclasspoint.X - mdc.xT) * 10 ^ 5 * mdc.Echelle))
>> p1.Y = CLng(((mclasspoint.Y - mdc.yT) * 10 ^ 5 * mdc.Echelle))
>>
>>
>> dummy& = BeginPath(mdc.hdc)
>> dummy& = MoveToEx&(mdc.hdc, p1.X - t \ 2, p1.Y - t&, p2)
>> dummy& = LineTo(mdc.hdc, p1.X - t&, p1.Y - t& \ 2)
>> dummy& = LineTo(mdc.hdc, p1.X - t&, p1.Y + t& \ 2)
>> dummy& = LineTo(mdc.hdc, p1.X - t& \ 2, p1.Y + t&)
>> dummy& = LineTo(mdc.hdc, p1.X + t& \ 2, p1.Y + t&)
>> dummy& = LineTo(mdc.hdc, p1.X + t&, p1.Y + t& \ 2)
>> dummy& = LineTo(mdc.hdc, p1.X + t&, p1.Y - t& \ 2)
>> dummy& = LineTo(mdc.hdc, p1.X + t& \ 2, p1.Y - t&)
>> dummy& = CloseFigure(mdc.hdc)
>> dummy& = EndPath(mdc.hdc)
>> dummy& = StrokePath(mdc.hdc)
>> dummy& = MoveToEx&(mdc.hdc, p1.X, p1.Y, p2)
>> dummy& = LineTo(mdc.hdc, p1.X + t& * 3 \ 2, p1.Y)
>> dummy& = MoveToEx&(mdc.hdc, p1.X, p1.Y, p2)
>> dummy& = LineTo(mdc.hdc, p1.X - t& * 3 \ 2, p1.Y)
>> dummy& = MoveToEx&(mdc.hdc, p1.X, p1.Y, p2)
>> dummy& = LineTo(mdc.hdc, p1.X, p1.Y + t& * 3 \ 2)
>> dummy& = MoveToEx&(mdc.hdc, p1.X, p1.Y, p2)
>> dummy& = LineTo(mdc.hdc, p1.X, p1.Y - t& * 3 \ 2)
>>
>> dummy& = SelectObject(mdc.hdc, OldPen&)
>> dummy& = DeleteObject(UsePen&)
>> mdc.exitmetrique
>>With mclasspoint
>>mdc.writetext .nom, .X + .taille, .Y, .taille, 0, 0, True
>>End With
>>
>>End If
>>
>>End Sub
>>
>>Public Property Get Classpoint_ID() As Long
>>Classpoint_ID = mclasspoint.id
>>End Property
>>
>>Public Property Let Classpoint_ID(ByVal RHS As Long)
>>mclasspoint.id = RHS
>>End Property
>>
>>Public Property Get Classpoint_Nom() As String
>>Classpoint_Nom = mclasspoint.nom
>>End Property
>>
>>Public Property Let Classpoint_Nom(ByVal RHS As String)
>>mclasspoint.nom = RHS
>>End Property
>>
>>Private Sub Classpoint_rotate(X As Double, Y As Double, deltagis As
>
> Double)
>
>>mclasspoint.rotate X, Y, deltagis
>>End Sub
>>
>>Private Sub Classpoint_translate(dx As Double, dy As Double)
>>Call mclasspoint.translate(dx, dy)
>>End Sub
>>
>>Public Property Let Classpoint_X(ByVal RHS As Double)
>>mclasspoint.X = RHS
>>End Property
>>
>>Public Property Get Classpoint_X() As Double
>>Classpoint_X = mclasspoint.X
>>End Property
>>
>>Public Property Let Classpoint_Y(ByVal RHS As Double)
>>mclasspoint.Y = RHS
>>End Property
>>
>>Public Property Get Classpoint_Y() As Double
>>Classpoint_Y = mclasspoint.Y
>>End Property
>>
>>Public Property Let Classpoint_Color(ByVal RHS As Long)
>>mclasspoint.Color = RHS
>>End Property
>>
>>Public Property Get Classpoint_Color() As Long
>>Classpoint_Color = Classpoint.Color
>>End Property
>>Public Property Let Classpoint_Taille(ByVal RHS As Double)
>>mclasspoint.taille = RHS
>>End Property
>>
>>Public Property Get Classpoint_Taille() As Double
>>Classpoint_Taille = Classpoint.taille
>>End Property
>>
>>Public Property Get ptrfeuille() As Long
>>
>> ptrfeuille = mptrfeuille
>>
>>End Property
>>
>>Public Property Let ptrfeuille(ByVal ptrfeuille As Long)
>>
>> mptrfeuille = ptrfeuille
>>
>>End Property
>>
>>
>>'*****************
>>'Christophe Vergon
>>'18/11/2004
>>'Projet1.vbp
>>'ClassPoints
>>'*****************
>>'Don't use it without the author agreement
>>'*****************
>>
>>
>>
>>Option Explicit
>>
>>Private m_col As Collection
>>
>>'****************************
>>
>>Public Function Add(p As Classpoint) As Classpoint
>>'p.id = m_col.Count + 1
>>Call m_col.Add(p, Str(p.id))
>>
>>End Function
>>Public Function Item(ByRef v As Variant) As Classpoint
>> Set Item = m_col.Item(v)
>>End Function
>>
>>Public Function Count() As Long
>> Count = m_col.Count
>>End Function
>>
>>Public Sub Delete(ByVal v As Variant)
>>
>> Call m_col.Remove(v)
>>End Sub
>>Public Function NewEnum() As IEnumVARIANT
>> Set NewEnum = m_col.[_NewEnum]
>>End Function
>>
>>Private Sub Class_Initialize()
>>Set m_col = New Collection
>>End Sub
>>
>>Private Sub Class_Terminate()
>>Set m_col = Nothing
>>End Sub
>>
>>
>>Option Explicit
>>
>>
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>' Module : metricDC
>>' DateTime : 17/11/02 17:51
>>' Author : VERGON Christophe
>>' Purpose : Gestion des pictureBox en mode metrique
>>' How to use PictureBox in Metric Mode with API
>>'call init sub to start
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>Const PS_SOLID& = 0
>>Const PS_DOT& = 2
>>Const PS_DASH& = 1
>>Const PS_DASHDOT& = 3
>>Const PS_DASHDOTDOT& = 4
>>Const MM_HIMETRIC& = 3
>>
>>Const FIXED_PITCH = 1
>> Const TA_NOUPDATECP = 0
>> Const TA_UPDATECP = 1
>> Const TA_LEFT = 0
>> Const TA_RIGHT = 2
>> Const TA_CENTER = 6
>> Const TA_TOP = 0
>> Const TA_BOTTOM = 8
>> Const TA_BASELINE = 24
>> Const LF_FACESIZE = 32
>>
>>Private Const SYSTEM_FONT& = 13
>>Private Type LOGFONT
>> lfHeight As Long
>> lfWidth As Long
>> lfEscapement As Long
>> lfOrientation As Long
>> lfWeight As Long
>> lfItalic As Byte
>> lfUnderline As Byte
>> lfStrikeOut As Byte
>> lfCharSet As Byte
>> lfOutPrecision As Byte
>> lfClipPrecision As Byte
>> lfQuality As Byte
>> lfPitchAndFamily As Byte
>> lfFaceName(LF_FACESIZE) As Byte
>>End Type
>>
>>
>>
>>
>>Private Type TEXTMETRIC
>> tmHeight As Long
>> tmAscent As Long
>> tmDescent As Long
>> tmInternalLeading As Long
>> tmExternalLeading As Long
>> tmAveCharWidth As Long
>> tmMaxCharWidth As Long
>> tmWeight As Long
>> tmOverhang As Long
>> tmDigitizedAspectX As Long
>> tmDigitizedAspectY As Long
>> tmFirstChar As Byte
>> tmLastChar As Byte
>> tmDefaultChar As Byte
>> tmBreakChar As Byte
>> tmItalic As Byte
>> tmUnderlined As Byte
>> tmStruckOut As Byte
>> tmPitchAndFamily As Byte
>> tmCharSet As Byte
>>End Type
>>
>>
>>Private Type Size
>> cx As Long
>> cy As Long
>>End Type
>>
>>Private Declare Function CreateFontIndirect& Lib "gdi32" Alias
>>"CreateFontIndirectA" (lpLogFont As LOGFONT)
>>Private Declare Function GetTextFace& Lib "gdi32" Alias "GetTextFaceA"
>>(ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String)
>>Private Declare Function GetTextMetrics& Lib "gdi32" Alias
>>"GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC)
>>Private Declare Function GetTextExtentPoint32& Lib "gdi32" Alias
>>"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal
>>cbString As Long, lpSize As Size)
>>Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal
>>hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String,
>>ByVal nCount As Long)
>>Private Declare Function SetTextAlign& Lib "gdi32" (ByVal hdc As Long,
>>ByVal wFlags As Long)
>>Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal
>>hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As
>>Rect, ByVal wFormat As Long)
>>Private Type POINTAPI
>> X As Long
>> Y As Long
>>End Type
>>
>>Private Type POINTGEO
>> X As Double
>> Y As Double
>>End Type
>>
>>Private Type RECTGEO
>> Left As Double
>> Top As Double
>> Right As Double
>> Bottom As Double
>>End Type
>>
>>Private Type Rect
>> Left As Long
>> Top As Long
>> Right As Long
>> Bottom As Long
>>End Type
>>
>>
>>'**********************************
>>
>>
>>Private mMousepointer As Integer
>>'** Function Declarations:
>>Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor As
>>Long)
>>Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As
>>Long, ByVal nWidth As Long, ByVal crColor As Long)
>>Private Declare Function LineTo& Lib "gdi32" (ByVal hdc As Long, ByVal X
>>As Long, ByVal Y As Long)
>>Private Declare Function MoveToEx& Lib "gdi32" (ByVal hdc As Long, ByVal
>>X As Long, ByVal Y As Long, lpPoint As POINTAPI)
>>Private Declare Function Polyline& Lib "gdi32" (ByVal hdc As Long,
>>lpPoint As POINTAPI, ByVal nCount As Long)
>>Private Declare Function PolylineTo& Lib "gdi32" (ByVal hdc As Long,
>>lppt As POINTAPI, ByVal cCount As Long)
>>Private Declare Function Polygon& Lib "gdi32" (ByVal hdc As Long,
>>lpPoint As POINTAPI, ByVal nCount As Long)
>>Private Declare Function DPtoLP& Lib "gdi32" (ByVal hdc As Long, lpPoint
>>As POINTAPI, ByVal nCount As Long)
>>Private Declare Function LPtoDP& Lib "gdi32" (ByVal hdc As Long, lpPoint
>>As POINTAPI, ByVal nCount As Long)
>>Private Declare Function SetMapMode& Lib "gdi32" (ByVal hdc As Long,
>>ByVal nMapMode As Long)
>>Private Declare Function SetViewportOrgEx& Lib "gdi32" (ByVal hdc As
>>Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
>>Private Declare Function SetWindowOrgEx& Lib "gdi32" (ByVal hdc As Long,
>>ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
>>Private Declare Function RestoreDC& Lib "gdi32" (ByVal hdc As Long,
>>ByVal nSavedDC As Long)
>>Private Declare Function GetClientRect& Lib "user32" (ByVal hwnd As
>>Long, lpRect As Rect)
>>Private Declare Function GetStockObject& Lib "gdi32" (ByVal nIndex As
>
> Long)
>
>>Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long,
>>ByVal hObject As Long)
>>Private Declare Function SaveDC& Lib "gdi32" (ByVal hdc As Long)
>>Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long,
>>ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
>>Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
>>Private Declare Function GetObjectAPI& Lib "gdi32" Alias "GetObjectA"
>>(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any)
>>Private Declare Function SetPixelV& Lib "gdi32" (ByVal hdc As Long,
>>ByVal X As Long, ByVal Y As Long, ByVal crColor As Long)
>>Private Declare Function Ellipse& Lib "gdi32" (ByVal hdc As Long, ByVal
>>X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
>>Private Declare Function CreateRectRgn& Lib "gdi32" (ByVal X1 As Long,
>>ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
>>Private Declare Function SelectClipRgn& Lib "gdi32" (ByVal hdc As Long,
>>ByVal hRgn As Long)
>>Private Declare Function SetROP2& Lib "gdi32" (ByVal hdc As Long, ByVal
>>nDrawMode As Long)
>>Private Declare Function GetROP2& Lib "gdi32" (ByVal hdc As Long)
>>
>>
>>
>>
>>
>>
>>Private Const R2_COPYPEN& = 13
>>Private mrectdessin As Rect
>>Private mypoint As POINTAPI
>>Private MyGeoPoint As POINTGEO
>>Private mespacereel As RECTGEO
>>Private mDimensionEspaceLogique
>>Private mYlog As Long
>>Private mXlog As Long
>>Private mYlogique As Long
>>Private mXlogique As Long
>>Private mX As Double
>>Private mY As Double
>>Private mXph As Long
>>Private mYph As Long
>>Private mxT As Double
>>Private myT As Double
>>Private mEchelle As Double
>>Private mViewOrgX As Long
>>Private mviewOrgY As Long
>>Private mviewExtX As Long
>>Private mviewExtY As Long
>>Private mWinOrgX As Long
>>Private mWinOrgY As Long
>>Private mWinExtX As Long
>>Private mWinExtY As Long
>>Private m_savedDC&
>>Private mrectText As Rect
>>Private mespaceText As RECTGEO
>>Private MaxlogPoint() As POINTAPI
>>Private lpPoint() As POINTAPI
>>Private mlpgeo() As POINTGEO
>>Private dummy&
>>
>>
>>Private mPicture As PictureBox
>>
>>
>>
>>
>>
>>Public Sub Init(Picture1 As PictureBox)
>>Dim pt As POINTAPI
>>
>>Set mPicture = Picture1
>>
>>mPicture.ScaleMode = 3
>>
>>
>>espaceclient
>>
>> mViewOrgX = 0&
>> mviewOrgY = mrectdessin.Bottom - mrectdessin.Top
>> mWinOrgX = 0
>> mWinOrgY = 0
>> mxT = 0
>> myT = 0
>> mEchelle = 1 / 1000
>>setmetrique
>>ReDim MaxlogPoint(0)
>> MaxlogPoint(0).X = mrectdessin.Right
>> MaxlogPoint(0).Y = mrectdessin.Top
>> dummy& = DPtoLP(mPicture.hdc&, MaxlogPoint(0), 1)
>> pt.X = 0: pt.Y = 0
>> mYlogique = MaxlogPoint(0).Y
>> mXlogique = MaxlogPoint(0).X
>> mDimensionEspaceLogique = DistanceAPI(pt, MaxlogPoint(0))
>> MyGeoPoint = LtoR(MaxlogPoint(0))
>> mespacereel.Right = MyGeoPoint.X
>> mespacereel.Top = MyGeoPoint.Y
>> MyGeoPoint = LtoR(pt)
>> mespacereel.Bottom = MyGeoPoint.X
>> mespacereel.Left = MyGeoPoint.Y
>>exitmetrique
>> zoomReel 0, 0, 1000, 1000
>>End Sub
>>
>>Public Sub setmetrique()
>>
>>
>>m_savedDC& = SaveDC&(mPicture.hdc)
>>
>> dummy& = SetMapMode&(mPicture.hdc, MM_HIMETRIC)
>> dummy& = SetViewportOrgEx&(mPicture.hdc, mViewOrgX, mviewOrgY,
>>mypoint)
>> dummy& = SetWindowOrgEx&(mPicture.hdc, mWinOrgX, mWinOrgY,
>
> mypoint)
>
>>End Sub
>>Public Sub exitmetrique()
>>m_savedDC& = RestoreDC(mPicture.hdc, m_savedDC&)
>>End Sub
>>Public Sub PeriphReel(X As Single, Y As Single)
>>setmetrique
>>ReDim lpPoint(0)
>>ReDim mlpgeo(0)
>>lpPoint(0).X = CLng(X)
>>lpPoint(0).Y = CLng(Y)
>>dummy& = DPtoLP(mPicture.hdc&, lpPoint(0), 1)
>>mlpgeo(0) = LtoR(lpPoint(0))
>>mX = mlpgeo(0).X
>>mY = mlpgeo(0).Y
>>'retour dc à vb
>>exitmetrique
>>End Sub
>>Public Sub ReelPeriph(X As Double, Y As Double)
>>setmetrique
>> ReDim mlpgeo(0)
>> mlpgeo(0).X = X
>> mlpgeo(0).Y = Y
>> ReDim lpPoint(0)
>> lpPoint(0) = RtoL(mlpgeo(0))
>> dummy& = LPtoDP(mPicture.hdc&, lpPoint(0), 1)
>> mXph = lpPoint(0).X
>> mYph = lpPoint(0).Y
>>exitmetrique
>>End Sub
>>Public Sub ReelLogiq(X As Double, Y As Double)
>>setmetrique
>> ReDim mlpgeo(0)
>> mlpgeo(0).X = X
>> mlpgeo(0).Y = Y
>> ReDim lpPoint(0)
>> lpPoint(0) = RtoL(mlpgeo(0))
>> mXlog = lpPoint(0).X
>> mYlog = lpPoint(0).Y
>>exitmetrique
>>End Sub
>>Public Sub LogiqToReel(X As Long, Y As Long)
>>setmetrique
>> ReDim lpPoint(0)
>> ReDim mlpgeo(0)
>> lpPoint(0).X = X
>> lpPoint(0).Y = Y
>> mlpgeo(0) = LtoR(lpPoint(0))
>> mX = mlpgeo(0).X
>> mY = mlpgeo(0).Y
>>exitmetrique
>>End Sub
>>Public Sub espaceclient()
>>Dim dummy&
>>dummy& = GetClientRect&(mPicture.hwnd, mrectdessin)
>>End Sub
>>
>>
>>
>>Private Function RtoL(p As POINTGEO) As POINTAPI
>>Dim X As Long, Y As Long
>>Dim X1 As Double, Y1 As Double
>>
>>
>>
>>X1 = ((p.X - mxT) * 10 ^ 5 * mEchelle)
>>Y1 = ((p.Y - myT) * 10 ^ 5 * mEchelle)
>>On Error Resume Next
>>Err.Clear
>>X = CLng(X1)
>>If Err.Number = 6 Then
>>X = -32765
>>Err.Clear
>>End If
>>Y = CLng(Y1)
>>If Err.Number = 6 Then
>>Y = -32765
>>Err.Clear
>>End If
>>On Error GoTo 0
>>
>>
>>If p.X < mxT Then
>>RtoL.X = -32765
>>X = -32765
>>End If
>>If p.Y < myT Then
>>RtoL.Y = -32765
>>Y = -32765
>>End If
>>
>>If X > 32765 Then
>>RtoL.X = 32765
>>Else
>>RtoL.X = X
>>End If
>>
>>If Y > 32765 Then
>>RtoL.Y = 32765
>>Else
>>RtoL.Y = Y
>>End If
>>
>>'RtoL.x = x
>>'RtoL.y = y
>>End Function
>>Private Function LtoR(p As POINTAPI) As POINTGEO
>>LtoR.X = p.X / (mEchelle * 10 ^ 5) + mxT
>>LtoR.Y = p.Y / (mEchelle * 10 ^ 5) + myT
>>
>>End Function
>>Public Sub zoomPh(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single)
>>espaceclient
>>setmetrique
>>ReDim lpPoint(1)
>> ReDim mlpgeo(1)
>> lpPoint(1).X = CLng(X2)
>> lpPoint(1).Y = CLng(Y2)
>> lpPoint(0).X = CLng(X1)
>> lpPoint(0).Y = CLng(Y1)
>>
>> dummy& = DPtoLP(mPicture.hdc&, lpPoint(0), 2)
>> mlpgeo(0) = LtoR(lpPoint(0))
>> mlpgeo(1) = LtoR(lpPoint(1))
>>
>>If mlpgeo(0).X < mlpgeo(1).X Then
>> mespacereel.Left = mlpgeo(0).X
>> mespacereel.Right = mlpgeo(1).X
>> Else
>> mespacereel.Left = mlpgeo(1).X
>> mespacereel.Right = mlpgeo(0).X
>> End If
>>
>> If mlpgeo(0).Y < mlpgeo(1).Y Then
>> mespacereel.Bottom = mlpgeo(0).Y
>> mespacereel.Top = mlpgeo(1).Y
>> Else
>> mespacereel.Bottom = mlpgeo(1).Y
>> mespacereel.Top = mlpgeo(0).Y
>> End If
>>
>> mEchelle = mDimensionEspaceLogique / (DistanceGEO(mlpgeo(0),
>>mlpgeo(1)) * 10 ^ 5)
>>
>> mxT = mespacereel.Left
>> myT = mespacereel.Bottom
>>
>> lpPoint(1).X = mrectdessin.Right
>> lpPoint(1).Y = mrectdessin.Top
>> dummy& = DPtoLP(mPicture.hdc&, lpPoint(0), 2)
>> mlpgeo(1) = LtoR(lpPoint(1))
>> mespacereel.Right = mlpgeo(1).X
>> mespacereel.Top = mlpgeo(1).Y
>> exitmetrique
>>End Sub
>>Public Sub Offset(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single)
>>espaceclient
>>setmetrique
>>ReDim lpPoint(1)
>> ReDim mlpgeo(1)
>> lpPoint(1).X = CLng(X2)
>> lpPoint(1).Y = CLng(Y2)
>> lpPoint(0).X = CLng(X1)
>> lpPoint(0).Y = CLng(Y1)
>>
>> dummy& = DPtoLP(mPicture.hdc&, lpPoint(0), 2)
>> mlpgeo(0) = LtoR(lpPoint(0))
>> mlpgeo(1) = LtoR(lpPoint(1))
>>mespacereel.Bottom = mespacereel.Bottom + (mlpgeo(0).Y - mlpgeo(1).Y)
>>mespacereel.Left = mespacereel.Left + (mlpgeo(0).X - mlpgeo(1).X)
>>mespacereel.Right = mespacereel.Right + (mlpgeo(0).X - mlpgeo(1).X)
>>mespacereel.Top = mespacereel.Top + (mlpgeo(0).Y - mlpgeo(1).Y)
>> mxT = mespacereel.Left
>> myT = mespacereel.Bottom
>>exitmetrique
>>End Sub
>>
>>Public Sub OffsetReal(X1 As Double, Y1 As Double, X2 As Double, Y2 As
>>Double)
>>
>>
>>
>>mespacereel.Bottom = mespacereel.Bottom + (Y1 - Y2)
>>mespacereel.Left = mespacereel.Left + (X1 - X2)
>>mespacereel.Right = mespacereel.Right + (X1 - X2)
>>mespacereel.Top = mespacereel.Top + (Y1 - Y2)
>>mxT = mespacereel.Left
>>myT = mespacereel.Bottom
>>
>>End Sub
>>Public Sub zoomReel(X1 As Double, Y1 As Double, X2 As Double, Y2 As
>
> Double)
>
>>If X1 = 0 And X2 = 0 And Y1 = 0 And Y2 = 0 Then Exit Sub
>>
>>espaceclient
>>setmetrique
>>ReDim lpPoint(1)
>>ReDim mlpgeo(1)
>>mlpgeo(0).X = mespacereel.Left
>>mlpgeo(1).X = mespacereel.Right
>>mlpgeo(0).Y = mespacereel.Bottom
>>mlpgeo(1).Y = mespacereel.Top
>>lpPoint(0) = RtoL(mlpgeo(0))
>>lpPoint(1) = RtoL(mlpgeo(1))
>>
>>ReDim mlpgeo(1)
>>mlpgeo(0).X = X1
>>mlpgeo(1).X = X2
>>mlpgeo(0).Y = Y1
>>mlpgeo(1).Y = Y2
>>mxT = X1
>>myT = Y1
>>mEchelle = DimensionEspaceLogique / (DistanceGEO(mlpgeo(0), mlpgeo(1)) *
>>10 ^ 5)
>>mlpgeo(0) = LtoR(lpPoint(0))
>>mlpgeo(1) = LtoR(lpPoint(1))
>>
>>mespacereel.Left = mlpgeo(0).X
>>mespacereel.Right = mlpgeo(1).X
>>mespacereel.Bottom = mlpgeo(0).Y
>>mespacereel.Top = mlpgeo(1).Y
>>exitmetrique
>>End Sub
>>
>>
>>
>>Public Sub linereal(X1 As Double, Y1 As Double, X2 As Double, Y2 As
>>Double, couleur As Long, Optional mode As Long = 13)
>>Dim p1 As POINTGEO
>>Dim p2 As POINTGEO
>>Dim ap1 As POINTAPI
>>Dim ap2 As POINTAPI
>>Dim OldPen&
>>Dim UsePen&
>>Dim dummy&
>>Dim oldmode&
>>
>>p1.X = X1
>>p1.Y = Y1
>>p2.X = X2
>>p2.Y = Y2
>>setmetrique
>>
>>oldmode = SetROP2(mPicture.hdc, mode)
>>
>>UsePen& = CreatePen(PS_SOLID, 1, couleur)
>>OldPen& = SelectObject(mPicture.hdc&, UsePen&)
>>ap1 = RtoL(p1)
>>ap2 = RtoL(p2)
>>
>>'Debug.Print "Xd " & Str(ap1.x) & " Yd " & Str(ap1.Y)
>>dummy& = MoveToEx&(mPicture.hdc&, ap1.X, ap1.Y, ap1)
>>dummy& = LineTo(mPicture.hdc&, ap2.X, ap2.Y)
>>
>>'Debug.Print "Xf " & Str(ap2.x) & " Yf " & Str(ap2.Y)
>>
>>dummy& = SelectObject(mPicture.hdc&, OldPen&)
>>dummy& = DeleteObject(UsePen&)
>>dummy& = SetROP2(mPicture.hdc, oldmode)
>>exitmetrique
>>
>>End Sub
>>
>>Public Sub linepheriph(X1 As Single, Y1 As Single, X2 As Single, Y2 As
>>Single, couleur As Long, Optional mode As Long = 13)
>>Dim ap(1) As POINTAPI
>>Dim OldPen&
>>Dim UsePen&
>>Dim dummy&
>>Dim oldmode&
>>
>>ap(0).X = CLng(X1)
>>ap(0).Y = CLng(Y1)
>>ap(1).X = CLng(X2)
>>ap(1).Y = CLng(Y2)
>>
>>setmetrique
>>
>>oldmode = SetROP2(mPicture.hdc, mode)
>>
>>UsePen& = CreatePen(PS_SOLID, 1, couleur)
>>OldPen& = SelectObject(mPicture.hdc&, UsePen&)
>>
>>dummy& = DPtoLP(mPicture.hdc, ap(0), 2)
>>
>>'Debug.Print "Xd " & Str(ap1.x) & " Yd " & Str(ap1.Y)
>>dummy& = MoveToEx&(mPicture.hdc&, ap(0).X, ap(0).Y, ap(0))
>>dummy& = LineTo(mPicture.hdc&, ap(1).X, ap(1).Y)
>>
>>'Debug.Print "Xf " & Str(ap2.x) & " Yf " & Str(ap2.Y)
>>
>>dummy& = SelectObject(mPicture.hdc&, OldPen&)
>>dummy& = DeleteObject(UsePen&)
>>dummy& = SetROP2(mPicture.hdc, oldmode)
>>exitmetrique
>>
>>End Sub
>>
>>
>>
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>' Procedure : DefiniCompteur
>>' DateTime : 18/09/03 11:49
>>' Author : VERGON Christophe
>>' Purpose : valeur min des x=0 calcul valeur max
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>'
>>Public Function DefiniCompteur() As Long
>>Dim p1 As POINTGEO
>>Dim p As POINTAPI
>>
>>p1.X = mespacereel.Right
>>p1.Y = mespacereel.Bottom
>>p = RtoL(p1)
>>DefiniCompteur = p.X
>>
>>End Function
>>
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>' Procedure : DefiniPasReal
>>' DateTime : 18/09/03 11:50
>>' Author : VERGON Christophe
>>' Purpose : Valeur de l'increment en x en fonction du zoom
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>'
>>Public Function DefiniPasReal() As Double
>>Dim p1 As POINTGEO
>>Dim p2 As POINTGEO
>>Dim pa1 As POINTAPI
>>Dim pa2 As POINTAPI
>>setmetrique
>>pa1.X = 0
>>pa2.X = 1
>>p1 = LtoR(pa1)
>>p2 = LtoR(pa2)
>>DefiniPasReal = p2.X - p1.X
>>exitmetrique
>>End Function
>>Public Function PixelScreen() As Double
>>Dim p1 As POINTGEO
>>Dim p2 As POINTGEO
>>Dim pa(1) As POINTAPI
>>
>>Dim dummy&
>>
>>setmetrique
>>
>>pa(0).X = 0
>>pa(0).Y = 0
>>pa(1).X = 1
>>pa(1).Y = 0
>>
>>dummy& = DPtoLP(mPicture.hdc, pa(0), 2)
>>p1 = LtoR(pa(0))
>>p2 = LtoR(pa(1))
>>PixelScreen = p2.X - p1.X
>>exitmetrique
>>
>>End Function
>>
>>
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>' Procedure : DessinePointFonction
>>' DateTime : 18/09/03 11:50
>>' Author : VERGON Christophe
>>' Purpose : dessine le point réel P dans le DC avec la couleur Color
>>
>
> '---------------------------------------------------------------------------
> ------------
>
>>'
>>Public Sub DessinePointFonction(X As Double, Y As Double, Color As Long)
>>Dim p1 As POINTAPI
>>Dim p As POINTGEO
>>
>>p.X = X
>>p.Y = Y
>>p1 = RtoL(p)
>>setmetrique
>>dummy& = SetPixelV(mPicture.hdc, p1.X, p1.Y, Color)
>>exitmetrique
>>End Sub
>>Private Function DistanceGEO(p1 As POINTGEO, p2 As POINTGEO) As Double
>>Dim X, Y As Double
>>
>>X = p2.X - p1.X
>>Y = p2.Y - p1.Y
>>DistanceGEO = Sqr(X * X + Y * Y)
>>End Function
>>
>>Private Function DistanceAPI(p1 As POINTAPI, p2 As POINTAPI) As Double
>>Dim X, Y As Double
>>
>>X = p2.X - p1.X
>>Y = p2.Y - p1.Y
>>DistanceAPI = Sqr(X * X + Y * Y)
>>
>>End Function
>>
>>Private Function PinRealRegion(p As POINTGEO, rgn As RECTGEO) As Boolean
>>Dim t As Double
>>If rgn.Left > rgn.Right Then
>>t = rgn.Left
>>rgn.Left = rgn.Right
>>rgn.Right = t
>>End If
>>
>>If rgn.Bottom > rgn.Top Then
>>t = rgn.Bottom
>>rgn.Bottom = rgn.Top
>>rgn.Top = t
>>End If
>>
>>If p.X < rgn.Left Then
>>PinRealRegion = False
>>Exit Function
>>Else
>> If p.X > rgn.Right Then
>> PinRealRegion = False
>> Exit Function
>> Else
>> If p.Y < rgn.Bottom Then
>> PinRealRegion = False
>> Exit Function
>> Else
>> If p.Y > rgn.Top Then
>> PinRealRegion = False
>> Exit Function
>> Else
>>
>> PinRealRegion = True
>>
>> End If
>> End If
>> End If
>>
>>End If
>>
>>End Function
>>Public Sub Refresh()
>>mPicture.Refresh
>>End Sub
>>
>>Public Function writetext(MyText As String, X As Double, Y As Double,
>>taille As Double, align As Long, angle As Double, affiche As Boolean)
>>Dim lf As LOGFONT
>>Dim oldfont&
>>Dim alignorigin&
>>Dim newfont&
>>
>>Dim di&
>>Dim pointattache As POINTAPI
>>Dim pointlog As POINTAPI
>>Dim p As POINTGEO
>>Dim SI As Size
>>
>>setmetrique
>>p.X = X
>>p.Y = Y
>>pointattache = RtoL(p)
>>p.X = X + taille
>>p.Y = Y + taille
>>pointlog = RtoL(p)
>>
>>'Police logique courante par selection police systeme
>>oldfont& = SelectObject(mPicture.hdc, GetStockObject(0))
>>di& = GetObjectAPI(oldfont&, Len(lf), lf)
>>
>>'rétablit la police de départ
>>di& = SelectObject(mPicture.hdc, oldfont&)
>>
>>'stocke l'alignement d'origine
>>Select Case align
>>Case 0
>>alignorigin& = SetTextAlign(mPicture.hdc, TA_LEFT Or TA_BOTTOM Or
>>TA_UPDATECP)
>>Case 1
>>alignorigin& = SetTextAlign(mPicture.hdc, TA_RIGHT Or TA_BOTTOM Or
>>TA_UPDATECP)
>>Case 2
>>alignorigin& = SetTextAlign(mPicture.hdc, TA_CENTER Or TA_BOTTOM Or
>>TA_UPDATECP)
>>End Select
>>
>>lf.lfHeight = pointlog.Y - pointattache.Y
>>lf.lfEscapement = -1 * Round(angle * 10, 0)
>>newfont& = CreateFontIndirect(lf)
>>oldfont& = SelectObject(mPicture.hdc, newfont&)
>>di& = GetTextExtentPoint32(mPicture.hdc, MyText, Len(MyText), SI)
>>mrectText.Bottom = pointattache.Y
>>mrectText.Top = mrectText.Bottom + SI.cy
>>mrectText.Left = pointattache.X - SI.cx / 2
>>mrectText.Right = mrectText.Left + SI.cx
>>ConvertEspaceText
>>If affiche Then
>>di& = MoveToEx&(mPicture.hdc, pointattache.X, pointattache.Y, pointlog)
>>di& = TextOut(mPicture.hdc, 0, 0, MyText, Len(MyText))
>>End If
>>di& = SelectObject(mPicture.hdc, oldfont&)
>>
>>DeleteObject (newfont&)
>>
>>exitmetrique
>>End Function
>>Public Property Get Espacereeltop() As Double
>>Espacereeltop = mespacereel.Top
>>End Property
>>Private Sub ConvertEspaceText()
>>Dim p As POINTGEO
>>Dim PL As POINTAPI
>>
>>'doit etre appelé par une foncvtion ayant effectué setmetrique
>>
>>PL.X = mrectText.Left
>>PL.Y = mrectText.Bottom
>>p = LtoR(PL)
>>mespaceText.Left = p.X
>>mespaceText.Bottom = p.Y
>>
>>PL.X = mrectText.Right
>>PL.Y = mrectText.Top
>>p = LtoR(PL)
>>mespaceText.Right = p.X
>>mespaceText.Top = p.Y
>>
>>End Sub
>>Public Property Get Espacereelleft() As Double
>>Espacereelleft = mespacereel.Left
>>End Property
>>Public Property Get Espacereelright() As Double
>>Espacereelright = mespacereel.Right
>>End Property
>>Public Property Get Espacereelbottom() As Double
>>Espacereelbottom = mespacereel.Bottom
>>End Property
>>
>>Public Property Get Echelle() As Double
>>Echelle = mEchelle
>>End Property
>>
>>Public Property Get xT() As Double
>>xT = mxT
>>End Property
>>
>>Public Property Get yT() As Double
>>yT = myT
>>End Property
>>Public Property Get DimensionEspaceLogique() As Long
>>DimensionEspaceLogique = mDimensionEspaceLogique
>>End Property
>>
>>Public Property Let DimensionEspaceLogique(ByVal vNewValue As Long)
>>mDimensionEspaceLogique = vNewValue 'DimensionEspaceLogique
>>End Property
>>
>>
>>
>>
>>Public Property Get Xencours() As Double
>>Xencours = mX
>>End Property
>>Public Property Get Yencours() As Double
>>Yencours = mY
>>End Property
>>Public Property Get XencoursPh() As Long
>>XencoursPh = mXph
>>End Property
>>Public Property Get yencoursph() As Double
>>yencoursph = mYph
>>End Property
>>Public Property Get XencoursLog() As Double
>>XencoursLog = mXlog
>>End Property
>>Public Property Get YencoursLog() As Double
>>YencoursLog = mYlog
>>End Property
>>
>>Private Sub Class_Terminate()
>>
>>Set mPicture = Nothing
>>End Sub
>>
>>
>>
>>Public Property Get hdc() As Long
>>
>> hdc = mPicture.hdc
>>
>>End Property
>>
>>
>>
>>Public Property Get Mousepointer() As Integer
>>
>> Mousepointer = mPicture.Mousepointer
>>
>>End Property
>>
>>Public Property Let Mousepointer(ByVal Mousepointer As Integer)
>>
>> mPicture.Mousepointer = Mousepointer
>>
>>End Property
>>
>>
>>
>>Amrit a écrit :
>>
>>>Hi All
>>>
>>>How to set DC Size within Rect. for Zoom Window.
>>>
>>>Thanks
>>>Amrit
>>>
>>>
>
>
>
>

Loading