POST, Analise dan Share Code di sini - VBers

[Harno]

Tweet

Hi Harno, mari kita analise code kamu yg ini ( please, no offence )

santai aja....

mengganti jam dan tanggal system....

Private Sub Command1_Click()
Dim myTime
myTime = Text1.Text
Time = myTime
End Sub

Private Sub Command2_Click()
Dim Mydate
Mydate = Text2.Text
Date = Mydate
End Sub

[positive+]

Tweet

Mmm, just to remind us
please make some conversation here if there's a code that need to be analise, or there's somethin else that u think should get a critic's, please speak here too, and show us a better one.
thought, every code has been written with a various logic maybe you got a better one to shared, and we can learn something ... that still we don't know or miss. Thx

bila ada pendapat, critic's atau analise yg ingin temen2 share d sini, please do it ... lg pula kitakan sama2 lg belajar

My Best Regard, Positive+

[positive+]

Tweet

API ( Application Programming Interface )
Using Rectangle Function

Option Explicit

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) As Long
        
'=============================================================================
'Parameter Description :
'=============================================================================
'· hdc
'Identifies the device context.
'· X1
'Specifies the logical x-coordinate of the upper-left corner of the rectangle.
'· Y1
'Specifies the logical y-coordinate of the upper-left corner of the rectangle.
'· X2
'Specifies the logical x-coordinate of the lower-right corner of the rectangle.
'· Y2
'Specifies the logical y-coordinate of the lower-right corner of the rectangle.
'=============================================================================
        
Dim mSize As Long '/ size rect

Sub Create_Grid()
Dim j As Long, jj As Long
Dim px As Long, py As Long
    px = ScaleWidth + mSize '/ width to draw
    py = ScaleHeight + mSize '/ height to draw
    Cls '/ clear form
    ' height and width Rectangle = mSize
    For j = 0 To px Step mSize '/ loop for X values
        For jj = 0 To py Step mSize '// loop for Y values
            Rectangle Me.hdc, j, jj, 0, 0 '// draw rect
        Next
    Next
    CurrentX = ScaleWidth - 80
    CurrentY = 25
    Print mSize
End Sub
Sub Initialize()
    ScaleMode = vbPixels
    BackColor = &H0&
    ForeColor = &H8000&
    FontSize = 25
    FontBold = True
    mSize = 5
End Sub
Private Sub Form_Load()
    Initialize 'setup form and mSize default value
    WindowState = 2 '/ maximized form
End Sub
Private Sub Command1_Click()
    mSize = mSize + 5 '/ increase mSize value
    Create_Grid
End Sub
Private Sub Command2_Click()
    If mSize = 5 Then Exit Sub
    mSize = mSize - 5 '/ decrease mSize value
    Create_Grid
End Sub
Private Sub Command3_Click()
    Unload Me
    Set Form1 = Nothing
End Sub

Sample proj. dlm ( *.zip ) File
Have fun, Positive+

[positive+]

Tweet

Utilities ::.
Create Word Document from program

Option Explicit

'reference : Microsoft Word 10.0 Object Library _
             this ref. exist if you've install Office
             
'a form with Command Button called Command1 and One Textbox called Text1

Sub AddToWord(iContents As String, _
              iFileName As String)
              
Dim w As New Word.Application

    w.Documents.Add '// add new document
    w.Selection.TypeText (iContents) '// write this to current doc that has been open
    w.ChangeFileOpenDirectory (App.Path) '// skrg kita buka Dialog Window dgn current project path 
    
    
    w.ActiveDocument.SaveAs FileName:=iFileName & ".doc", _  '// save the file name same with iFilename parameter value
    FileFormat:=wdFormatDocument, LockComments:=False, _ '// this, till end set the document properties
    Password:="", _
    AddToRecentFiles:=True, WritePassword:="", _
    ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
    SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False
    
    w.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    w.Application.Quit
    
    Set w = Nothing '// destroy object from memory
End Sub
Private Sub Command1_Click()
    AddToWord Text1.Text, "Test3"
