Results 1 to 10 of 10

Thread: vb6 and crystal report question

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Oct 2012
    Posts
    193

    vb6 and crystal report question

    I am not sure if this question should be in here cause it involves vb6 code and crystal report or sql query.

    I have this record for example group of subjects and grade per student. I will print this record on half paper. I would like to appear each subject with corresponding grades separately in each half size paper. so like math and algebra would be shown on one paper since they belong to same group and english on another paper and so on.

    I have group id assigned to each subject.

    Its like, they are page 1, its the math and algebra then page 2 its english and so on.

    How will i do that?
    Last edited by genlight; May 27th, 2017 at 11:02 AM.

  2. #2
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: vb6 and crystal report question

    Quote Originally Posted by genlight View Post
    I am not sure if this question should be in here cause it involves vb6 code and crystal report or sql query.
    A lot of developers prefer to use their own Report-Drawing, to have more control over the Render-OutPut
    and not as many dependecies to ship, which often are (e.g. in case of Crystal-Reports) not easy to bundle in an Installer.

    Quote Originally Posted by genlight View Post
    I have this record for example group of subjects and grade per student. I will print this record on half paper...
    ...Its like, they are page 1, its the math and algebra then page 2 its english and so on.
    How will i do that?
    Below is shown, how one can achieve his own OwnerDrawn-Reporting (including a PictureBox-based Preview)
    with a small set of only 4 (wrapped) VB6-Drawing-Routines (the Print-Output based on vbPoints-Coordinates).

    Here is the set of the just mentioned 4 Helper-Functions, which you can put into a *.bas-Module for global availability.
    Code:
    Option Explicit
    
    Sub ChangeFontOn(Canvas As Object, FontName, FontSize, Optional ByVal FontBold As Boolean, Optional ByVal FontItalic As Boolean)
      Canvas.Font.Name = FontName
      Canvas.Font.Size = FontSize
      Canvas.Font.Bold = FontBold
      Canvas.Font.Italic = FontItalic
    End Sub
     
    Sub DrawRectangleOn(Canvas As Object, x, y, dx, dy, Optional ByVal LineColor&, Optional ByVal LineWidth& = 1, Optional ByVal FillColor& = -1)
      If LineWidth Then Canvas.DrawWidth = LineWidth
      If FillColor <> -1 Then Canvas.Line (Int(x), Int(y))-(Int(x + dx), Int(y + dy)), FillColor, BF
      If LineWidth Then Canvas.Line (Int(x), Int(y))-(Int(x + dx), Int(y + dy)), LineColor, B
    End Sub
    
    Sub DrawTextOn(Canvas As Object, x, y, dx, dy, ByVal Text$, Optional ByVal Color&, Optional ByVal Align As AlignmentConstants, Optional ByVal VCenter As Boolean = True, Optional ByVal Padding As Long = 3)
      Canvas.ForeColor = Color
      If VCenter Then Canvas.CurrentY = y + (dy - Canvas.TextHeight("|")) / 2 Else Canvas.CurrentY = y - Padding
      Select Case Align
        Case vbLeftJustify:  Canvas.CurrentX = x + Padding
        Case vbCenter:       Canvas.CurrentX = x + (dx - Canvas.TextWidth(Trim$(Text))) / 2
        Case vbRightJustify: Canvas.CurrentX = x + (dx - Canvas.TextWidth(Trim$(Text))) - Padding
      End Select
      Canvas.Print Text
    End Sub
    
    Sub DrawRsTableOn(Canvas As Object, Rs As Object, xOffs, yOffs, dx, dy, ColWPercArr, HeaderHeight, RowHeight)
      Dim i, x, y, ColWidth, PercColor
      
      ChangeFontOn Canvas, "Arial", 10
     
      x = xOffs: y = yOffs
      For i = 0 To Rs.Fields.Count - 1 'draw the Header first
        ColWidth = ColWPercArr(i) * dx 'calculate the current ColWidth
        DrawRectangleOn Canvas, x, y, ColWidth, HeaderHeight, vbBlack, 1, &HBBBBBB
        DrawTextOn Canvas, x, y, ColWidth, HeaderHeight, Rs(i).Name, , vbCenter
        x = x + ColWidth 'increase the current x about the last ColWidth
      Next
      y = y + HeaderHeight
      
      Do Until Rs.EOF Or y - yOffs + RowHeight > dy    'now the Table-Body
        x = xOffs 'reset to xOffs for the rendering of the next Row
        For i = 0 To Rs.Fields.Count - 1 'loop over all Fields in the Rs to render the current Row
          ColWidth = ColWPercArr(i) * dx 'calculate the current ColWidth
          DrawRectangleOn Canvas, x, y, ColWidth, RowHeight, vbBlack, 1 'the Border-Rect
          
          If InStr(1, Rs(i).Name, "Perc", 1) Then 'a special Handling for Rs-FieldNames which have "Perc" in it
            PercColor = Choose(1 + Int(4 * Rs(i).Value - 0.01), vbRed, vbMagenta, vbBlue, vbCyan)
            DrawRectangleOn Canvas, x + 2, y + (RowHeight - 4) / 2, Rs(i).Value * (ColWidth - 4), 4, 0, 0, PercColor
          Else 'draw normal Text-Content
            Select Case VarType(Rs(i).Value)
              Case vbNull:    'your choice what is rendered in this case, currently we do nothing
              Case vbBoolean: DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & IIf(Rs(i).Value, "X", "O"), 0, vbCenter
              Case vbString:  DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & Rs(i).Value, 0, vbLeftJustify
              Case Else:      DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & Rs(i).Value, 0, vbRightJustify
            End Select
            x = x + ColWidth 'increase the current x about the last ColWidth
          End If
        Next
        y = y + RowHeight 'increase y about the just rendered Row
        Rs.MoveNext
      Loop
    End Sub
    With the above Helpers "out of the way" in the *.bas Module, the Form-Code
    becomes quite lean and readable.

    Into a naked Form, which will only need a Command1 and a Picture1 on it (arranged e.g. like in the ScreenShot below):
    Code:
    Option Explicit
    
    Private Rs As Object
    
    Private Sub Form_Load()
      Me.BackColor = &H888888
      Picture1.AutoRedraw = True
      Picture1.BackColor = vbWhite
      Picture1.BorderStyle = 0
    End Sub
    
    Private Sub Command1_Click()
      Picture1.Cls
      DrawPageOn Picture1, "Maths", "Algebra"
      
      If MsgBox("Print it?", vbYesNo) = vbYes Then
        DrawPageOn Printer, "Maths", "Algebra"
        Printer.NewPage
        DrawPageOn Printer, "Bio-Lectures", "Bio-Lab"
        Printer.EndDoc
      End If
    End Sub
    
    Private Sub DrawPageOn(Canvas As Object, SubjTop As String, Optional SubjBottom As String)
      Canvas.ScaleMode = vbPoints
      If TypeOf Canvas Is VB.PictureBox Then Canvas.Cls
      
      DrawHalfPage Canvas, SubjTop, GetRsForSubject(SubjTop)
      If Len(SubjBottom) Then DrawHalfPage Canvas, SubjBottom, GetRsForSubject(SubjBottom), Canvas.ScaleWidth / 2
    End Sub
    
    Sub DrawHalfPage(Canvas As Object, Subject As String, Rs As Object, Optional ByVal xOffs = 0)
      'print a separator-line at the top of the bottom-halfpage when needed
      If xOffs Then DrawRectangleOn Canvas, xOffs, 10, 0, Canvas.ScaleHeight - 20
      
      'draw the Subject-Text in Arial 12pt, centered, and blue
      ChangeFontOn Canvas, "Arial", 12, True, True
      DrawTextOn Canvas, xOffs, 20, Canvas.ScaleWidth / 2, 12, Subject, vbBlue, vbCenter
      
      'now the Rs-based TableRendering
      Dim ColWPerc: ColWPerc = Array(0.5, 0.15, 0.35) 'define the ColumnWidths of the 3 Rs-Columns i percent
      DrawRsTableOn Canvas, Rs, xOffs + 10, 40, Canvas.ScaleWidth / 2 - 20, Canvas.ScaleHeight - 40, ColWPerc, 16, 15
    End Sub
     
    'just to simulate a DB-Select which hands out a similar RecordSet
    Private Function GetRsForSubject(Subject As String) As Object
      Set GetRsForSubject = CreateObject("ADODB.Recordset")
      With GetRsForSubject
        .Fields.Append "Name", vbString
        .Fields.Append "Grade", vbInteger
        .Fields.Append "GradePerc", vbDouble
        .Open
        Dim i As Long, Name, Grade, GradePerc
        For i = 1 To 25
          .AddNew
          !Name = "Sudent " & i
          !Grade = 19 + Rnd * 80
          !GradePerc = !Grade / 100
        Next
        .MoveFirst
      End With
    End Function
    Here's what the above Form-Code will produce:


    And here is the output which gets generated, when the above MsgBox is answered with "Yes" (using a PDF-PrinterDriver here):
    http://vbRichClient.com/Downloads/TwoDemoPages.pdf

    HTH

    Olaf

  3. #3
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: vb6 and crystal report question

    Quote Originally Posted by Schmidt View Post
    A lot of developers prefer to use their own Report-Drawing, to have more control over the Render-OutPut
    and not as many dependecies to ship, which often are (e.g. in case of Crystal-Reports) not easy to bundle in an Installer.



    Below is shown, how one can achieve his own OwnerDrawn-Reporting (including a PictureBox-based Preview)
    with a small set of only 4 (wrapped) VB6-Drawing-Routines (the Print-Output based on vbPoints-Coordinates).

    Here is the set of the just mentioned 4 Helper-Functions, which you can put into a *.bas-Module for global availability.
    Code:
    Option Explicit
    
    Sub ChangeFontOn(Canvas As Object, FontName, FontSize, Optional ByVal FontBold As Boolean, Optional ByVal FontItalic As Boolean)
      Canvas.Font.Name = FontName
      Canvas.Font.Size = FontSize
      Canvas.Font.Bold = FontBold
      Canvas.Font.Italic = FontItalic
    End Sub
     
    Sub DrawRectangleOn(Canvas As Object, x, y, dx, dy, Optional ByVal LineColor&, Optional ByVal LineWidth& = 1, Optional ByVal FillColor& = -1)
      If LineWidth Then Canvas.DrawWidth = LineWidth
      If FillColor <> -1 Then Canvas.Line (Int(x), Int(y))-(Int(x + dx), Int(y + dy)), FillColor, BF
      If LineWidth Then Canvas.Line (Int(x), Int(y))-(Int(x + dx), Int(y + dy)), LineColor, B
    End Sub
    
    Sub DrawTextOn(Canvas As Object, x, y, dx, dy, ByVal Text$, Optional ByVal Color&, Optional ByVal Align As AlignmentConstants, Optional ByVal VCenter As Boolean = True, Optional ByVal Padding As Long = 3)
      Canvas.ForeColor = Color
      If VCenter Then Canvas.CurrentY = y + (dy - Canvas.TextHeight("|")) / 2 Else Canvas.CurrentY = y - Padding
      Select Case Align
        Case vbLeftJustify:  Canvas.CurrentX = x + Padding
        Case vbCenter:       Canvas.CurrentX = x + (dx - Canvas.TextWidth(Trim$(Text))) / 2
        Case vbRightJustify: Canvas.CurrentX = x + (dx - Canvas.TextWidth(Trim$(Text))) - Padding
      End Select
      Canvas.Print Text
    End Sub
    
    Sub DrawRsTableOn(Canvas As Object, Rs As Object, xOffs, yOffs, dx, dy, ColWPercArr, HeaderHeight, RowHeight)
      Dim i, x, y, ColWidth, PercColor
      
      ChangeFontOn Canvas, "Arial", 10
     
      x = xOffs: y = yOffs
      For i = 0 To Rs.Fields.Count - 1 'draw the Header first
        ColWidth = ColWPercArr(i) * dx 'calculate the current ColWidth
        DrawRectangleOn Canvas, x, y, ColWidth, HeaderHeight, vbBlack, 1, &HBBBBBB
        DrawTextOn Canvas, x, y, ColWidth, HeaderHeight, Rs(i).Name, , vbCenter
        x = x + ColWidth 'increase the current x about the last ColWidth
      Next
      y = y + HeaderHeight
      
      Do Until Rs.EOF Or y - yOffs + RowHeight > dy    'now the Table-Body
        x = xOffs 'reset to xOffs for the rendering of the next Row
        For i = 0 To Rs.Fields.Count - 1 'loop over all Fields in the Rs to render the current Row
          ColWidth = ColWPercArr(i) * dx 'calculate the current ColWidth
          DrawRectangleOn Canvas, x, y, ColWidth, RowHeight, vbBlack, 1 'the Border-Rect
          
          If InStr(1, Rs(i).Name, "Perc", 1) Then 'a special Handling for Rs-FieldNames which have "Perc" in it
            PercColor = Choose(1 + Int(4 * Rs(i).Value - 0.01), vbRed, vbMagenta, vbBlue, vbCyan)
            DrawRectangleOn Canvas, x + 2, y + (RowHeight - 4) / 2, Rs(i).Value * (ColWidth - 4), 4, 0, 0, PercColor
          Else 'draw normal Text-Content
            Select Case VarType(Rs(i).Value)
              Case vbNull:    'your choice what is rendered in this case, currently we do nothing
              Case vbBoolean: DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & IIf(Rs(i).Value, "X", "O"), 0, vbCenter
              Case vbString:  DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & Rs(i).Value, 0, vbLeftJustify
              Case Else:      DrawTextOn Canvas, x, y, ColWidth, RowHeight, "" & Rs(i).Value, 0, vbRightJustify
            End Select
            x = x + ColWidth 'increase the current x about the last ColWidth
          End If
        Next
        y = y + RowHeight 'increase y about the just rendered Row
        Rs.MoveNext
      Loop
    End Sub
    With the above Helpers "out of the way" in the *.bas Module, the Form-Code
    becomes quite lean and readable.

    Into a naked Form, which will only need a Command1 and a Picture1 on it (arranged e.g. like in the ScreenShot below):
    Code:
    Option Explicit
    
    Private Rs As Object
    
    Private Sub Form_Load()
      Me.BackColor = &H888888
      Picture1.AutoRedraw = True
      Picture1.BackColor = vbWhite
      Picture1.BorderStyle = 0
    End Sub
    
    Private Sub Command1_Click()
      Picture1.Cls
      DrawPageOn Picture1, "Maths", "Algebra"
      
      If MsgBox("Print it?", vbYesNo) = vbYes Then
        DrawPageOn Printer, "Maths", "Algebra"
        Printer.NewPage
        DrawPageOn Printer, "Bio-Lectures", "Bio-Lab"
        Printer.EndDoc
      End If
    End Sub
    
    Private Sub DrawPageOn(Canvas As Object, SubjTop As String, Optional SubjBottom As String)
      Canvas.ScaleMode = vbPoints
      If TypeOf Canvas Is VB.PictureBox Then Canvas.Cls
      
      DrawHalfPage Canvas, SubjTop, GetRsForSubject(SubjTop)
      If Len(SubjBottom) Then DrawHalfPage Canvas, SubjBottom, GetRsForSubject(SubjBottom), Canvas.ScaleWidth / 2
    End Sub
    
    Sub DrawHalfPage(Canvas As Object, Subject As String, Rs As Object, Optional ByVal xOffs = 0)
      'print a separator-line at the top of the bottom-halfpage when needed
      If xOffs Then DrawRectangleOn Canvas, xOffs, 10, 0, Canvas.ScaleHeight - 20
      
      'draw the Subject-Text in Arial 12pt, centered, and blue
      ChangeFontOn Canvas, "Arial", 12, True, True
      DrawTextOn Canvas, xOffs, 20, Canvas.ScaleWidth / 2, 12, Subject, vbBlue, vbCenter
      
      'now the Rs-based TableRendering
      Dim ColWPerc: ColWPerc = Array(0.5, 0.15, 0.35) 'define the ColumnWidths of the 3 Rs-Columns i percent
      DrawRsTableOn Canvas, Rs, xOffs + 10, 40, Canvas.ScaleWidth / 2 - 20, Canvas.ScaleHeight - 40, ColWPerc, 16, 15
    End Sub
     
    'just to simulate a DB-Select which hands out a similar RecordSet
    Private Function GetRsForSubject(Subject As String) As Object
      Set GetRsForSubject = CreateObject("ADODB.Recordset")
      With GetRsForSubject
        .Fields.Append "Name", vbString
        .Fields.Append "Grade", vbInteger
        .Fields.Append "GradePerc", vbDouble
        .Open
        Dim i As Long, Name, Grade, GradePerc
        For i = 1 To 25
          .AddNew
          !Name = "Sudent " & i
          !Grade = 19 + Rnd * 80
          !GradePerc = !Grade / 100
        Next
        .MoveFirst
      End With
    End Function
    Here's what the above Form-Code will produce:


    And here is the output which gets generated, when the above MsgBox is answered with "Yes" (using a PDF-PrinterDriver here):
    http://vbRichClient.com/Downloads/TwoDemoPages.pdf

    HTH

    Olaf
    very good example. thans

  4. #4

    Thread Starter
    Addicted Member
    Join Date
    Oct 2012
    Posts
    193

    Re: vb6 and crystal report question

    that was beautiful Olaf, that might come useful in the future. But i would like to accomplish this for now with crystal report.

  5. #5
    PowerPoster
    Join Date
    Sep 2012
    Posts
    2,083

    Re: vb6 and crystal report question

    In the VB6 IDE, there is no color-bar in the grid. But after compiling into exe, color-bars appear.
    Attached Images Attached Images  

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: vb6 and crystal report question

    Quote Originally Posted by dreammanor View Post
    In the VB6 IDE, there is no color-bar in the grid. But after compiling into exe, color-bars appear.
    The Color-bars will be created within the Routine 'DrawRsTable' on all Fields
    (Field-Names) which contain the snippet 'Perc' by this line here:

    Code:
    If InStr(1, Rs(i).Name, "Perc", 1) Then 'a special Handling for Rs-FieldNames which have "Perc" in it
    Why exactly this branching-instruction fails (in your IDE on a system with a chinese locale)
    should be relatively easy to discover when you set a breakpoint there...

    Olaf

  7. #7
    PowerPoster
    Join Date
    Sep 2012
    Posts
    2,083

    Re: vb6 and crystal report question

    I re-tested it.

    On XP:
    Whether in the VB6 IDE environment, or after compiling into exe, the grid have color-bars.

    On Win10:
    In the VB6 IDE, there is no color-bar in the grid. But after compiling into exe, color-bars appear.

    After testing, the problem is indeed generated by the following code line:
    Code:
    If InStr(1, Rs(i).Name, "Perc", 1) Then 
    I have encountered this type of problem before, I know what the reason is.

    In vb6 IDE on Win7, Win8 and Win10 with Chinese locale, the compare method of Instr must be 0 (vbBinaryCompare), can not be 1 (vbTextCompare) or 2 (vbDatabaseCompare).

    Function InStr([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare])


    I modified the following code line, everything was fine:
    Code:
    If InStr(1, Rs(i).Name, "Perc", 0) Then
    or
    Code:
    If InStr(1, LCase(Rs(i).Name), "perc", 0) Then
    Thanks, Olaf.
    Last edited by dreammanor; May 29th, 2017 at 08:49 AM.

  8. #8
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,854

    Re: vb6 and crystal report question

    @dreammanor, you are again hijacking a thread for your own need.
    genlight stated the following:
    that was beautiful Olaf, that might come useful in the future. But i would like to accomplish this for now with crystal report.
    So better start a thread of your own and make a reference to the post by Olaf.

  9. #9
    PowerPoster
    Join Date
    Sep 2012
    Posts
    2,083

    Re: vb6 and crystal report question

    @Arnoutdv, sorry, I missed the OP's sentence. When Olaf made a good solution, I tested it and raised the problem in the test process, that's it.

    In my opinion, answering question is to help others, testing and find problem is to help others too, which can let others and me learn a lot of knowledge.

    Of course, if OP is not interested in these issues, then I really disturb him. I will pay attention to this, and try not to ask questions in other's thread. Thanks for your reminder.

  10. #10
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    38,943

    Re: vb6 and crystal report question

    Thread moved to reporting, since the question is now more focused on Crystal Reports, specifically.
    My usual boring signature: Nothing

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width