VB Crystal Report, Images on a horozontal line

1. Removin grid lines from images - VB.Net

2. Move images and lines on a picturebox....

Hi All,

I have been trying to place images and lines on a picturebox and move
them around.
I place a picture2 and a Label1 on a form. Both indexes set to 0.
I also use a ImageList1 with 7 images. Now I place an icon in the
middle of the form and want to draw some additional images in a circle
around the middle one. All the images are connected through a line with
the middle image. When I try to move the images the line gets moved as
well but the old lines don't dissapear, so I end up with a lot of noise
on the form.

Option Explicit

Private Type LINKDATA
    pIcon As Long
    sLabel As String
    sLabel2 As String
    szTip As String * 128
    sID As String
    sLink As String
End Type

Private Const OPAQUE = 2
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private dragging As Boolean
Private xpos As Single, ypos As Single
Private xmouse As Single, ymouse As Single
Private xOffset As Single, yOffset As Single
Dim MyData() As LINKDATA
Dim MyDataCount As Long
Dim c As Long
Dim sChosenItem As String

Private Sub Form_Load()

Dim theName As String

  If Me.Tag <> "fixed" Then
     Me.Move 0, 0, Form1.ScaleWidth, Form1.ScaleHeight
     Me.Tag = "fixed"
  End If

'Set rs = dbfASIC.OpenRecordset(SearchStr, dbOpenDynaset)
'If rs.RecordCount <> 0 Then

    Font.Size = 8
    'theName = rs.Fields("BID")
    DisplayPictureBox Me.ImageList1.ListImages(1).Picture, 1,
Me.ScaleWidth \ 2, Me.ScaleHeight \ 2, UCase("LASTNAME") & ", " &
"firstname", "test1", "test2"
'    Me.Caption = "Link Analysis - " & _
    UCase(rs.Fields("family_name")) & ", " & rs.Fields("first_name")
    Call LoadPeople(theName)

'End If   'recordcount <> 0

End Sub

Private Function GetCirclePoints( _
    ByVal inNumPoints As Long, ByVal inRadius As Long, _
    Optional ByVal inXOff As Long = 0, _
    Optional ByVal inYOff As Long = 0, _
    Optional ByVal inOffsetRotation As Long = 0) As POINTAPI()

    Dim RetArr() As POINTAPI, LoopPts As Long
    Dim Radians As Double

    Const Pi As Double = 3.14159
    Const TwoPi As Double = Pi * 2

    If (inNumPoints > 0) Then ' Allocate return array
        ReDim RetArr(1 To inNumPoints) As POINTAPI

        For LoopPts = 1 To inNumPoints ' Calculate coordinates of each
point
            Radians = ((LoopPts / inNumPoints) + (inOffsetRotation /
360)) * TwoPi
            RetArr(LoopPts).X = (Cos(Radians) * inRadius) + inXOff
            RetArr(LoopPts).Y = (Sin(Radians) * inRadius) + inYOff
        Next LoopPts

        ' Return point array
        GetCirclePoints = RetArr
    End If
End Function

Private Sub Form_MouseDown(ByRef Button As Integer, _
    ByRef Shift As Integer, ByRef X As Single, ByRef Y As Single)

Dim TestBox As Box

'If (Button = vbLeftButton) Then
    For Each TestBox In Boxes ' Hit test each box
        If ((X >= TestBox.X) And (Y >= TestBox.Y) And _
            (X < (TestBox.X + Me.ScaleX(TestBox.stdPic.Width,
vbHimetric, Me.ScaleMode))) And _
            (Y < (TestBox.Y + Me.ScaleY(TestBox.stdPic.Height,
vbHimetric, Me.ScaleMode)))) Then
            Set User = TestBox
            Exit For
        End If
    Next TestBox
'End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)

Dim iIndex As Long

If Not User Is Nothing Then
   User.X = X - 90
   User.Y = Y - 90
   sChosenItem = User.Id
   Refresh