End Sub

hope it's usefull

[Dewaputra]

Tweet

plissss, analise this code
n tell me where I've done wrong!!

Dim Report As New CrystalReport1

Private Sub Form_Load()
Screen.MousePointer = vbHourglass
CRViewer1.ReportSource = Report
Screen.MousePointer = vbDefault

    Select Case FrmRep.CmbFilter.ListIndex
        Case 0
            Report.RecordSelectionFormula = "{Quatity.Date} in DateTime (" & FrmRep.TxtTh.Text & "," & FrmRep.CmbBln.Text & "," & FrmRep.CmbTgl.Text & ") to DateTime (" & FrmRep.TxtTh1.Text & "," & FrmRep.CmbBln1.Text & "," & FrmRep.CmbTgl1.Text & ")"
            CRViewer1.ViewReport
        Case 1
            Report.SQLQueryString = "select * from quatity order by draw_no" 'sort report ascending with draw_no field
            CRViewer1.ViewReport
        Case 2
            Report.SQLQueryString = "select * from quatity order by customer" 'sort report ascending with customer field
            CRViewer1.ViewReport
        Case 3
            Report.SQLQueryString = "select * from quatity order by proses" 'sort report ascending with proses field
            CRViewer1.ViewReport
        Case 4
            Report.SQLQueryString = "select * from quatity order by job_no" 'sort report ascending with job_no field
            CRViewer1.ViewReport
        Case 5
            Report.SQLQueryString = "select * from quatity order by opt_id" 'sort report ascending with opt_id field
            CRViewer1.ViewReport
    End Select
    
End Sub

Private Sub Form_Resize()
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.Height = ScaleHeight
CRViewer1.Width = ScaleWidth

End Sub

code ini maksudnya untuk menampilkan report dengan sorting pada field tertentu, pi ga jalan2
dimana letak kesalahannya??

[positive+]

Tweet

Hi Dewaputra ... this what i've done

Option Explicit

'/ i'm makin it as Procedure
Sub view_rpt(iNum As Integer) '/ fill the parameter values with ListBox Listindex
'* I HAVEN'T TESTED THIS PROC, so tell me if there's somethin wrong ( i don't have any C.Report install on ma computer )
Dim Report As New CrystalReport1 '/ use as local var in this proc
Dim sBuff As String
    Screen.MousePointer = vbHourglass '/ change to busy mouse pointer
    '** it should be there's set up for .DataFiles(x), Database etc properties
    '// before this line
    Select Case iNum '/ put query into variable sBuff
        Case 0
             '/ try usin <Between> and try to make it as Variable..more save, Mmm...it will look like this
             'sBuff = "{Quatity.Date} BETWEEN ..... AND .....
             sBuff = "{Quatity.Date} in DateTime (" & FrmRep.TxtTh.Text & "," & FrmRep.CmbBln.Text & "," & FrmRep.CmbTgl.Text & ") to DateTime (" & FrmRep.TxtTh1.Text & "," & FrmRep.CmbBln1.Text & "," & FrmRep.CmbTgl1.Text & ")"
        Case 1
             sBuff = "select * from quatity order by draw_no" 'sort report ascending with draw_no field
        Case 2
             sBuff = "select * from quatity order by customer" 'sort report ascending with customer field
        Case 3
             sBuff = "select * from quatity order by proses" 'sort report ascending with proses field
        Case 4
             sBuff = "select * from quatity order by job_no" 'sort report ascending with job_no field
        Case 5
             sBuff = "select * from quatity order by opt_id" 'sort report ascending with opt_id field
    End Select
    
    '** the rem code below, use for passing selection formula to Report Obj
    '-> this code -> Report.DataDefinition.RecordSelectionFormula = sBuff
    Report.DataDefinition.RecordSelectionFormula = sBuff
    '** if you want to passing selection formula by Viewer Control
    '-> this code -> CRViewer1.SelectionFormula = sBuff
    
    '// after we select the record, then set to viewer source properties
    CRViewer1.ReportSource = Report
    '// viewing the rpt
    CRViewer1.ViewReport
    '// change MP to default again
    Screen.MousePointer = vbDefault
    '// Mmm...try it first, bye
End Sub
Private Sub Form_Load()
    'Screen.MousePointer = vbHourglass
    'CRViewer1.ReportSource = Report <- it will view with default source, that is ( * ) all
    'Screen.MousePointer = vbDefault <- should be write after all process has been done
    'Select Case FrmRep.CmbFilter.ListIndex <- for this till END SELECT, try with above..to passing the selection
    '    Case 0
    '        Report.RecordSelectionFormula = "{Quatity.Date} in DateTime (" & FrmRep.TxtTh.Text & "," & FrmRep.CmbBln.Text & "," & FrmRep.CmbTgl.Text & ") to DateTime (" & FrmRep.TxtTh1.Text & "," & FrmRep.CmbBln1.Text & "," & FrmRep.CmbTgl1.Text & ")"
             '// it will be done (viewing your record) if you add this line below _
                 CRViewer1.ReportSource '// but, this is for the second time you'll write it
    '        CRViewer1.ViewReport
    '    Case 1
    '        Report.SQLQueryString = "select * from quatity order by draw_no" 'sort report ascending with draw_no field
    '        CRViewer1.ViewReport
    '    Case 2
    '        Report.SQLQueryString = "select * from quatity order by customer" 'sort report ascending with customer field
    '        CRViewer1.ViewReport
    '    Case 3
    '        Report.SQLQueryString = "select * from quatity order by proses" 'sort report ascending with proses field
    '        CRViewer1.ViewReport
    '    Case 4
    '        Report.SQLQueryString = "select * from quatity order by job_no" 'sort report ascending with job_no field
    '        CRViewer1.ViewReport
    '    Case 5
    '        Report.SQLQueryString = "select * from quatity order by opt_id" 'sort report ascending with opt_id field
    '        CRViewer1.ViewReport
    'End Select
    
    'the problem is :
    '-> i don't see any line that set the DataFiles(x) or else properties
    '-> all u want is to select the records, but you have set the report source first _
        Report.RecordSelectionFormula = ".." <- it should be first, then _
        CRViewer1.ReportSource = Report <- this line after above has been done
    view_rpt FrmRep.CmbFilter.ListIndex
End Sub
Private Sub Form_Resize()
    If WindowState <> 1 Then
       '/ use .Move more effecient and faster _
          rather than setting up the rect prop (  .left, .top, .width, .height )
       CRViewer1.Move 0, 0, ScaleWidth, ScaleHeight
    End If
End Sub

the different with passing the formula :
-> Passing Selection to Report Object, you select the records first then view the result with Viewer Ctrl

Report.DataDefinition.RecordSelectionFormula = sBuff

-> Passing Selection to Viewer Object, the report has been there in viewer obj. ( at real time )

CRViewer1.SelectionFormula = sBuff

other suggest :
Try copy your selection formula to the seagate crystal report program and use the record selection formula to test the formula. Most of the time the error you encounter it due to the report to have the field your try to refer with

[Harno]

Tweet

plissss, analise this code
n tell me where I've done wrong!!

kita sama2 belajar... ok
coba programnya di upload ya...

[positive+]

Tweet

masalahnya pada awal sebelum SELECT CASE statement Dewa menulis ini :
-> CRViewer1.ReportSource = Report ( yang tentunya akan menampilkan seluruh data yg ada tanpa selection / default )
-> dan dalam CASE (index) , Dewa membuat seleksi data yg akan ditampilkan, line ini :

Case (index)
Report.RecordSelectionFormula = "bla ..."
CRViewer1.ViewReport

kalaupun data dr report dapat ditampilkan, itu pasti bukan hasil dr selectionFormula-nya yg ada dlm CASE krn ReportSource tidak di-update setelah Selection Formula, utk penulisan yg benar seharusnya spt ini :