End If
If (Button = vbRightButton) Then
    cP.Restore "cPopMenu1"
    iIndex = cP.ShowPopupMenu(X, Y)
End If
Set User = Nothing

End Sub

Private Sub Form_Paint()

Dim I
Dim oldmode As Long, OldCol As Long

Cls
oldmode = SetBkMode(Me.hDC, OPAQUE)
OldCol = SetBkColor(Me.hDC, vbWhite)

For Each I In Ropes
  I.Draw Me
Next
For Each I In Boxes
  I.Draw Me
Next

End Sub

Private Sub EnlargeMyDataIfNeeded(ByRef a() As LINKDATA, ByVal Index As
Long)

    Dim NewSize As Long
    Dim I As Long

    On Error Resume Next
    NewSize = UBound(a)
    If Err.Number = 9 Then ' Subscript out of range
        ' Array was not dimmed before
        Err.Clear
    End If

    On Error GoTo 0 ' Let VB show us subsequent errors
    If Index > NewSize Then
        ' Enlarge the array in 100 steps
        ReDim Preserve a(1 To Index + 100)
    End If
End Sub
Private Function LoadPeople(sID As String)

Dim CircPts() As POINTAPI
Dim LoopPts As Long
Dim CircleHeight As Long
Dim strBio As String
Dim I As Long

CircleHeight = (Me.ScaleHeight - 1500) \ 2

MyDataCount = 4

Call FillArray(strBio, 1, 5, "Biographies")
CircPts = GetCirclePoints(5, CircleHeight, Me.ScaleWidth \ 2,
Me.ScaleHeight \ 2)

For LoopPts = 1 To MyDataCount
    With CircPts(LoopPts)
      Font.Size = 24
      DisplayPictureBox Me.ImageList1.ListImages(1).Picture, 2, .X, .Y,
"LASTNAME" & ", " & "firstname", "test1", "test2"
      Font.Size = 8
      If MyData(LoopPts).pIcon = 1 Then  'Bios
         Me.Line (Me.ScaleWidth \ 2, Me.ScaleHeight \ 2)-(.X, .Y),
vb3DShadow
      End If
    End With
Next LoopPts

End Function


Private Function FillArray(strSQL As String, lIcon As Long, lDataCnt As
Long, sEntity As String)

   MyDataCount = MyDataCount + 1
   EnlargeMyDataIfNeeded MyData, MyDataCount
   MyData(MyDataCount).pIcon = lIcon
      MyData(MyDataCount).sLabel = UCase("MY LASTNAME") & ", " &
"first_name"
      MyData(MyDataCount).sLabel2 = ""
      MyData(MyDataCount).szTip = "DIt is een tooltip" & Chr$(0)
      MyData(MyDataCount).sID = "B" & MyDataCount
      MyData(MyDataCount).sLink = "Dit is een link"

End Function


Private Sub DisplayPictureBox(NewImage As StdPicture, Index As Long, _
XStart As Long, YStart As Long, sText As String, sType As String, sCat
As String)

Dim PB As PictureBox
Dim textWide As Single, textHigh As Single
Dim textWide2 As Single

If Index > Picture2.UBound Then Load Picture2(Index)
If Index > Label1.UBound Then Load Label1(Index)
Set PB = Picture2(Index)

PB.AutoRedraw = True