Report.RecordSelectionFormula = "bla..bla"
CRViewer1.ReportSource = Report
CRViewer1.ViewReport

sedangkan bila mengikuti Logic penulisan dr Dewaputra, maka akan hrs tertulis spt ini :

CRViewer1.ReportSource = Report '// i dunno why Dewa's write this before SELECT CASE
Report.RecordSelectionFormula = 
"bla..bla.." '// coz, then he make selection for Report data with this line
'// the selection will be executed, but the report source never change coz he's not write it again
CRViewer1.ReportSource = Report '// so, this line existence make it more logical for me, but not efficient to the way we must write the program
CRViewer1.ViewReport

that's what i think. CMIIW
btw, i forgot to ask

.....pi ga jalan2 dimana letak kesalahannya??

maksudnya, apakah data yg di-inginkan setelah Selection yg ngga jalan ? ato blank sama sekali ??
krn bila melihat dari coding Dewa di atas, asumsi saya hasil dr Selection formula yg ngga jalan ?

once again CMIIW, we'll wait for Dewa's replies

[Dewaputra]

Tweet

Tnx, bgt nih buat pencerahannya

kebetulan VB saya lgi ngadat, saya coba install ulang pi keluar pesan :

Error installing SQL odbc driver

jdi saya blom bisa coba codingnya, kira2 ada yang tau ga solusi untuk permasalahan tersebut? untuk bang Positive+ tnx bgt buat logicnya, sudenly saya mendapat pencerahannya.

Buat bang Positive+ maksudnya ga jalan2, setiap saya run dngan ful compile, slalu ada pesan error :

Compiler error
invalid use of method bla....

di LOC Report.recordselectionformula

Tnx untuk semua, nanti klo VB saya dah sehat lgi n saya bisa coba codingnya saya akan inform lagi gmana hasilnya

best regards,

[Harno]

Tweet

main game puzzle yuk....
masih sederhana banget ni.....
terbuka buat dianalisa .....

Dim numPict As Byte
Dim pictIndex As Integer
Dim myTempl(47) As Integer

Private Sub TemplPict()
Dim h As Byte
Dim pictLeft, pictTop
pictLeft = 200
pictTop = 100

For h = 0 To 47
 Load Picture2(h)
 Picture2(h).Left = pictLeft
 Picture2(h).Top = pictTop
 pictLeft = pictLeft + 80
 If pictLeft > 760 Then
  pictLeft = 200
  pictTop = pictTop + 80
 End If
 Picture2(h).Visible = True
Next h
End Sub

Private Sub AcakPict()
Dim imgX As ListImage
Static xxx As Integer
Static yyy As Integer
xxx = 0
yyy = 0

ImageList1.ListImages.Clear

Dim X As Integer
For X = 0 To 47

 Picture2(X).PaintPicture Picture1.Picture, 0, 0, 80, 80, 80 * xxx, 80 * yyy, 80, 80
 xxx = xxx + 1: If xxx = 8 Then xxx = 0: yyy = yyy + 1
 Set imgX = ImageList1.ListImages.Add(X + 1, , Picture2(X).Image)
 DoEvents
Next X

Erase myTempl

Dim Y As Byte
Dim z As Long
For Y = 0 To 47
 Picture2(Y).Cls
upp:
 Randomize
 z = Rnd * 47
 If myTempl(z) = 777 Then GoTo upp
 Picture2(Y).Picture = ImageList1.ListImages(z + 1).ExtractIcon
 myTempl(z) = 777
 DoEvents
Next Y
End Sub

Private Sub Form_Load()
TemplPict
AcakPict
End Sub

Private Sub Picture2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then
   Exit Sub
End If

If MousePointer = 0 Then
 MouseIcon = Picture2(Index).Picture
 MousePointer = 99
 Picture2(Index) = Picture3.Picture
 pictIndex = Index
ElseIf MousePointer = 99 Then
 Picture2(pictIndex) = Picture2(Index)
 Picture2(Index) = MouseIcon
 MousePointer = 0
End If
End Sub