With PB
  'Set .Picture = NewImage [this line not now required]
  .ScaleMode = vbPixels
  With .Font
    .Name = "MS Sans Serif"
    .Size = 8
  End With
  textWide = .TextWidth(sType)
  textHigh = .TextHeight(sType)
  textWide2 = .TextWidth(sCat)
  If textWide2 > textWide Then
     textWide = textWide2
  End If
  .Left = XStart
  .Top = YStart
  Label1(Index).Left = .Left + (.Width - Label1(Index).Width) / 2
  Label1(Index).Top = .Top + .Height
  .BorderStyle = 0
  .Visible = True
  .AutoRedraw = True
  .ToolTipText = sText
  .BackColor = vbWhite

  If textWide > 32 Then
    .Width = .ScaleX(textWide, vbPixels, .Container.ScaleMode)
    .CurrentX = 0
    .PaintPicture NewImage, (.ScaleWidth - 32) / 2, 0, 32, 32
  Else
    .Width = .ScaleX(32, vbPixels, .Container.ScaleMode)
    .CurrentX = (.ScaleWidth - textWide) / 2
    .PaintPicture NewImage, 0, 0, 32, 32
  End If
  .Height = .ScaleX(32, vbPixels, .Container.ScaleMode)
  .CurrentX = (.ScaleWidth - .TextWidth(sType)) / 2
  Label1(Index).Visible = True
  Label1(Index).ForeColor = vbBlack
  Label1(Index).Caption = sType & vbCrLf & sCat
End With

End Sub

Private Sub Picture2_MouseDown(Index As Integer, Button As Integer,
Shift As Integer, X As Single, Y As Single)

xmouse = X
ymouse = Y
xOffset = Picture2(Index).Left - Label1(Index).Left
yOffset = Picture2(Index).Top - Label1(Index).Top
dragging = True

End Sub

Private Sub Picture2_MouseMove(Index As Integer, Button As Integer,
Shift As Integer, X As Single, Y As Single)

Dim x1 As Single, y1 As Single
If dragging Then
  x1 = Picture2(Index).Left + X - xmouse
  y1 = Picture2(Index).Top + Y - ymouse
  If (Picture2(Index).Left <> x1) Or (Picture2(Index).Top <> y1) Then
    Picture2(Index).Move x1, y1
    Label1(Index).Move x1 - xOffset, y1 - yOffset
    Me.Line (Me.ScaleWidth \ 2, Me.ScaleHeight \ 2)-(x1, y1),
vb3DShadow
  End If
End If

End Sub

Private Sub Picture2_MouseUp(Index As Integer, Button As Integer, Shift
As Integer, X As Single, Y As Single)

dragging = False

End Sub

Marco

3. Line control over 3rd party Image control - Visual Basic/VB

4. Resize In-line images with VB ?

I am trying to resize in-line images using VB. I had limited success with the 
code below (found online and in the help index I am not a VB programer). 
Within a set of 3 images, the first two were reduced 80% but the third one 
got larger (112%). Note: These images have been pasted into Word from another 
program.  I can have up to 100 images in repetative reports that I need to 
shrink so any help would be appreciated.

Sub ResetImages()

    For Each ishape In ActiveDocument.InlineShapes
    ishape.ScaleWidth = 80
    ishape.ScaleHeight = 80

Next ishape

End Sub

5. Images print with leading line - Word VBA

6. Drawing lines using Image Editor toolbar

Hi,

  I need to draw a line on a windows form in my project using Visual
Basic .Net 2003. My preference would be to use a toolbar rather than
code, if possible. I was able draw lines on forms using Visual Basic
6.0 with no problem but now for some reason the line tools are grayed
out on the Image Editor toolbar in .Net 2003. Does anyone know if it
is possible to do this using a tool bar in Visual Studio .Net 2003 or
will I need to code it instead?
  I have been seaching Technet, MSDN, and the Knowledge Base for 2
days and cannot find an answer.

  Thanks,
  Rob

7. Making 1 line text objects line up with a 5 line text object - VB Crystal Report

8. Control image property locking image file even after image cleared

Hi All

When I set a buttons image to a image file in the properties window it seems 
to lock the file even if I clear the button image property in the properties 
window

Sometimes I am editing the icon/bitmap and connect it to the button to see 
what it looks like

Then I want to make further changes so I clear the image from the buttons 
image property, but when I edit and try to save the image file I get a 
message saying it is in use by another program

I have to close the VB.net 2005 solution to free it up


Any ideas

Regards
Steve