VB MSFlexGrid

폼에 메뉴를 만들기 위해서는 [메뉴편집기]를 이용한다. 편집기는 e[도구]메뉴 안의 [메뉴편집기]를 선택하거나 폼에서 마우스 오른 쪽 버튼을 누르면 된다.[메뉴편집기]를 사용할 때 주의할 사항은 메뉴를 추후에 자주 수정하여 사용할 경우 index를 사용하면 부분별로 여러 군데 고쳐야 하기 때문에 계획 없이 프로그램을 개발한다면 일일이 name를 따로따로 지정하는 편이 낫다.

우리 나라는 결재 문화이므로 MsFlexGrid를 많이 활용하자

외국의 문서를 본 사람이라면 한번쯤 이런 의문점을 느끼게 될 것이다. 우리는 왜이리 도표를 많이 쓰는지 가로줄 세로줄이 문서를 도배하는 경우가 한 두 번이 아니다. 줄이 안 그어 있으면 답답함을 느끼나 특히 원로한 분들에게서 그 증상이 더 심하다. 물론 프로그램에서도 도표의 중요성은 매우 크다. 업무용 프로그램에서 거의 대부분의 입력을 이 도표에 의존하고 있기 때문이다.

원에 표시된 컨트롤이 MsFlexGrid.ocx 개체인데 이것을 선택해서 폼에 원하는 크기로 드래그 한 다음 Textbox를 끌어다 놓으면 된다. 문제는 엑세스(Access)나 엑셀(Excel)에서 처럼 도표에 입력이 가능하여야 한다. 처음엔 이해가 가지 않지만 복사해서 쓰다보면 나중에는 아 별거 아니구먼! 이란 소리가 자신도 모르게 나오게 된다. 그런데 이런 도표를 여기저기 많이 쓰게 되므로 아예 모듈에 넣어 놓는 것이 유리하다.

[실전 예]

MsFlexGrid(이름)을 fg1이라고 정했을 경우 다음과 같이 기술하면 된다.

Private Sub Form_Load()

TXTEDIT = "" '도표에서 마우스로 클릭 하거나 키보드를 누를 때까지는

TXTEDIT.Visible = False ’ 텍스트 박스가 도표 위에 나타나지 않게 하여야 한다

fg1.Cols=4 'Column 전체 갯수

fg1.Rows=21 ‘Row 전체 갯수

fg1.TextMatrix(0,0)="학급“

fg1.TextMatrix(0,1)="1999입학년도 1학년“

fg1.TextMatrix(0,2)="1998입학년도 2학년“

fg1.TextMatrix(0,3)="1997입학년도 3학년“

For r=1 to 20

fg1.TextMatrix(r,0)=Format(r,"@@") & "반“

'문자열을 붙일 때에는 + 보다 & 을 쓰도록 권장한다

End Sub

Sub fg1_KeyPress(KeyAscii As Integer)

MSFlex_Edit fg1, TXTEDIT, KeyAscii

End Sub

Sub fg1_DblClick()

MSFlex_Edit fg1, TXTEDIT, 32

End Sub

Sub fg1_GotFocus()

If TXTEDIT.Visible = False Then Exit Sub

fg1 = TXTEDIT ‘텍스트박스에 입력된 글자를 도표 셀에 옮긴다

TXTEDIT.Visible = False ‘텍스트 박스를 감춘다

End Sub

Sub fg1_LeaveCell()

If TXTEDIT.Visible = False Then Exit Sub

fg1 = TXTEDIT

TXTEDIT.Visible = False

End Sub

Sub txtedit_KeyPress(KeyAscii As Integer)

' 소리를 제거하기 위해 반환 값을 삭제

If KeyAscii = 13 Then KeyAscii = 0

End Sub

Sub txtedit_KeyDown(KeyCode As Integer, Shift As Integer)

MSFlex_EditKeyCode fg1, TXTEDIT, KeyCode, Shift

End Sub

' 그리드 편집 프로시저

Sub MSFlex_Edit(Grd As Control, Edt As Control, KeyAscii As Integer)

Select Case KeyAscii

Case 0 To 32

Edt = Grd

Edt.SelStart = 1000

Case Else

Edt = Chr(KeyAscii)

Edt.SelStart = 1

End Select

Edt.Move Grd.Left + Grd.CellLeft, Grd.Top + Grd.CellTop, _

Grd.CellWidth, Grd.CellHeight

Edt.Visible = True

Edt.SetFocus

End Sub

Sub MSFlex_EditKeyCode(Grd As Control, Edt As Control, KeyCode As Integer, Shift As Integer)

' 표준 편집 컨트롤 처리.

Select Case KeyCode

' ESC: MSFlexGrid에 포커스를 숨기고 반환

Case 27

Edt.Visible = False

Grd.SetFocus

' ENTER는 포커스를 MSFlexGrid에 반환

Case 13

Grd.SetFocus

' 위로...

Case 38

Grd.SetFocus

DoEvents

If Grd.Row > Grd.FixedRows Then Grd.Row = Grd.Row - 1

' 아래로.

Case 40

Grd.SetFocus

DoEvents

If Grd.Row > Grd.Rows Then Grd.Row = Grd.Row + 1

End Select

End Sub

도표에 편집기능을 넣자

도표 입력 시 똑같은 글자를 계속 치자니 얼마나 짜증나겠는가 또는 한참 입력하고 나서야 한 칸씩 자료가 밀려 입력된 것을 알아차렸을 때는 미칠 지경인 경우가 한 두 번이 아니었다. 그림과 같이 셀에 오른쪽 마우스를 누르면 편집기능이 나타나 선택된 셀 만큼의 자료를 다른 셀로 옮길 수 있다면 그러한 문제로부터 해방될 수 있을 것이다.

[실전 예]

[메뉴편집기]를 사용하여 먼저 메뉴를 만든다.

에 체크하지 않으면 폼에 메뉴바에 편집메뉴가 보이지 않게 된다.

Private Sub EditClear_Click()

Call Edit_Clear(fg1)

End Sub

Private Sub EditCopy_Click()

Call Edit_Copy(fg1)

End Sub

Private Sub EditCut_Click()

Call Edit_Cut(fg1)

End Sub

Private Sub EditPaste_Click()

Call Edit_Paste(fg1)

End Sub

Private Sub EditSelect_Click()

Call Edit_Select(fg1)

End Sub

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

If Button = 2 Then ‘마우스 오른쪽 단추는 2

PopupMenu mnu_edit ’PopupMenu를 사용하여 mnu_edit이름으로 된 메뉴호출

End If

End Sub

모듈(Module) 부분에 작성하여 중복을 사용을 방지한다

Public Sub Edit_Clear(Grd As Control)

Dim irow As Integer, icol As Integer

For irow = Grd.Row To Grd.RowSel

For icol = Grd.col To Grd.ColSel

Grd.TextMatrix(irow, icol) = ""

End Sub

Public Sub Edit_Copy(Grd As Control)

Dim tmpText As String

tmpText = Grd.Clip

Clipboard.Clear

Clipboard.SetText tmpText

End Sub

Public Sub Edit_Cut(Grd As Control)

Dim tmpText As String

tmpText = Grd.Clip

Clipboard.Clear

Clipboard.SetText tmpText

Call Edit_Clear(Grd)

End Sub

Public Sub Edit_Paste(Grd As Control)

Dim tmpText As String

tmpText = Clipboard.GetText

Grd.Clip = tmpText

End Sub

Public Sub Edit_Select(Grd As Control)

Grd.Row = 1

Grd.col = 1

Grd.RowSel = Grd.Rows - 1

Grd.ColSel = Grd.Cols - 1

End Sub

제목이 들어갈 고정 셀의 영역이 복잡할 때

셀을 합병하여야 할 때가 생길 것이다. Visual Basic 함수와 속성을 모두 기억할 수는 없는 것. fg1.을 쳐서 MergeCells를 선택한 다음 =를 누르기만 하면 선택 안내 화면이 다음과 같이 나온다. 이해하기 쉽게 나열되어 있지만 이 글을 읽는 독자라면 대부분 더 간단히 고쳐 쓸 수 있으리라 본다.

Private Sub Form_Load()

fg1.FontName = "굴림"

fg1.FontSize = 9

fg1.MergeCells = flexMergeRestrictRows ’ Row부분을 제한

fg1.MergeRow(0) = True ’ Row 첫 번째 줄 합병

fg1.MergeRow(1) = True ’ Row 두 번째 줄 합병

fg1.MergeCells = flexMergeRestrictColumns 'Column 제한

fg1.MergeCol(0) = True

fg1.Clear

fg1.Rows = 62

fg1.Cols = 23

fg1.TextMatrix(0, 1) = "1학년"

fg1.TextMatrix(0, 2) = "1학년"

fg1.TextMatrix(0, 3) = "1학년"

fg1.TextMatrix(0, 4) = "2학년"

fg1.TextMatrix(0, 5) = "2학년"

fg1.TextMatrix(0, 6) = "2학년"

fg1.TextMatrix(0, 7) = "3학년"

fg1.TextMatrix(0, 8) = "3학년"

fg1.TextMatrix(0, 9) = "3학년"

fg1.TextMatrix(1, 1) = "재학"

fg1.TextMatrix(1, 2) = "학급"

fg1.TextMatrix(1, 3) = "번호"

fg1.TextMatrix(1, 4) = "재학"

fg1.TextMatrix(1, 5) = "학급"

fg1.TextMatrix(1, 6) = "번호"

fg1.TextMatrix(1, 7) = "재학"

fg1.TextMatrix(1, 8) = "학급"

fg1.TextMatrix(1, 9) = "번호"

fg1.TextMatrix(0, 10) = "인사등록"

fg1.TextMatrix(0, 11) = "인사등록"

fg1.TextMatrix(0, 12) = "인사등록"

fg1.TextMatrix(0, 13) = "인사등록"

fg1.TextMatrix(1, 10) = "성명"

fg1.TextMatrix(1, 11) = "주민번호"

fg1.TextMatrix(1, 12) = "성별"

fg1.TextMatrix(1, 13) = "학생ID"

fg1.TextMatrix(0, 14) = "1학기"

fg1.TextMatrix(0, 15) = "1학기"

fg1.TextMatrix(0, 16) = "1학기"

fg1.TextMatrix(1, 14) = "중간"

fg1.TextMatrix(1, 15) = "기말"

fg1.TextMatrix(1, 16) = "합산"

fg1.TextMatrix(0, 17) = "2학기"

fg1.TextMatrix(0, 18) = "2학기"

fg1.TextMatrix(0, 19) = "2학기"

fg1.TextMatrix(0, 20) = "2학기"

fg1.TextMatrix(1, 17) = "중간"

fg1.TextMatrix(1, 18) = "기말"

fg1.TextMatrix(1, 19) = "합산"

fg1.TextMatrix(1, 20) = "년말합산"

fg1.TextMatrix(0, 21) = "기타"

fg1.TextMatrix(0, 22) = "기타"

fg1.TextMatrix(1, 21) = "성취도"

fg1.TextMatrix(1, 22) = "기타"

fg1.ColWidth(0) = 350

fg1.ColAlignment(0) = 1

For c = 1 To 9

fg1.ColWidth(c) = 400

fg1.ColAlignment(c) = 1

fg1.ColWidth(1) = 700

fg1.ColWidth(4) = 700

fg1.ColWidth(7) = 700

fg1.ColWidth(10) = 1000

fg1.ColWidth(11) = 1600

fg1.ColWidth(12) = 400

fg1.ColWidth(13) = 1000

fg1.ColAlignment(10) = 1

fg1.ColAlignment(11) = 1

fg1.ColAlignment(12) = 1

fg1.ColAlignment(13) = 1

For c = 14 To 22

fg1.ColWidth(c) = 350

fg1.ColAlignment(c) = 1

fg1.RowHeight(1) = 600

End Sub

큰 영역을 선택하는데는 ComboBox를 잘 활용하자.

Combo2.Clear

Combo2.AddItem “공통”

Combo2.AddItem “정보과”

Combo2.AddItem “상과”

Combo2.ListIndex = 0 ’공통을 선택한 상태, 1은 정보과, 2는 상과

ListBox는 다중 선택에 필수적으로 쓰인다.

ListBox를 이용하여 여러 가지 자료를 선택할 때 ListBox 속성(Property)중 style에 꼭 1-확인란을 선택하여야 한다.

나열된 list의 확인란의 check상태는 List1(0).Selected=True로 나타나며 체크가 안된 상태는 List1(0).Selected=False로 나타난다

Private Sub Form_Load()

Dim b as Integer

List1(0).Clear

List1(1).Clear

List1(2).Clear

For b = 1 To 20

List1(0).AddItem Trim(Str(b)) & "반"

List1(1).AddItem Trim(Str(b)) & "반"

List1(2).AddItem Trim(Str(b)) & "반"

End sub

Private Sub Command8_Click()

Dim TEXT_STR As String

Screen.MousePointer = 11

For h = 1 To 3

TEXT_STR = ""

For b = 0 To 19

If List1(h - 1).Selected(b) = True Then 'check확인

TEXT_STR = TEXT_STR + Format(b + 1, "@@")

End If

Msgbox Str(h) & "학년은 " & TEXT_STR &“을 선택했습니다”

Screen.MousePointer = 0

End Sub

진행바는 만들어 쓰는 편이 보기에 좋다

Form에 PictureBox를 끌어다 넣고 Form Load 부분에 색을 파랗게 지정한다. 지정하지 않을 경우는 흑백으로 실행시 출력된다.

Private Sub Form_Load()

Picture1.Visible = False

Picture1.ForeColor = RGB(0, 0, 255): '파란색

End Sub

Private Sub Command1_Click()

Screen.MousePointer = 11

For b = 1 To 500

Percent = (b / 500) * 100 '백분율 값을 구한다

updateprogress Picture1, Percent

DoEvents

Next b

Screen.MousePointer = 0

End Sub

Public Sub updateprogress(PBox As Control, ByVal Percent)

Dim num As String

If Not PBox.AutoRedraw Then

PBox.AutoRedraw = True

End If

PBox.Cls

PBox.ScaleWidth = 100

PBox.DrawMode = 10

num = Format(Percent, "##0") + "%"

PBox.CurrentX = 50 - PBox.TextWidth(num) / 2

PBox.CurrentY = (PBox.ScaleHeight - PBox.TextHeight(num)) / 2

PBox.Print num

PBox.Line (0, 0)-(Percent, PBox.ScaleHeight), , BF

PBox.Refresh

End Sub

원하는 파일을 선택해서 다른 폴더로 옮길 때

물론 윈도우 탐색기를 이용하여 옮기고자 하는 파일을 복사할 수 있다. 그러나 어쩐지 귀찮은 경우가 많다. 화면을 hidden시키고 탐색기를 눌러 파일 찿는 일이 잦아지면 스트레스가 쌓이지 않는 사람은 결코 없을 것이다.

Private Sub Form_Load()

drvDrive.Drive = "C:"

dirDirectory.Path = "C:\windows"

Frame2.Visible = True

End Sub

DriveListBox부분

Private Sub drvDrive_Change()

On Error GoTo DriveError

dirDirectory.Path = drvDrive.Drive

Exit Sub

DriveError:

MsgBox "Drive error!", 48, "Error"

drvDrive.Drive = dirDirectory.Path

Resume Next

End Sub

DirListBox

Private Sub dirDirectory_Change()

File1.Path = dirDirectory.Path

List1.Clear

For i = 0 To File1.ListCount - 1

List1.AddItem File1.List(i)

End Sub

'버튼을 누른 경우

Private Sub Command9_Click()

On Error GoTo errdrive

Dim source_file As String

Dim target As String

Screen.MousePointer = 11

For i = 0 To List1.ListCount - 1

If List1.Selected(i) = True Then

source_file = dirDirectory.Path & "\" & List1.List(i)

If Right(Dir1.Path, 1) = "\" Then

target = Dir1.Path & List1.List(i)

Else

target = Dir1.Path & "\" & List1.List(i)

End If

FileCopy source_file, target

End If

Screen.MousePointer = 0

MsgBox "화일이동이 끝났습니다"

Exit Sub

errdrive:

If Err = 70 Then

MsgBox "화일을 누가 사용중 입니다..."

End If

End Sub

BMP ⇔ JPG 이미지 전환

PictureBox 나 ImageBox 컨트롤은 비트맵, 아이콘, 메타 파일, 확장 메타 파일, JPEG 또는 GIF 파일 형식으로 그림 파일을 표시할 수 있으나, 가장 많이 쓰는 JPG(JPEG) 타입으로는 아직까지는 저장이 되지 않는다.

▶ PictureBox 컨트롤로 그래픽 로드하기

컨트롤의 속성 창에서 Picture 속성을 선택하여 디자인 모드에서 PictureBox 컨트롤로 그림을 로드할 수 있다. 또는 실행 모드에서 Picture 속성과 LoadPicture 함수를 사용하여 로드할 수 있다.

Set Picture1.Picture =_

LoadPicture("c:\Windows\Winlogo.cur", vbLPLarge, vbLPColor)

PictureBox 컨트롤에서 그래픽을 지우려면 파일 이름을 지정하지 않고 LoadPicture 함수를 사용한다.

Set Picture1.Picture = LoadPicture

▶ 인터넷 자료실(비주얼을 사랑하는 모임)에 가면 소스 통째 공개된 것이 있다. Delphi2.0으로 만들어진 JPG관련 DLL함수가 공개되어 있다. 이것을 이용하면 VB에 부족한 부분을 메꿀 수 있을 것이다. 물론 돈만 있으면 www.download.com에 가면 모든 것이 해결되지만 이 책을 보는 독자는 그렇지 않은 사정에 놓인 분들이 대부분이라 생각된다. 우선 아래 모듈부분에 다음과 같이 선언하고 폼에 Picture박스와 버튼을 드래그 한다.

‘모듈부분에 선언

Declare Function Load_JPG Lib "NViewLib.dll" (ByVal filename As String, ByVal a As Integer) As Long

Declare Function Load_GIF Lib "NViewLib.dll" (ByVal filename As String, ByVal a As Integer) As Long

Declare Function NViewLibLoad Lib "NViewLib.dll" (ByVal filename As String, ByVal a As Integer) As Long

Declare Function NViewLibSaveAsJPG Lib "NViewLib.dll" (ByVal Quality As Integer, ByVal filename As String) As Integer

Declare Function NViewLibSetLanguage Lib "NViewLib.dll" (ByVal Language As String) As Integer

Declare Sub NViewLibSetCustomLang Lib "NViewLib.dll" (ByVal pProgress As String, ByVal pError As String, ByVal pLoad As String, ByVal pErrLoad As String, ByVal pWarning As String)

Declare Function GetWidth Lib "NViewLib.dll" () As Integer

Declare Function GetHeight Lib "NViewLib.dll" () As Integer

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

[폼부분에 작성]

Sub NviewLibSave(JpegQuality As Integer, filename As String)

On Error Resume Next 'This line is very important...

Dim a As Integer

a = NViewLibSaveAsJPG(JpegQuality, filename)

If a = 0 Then

SavePicture Picture1.Image, "~temp.BMP"

a = NViewLibLoad("~temp.BMP", 0)

a = NViewLibSaveAsJPG(80, filename)

Kill "~temp.bmp"

End If

End Sub

Sub NViewLibShowPicutre(Picture1 As Control, filename As String, ShowProgress As Integer)

Dim ShadowDC As Long, a As Long, di As Long, Pwidth As Long, Pheight As Long

On Error Resume Next

With Picture1

.ScaleMode = 3

.AutoRedraw = True

.Cls

.Refresh

ShadowDC = CreateCompatibleDC(.hdc)

a = NViewLibLoad(filename, ShowProgress)

Pwidth = (GetWidth() + 4) * Screen.TwipsPerPixelX

Pheight = (GetHeight() + 4) * Screen.TwipsPerPixelY

.Width = Pwidth

.Height = Pheight

b = SelectObject(ShadowDC, a)

'You can use either BitBlt or StretchBlt. I heard StretchBlt is faster, but I do not know...

'di = BitBlt(picture1.hdc, 0, 0, picture1.Width, picture1.Height, ShadowDC, 0, 0, &HCC0020)

di = StretchBlt(.hdc, 0, 0, Pwidth, Pheight, ShadowDC, 0, 0, Pwidth, Pheight, &HCC0020)

di = SelectObject(ShadowDC, b)

di = DeleteObject(b)

di = DeleteDC(ShadowDC)

.Refresh

End With

End Sub

▶ 다음은 PictureBox에 DLL함수를 사용하여 Tga, Pcx, Gig, Bmp형식을 불러오는 형식을 나타낸 것이다.

NViewLibShowPicutre Picture1, "cat.tga", 1

NViewLibShowPicutre Picture1, "cat.pcx", 0

NViewLibShowPicutre Picture1, "cat.gig", 1

NViewLibShowPicutre Picture1, "cat.bmp", 0

▶ JPG저장

NviewLibSave 10, "junk.jpg"

【주의】DLL함수로 불러온 후에 저장하여야 저장이 된다. 예제 소스 CD안의 nviewlib.HLP를 참조하면 된다.

이미지를 프린트 할 때 PaintPicture를 쓴다

object.PaintPicture picture, x1, y1, width1, height1, x2, y2, width2, height2, opcode

프린터 개체를이용한 인쇄

예) Printer.PaintPicture img그림.Picture, 9300, 900, 1500, 1700

큰 PictureBox에 있는 이미지 일부분을 복사해서 다른 PictureBox로 복사할 때의 모드

예) Picture1.PaintPicture pic그림.Image, 0, 0, 1800, 2200, 5000, 4000, 1800, 2200

img그림 = Picture1.Image

구성요소	설 명
object	선택. 적용 대상 목록에 있는 개체로 평가되는 개체식. objec가 생략되었다면 포커스를 갖는Form 개체를 object로 가정합니다.
Picture	필수. object에 그려질 그래픽의 원본. Form 또는 PictureBox의 Picture 속성이어야 합니다.
x1, y1	필수. 그려질 picture의 object에 대상 좌표(x-axis and y-axis)를 나타내는 단정도 값. object의 ScaleMode 속성은 사용된 측정 단위를 지정합니다.
Width1	선택. picture의 너비를 나타내는 단정도 값. ScaleMode 속성은 사용된 측정 단위를 결정합니다. 대상 너비가 원본 너비(width2)보다 크거나 작다면 picture는 대상 너비에 맞게 늘어나거나 줄어듭니다. 생략되었으면 원본 너비가 사용됩니다.
Height1	선택. picture의 높이를 나타내는 단정도 값. ScaleMode 속성은 사용된 측정 단위를 지정합니다. 대상 높이가 원본 높이(height2)보다 크거나 작다면, picture는 대상 너비에 맞게 늘어나거나 줄어듭니다. 생략되었으면 원본 높이가 사용됩니다.
x2, y2	선택. picture내에 있는 오려낼 영역의 좌표(x-axis 와 y-axis)를 나타내는 단정도 값. ScaleMode 속성은 사용된 측정 단위를 결정합니다. 생략되어 있으면 0으로 간주됩니다,
Width2	선택. picture내에 있는 오려낼 영역의 원본 너비를 나타내는 단정도 값. ScaleMode 속성은 사용된 측정 단위를 결정합니다. 생략되었으면 전체 원본 너비가 사용 됩니다.
Height2	선택. picture내에 있는 오려낼 영역의 원본 높이를 나타내는 단정도 값. ScaleMode 속성은 사용된 측정 단위를 지정합니다. 생략되었으면 전체 원본 높이를 사용합니다.
Opcode	선택. 비트맵으로만 사용된 자세한 값과 코드. 그것은 picture가 object에서 그려질 때 picture에 대해 수행되는 비트 단위 연산(예: vbMergeCopy 또는 vbSrcAnd 연산자)을 정의합니다.

Bmp를 PictureBox 컨트롤로 로드하는 것과 Windows API 함수 BitBlt()를 사용하여 여기에 그림을 추가하는 것과는 차이가 있다는 것을 유의하십시오. 사용자가 이미지를 BitBlt할 때 PictureBox 컨트롤은 LoadPicture 메서드를 사용할 경우 처럼 크기를 다시 조정하는 법을 모릅니다. 또한 ScaleWidth와 ScaleHeight 속성을 이미지 크기에 설정하는 것은 효과가 없습니다. BitBlt이후 PictureBox를 새로운 그림 크기로 다시 조정하고 싶을 경우 사용자는 코드를 이용하여 단위를 변경하고 테두리를 처리하여 수동으로 이 작업을 해야합니다. 다음은 이러한 작업을 하는 방법에 관한 간단한 보기입니다.

Sub ResizePictureBoxToImage(pic as PictureBox, twipWd _

as Integer, twipHt as Integer)

' 이 코드는 모든 단위를 트윕으로 인식합니다.

' 트윕이 아니면 코드가 루틴을 호출하기 전에

' 트윕으로 변환해야 합니다. 또한 이미지가 0,0으로

' 작성된 것으로 인식합니다

Dim BorderHt as Integer, BorderWd as Integer

BorderWd = Pic.Width - Pic.ScaleWidth

BorderHt = Pic.Height - Pic.ScaleHeight

pic.Move pic.Left, pic.Top, twipWd + BorderWd, twipHt + BorderHt

End Sub

Form의 컨트롤 Freesize

www.download.com에 가면 freeseze.ocx를 팔고 있다. shareware인 경우 구입하라는 메시지가 자주 떠서 쓸 수 가 없다. 돈 안들이고 화면이 커지거나 작아질 때 컨트롤의 크기가 자동으로 커지거나 작아질 수 없을까? 특히 도표 같은 경우는 화면이 커진 후 그대로 있을 경우 보기가 아주 흉하다. 대부분 한 폼에 컨트롤이 100개 이상 쓰이지 않기 때문에 배열을 100정도로 모듈에 선언 해놓고 각 폼마다 Call free_size(Me) 와 Call free_resize(Me) 만 작성해 놓으면 크기에 다른 걱정은 끝이다. 물론 폰트 크기도 조절하면 좋겠지만 실무상으로 폰트크기는 별 필요성이 없어서 제외 시켰다.

[모듈 부분에서]

'form resize variable

Global FW As Long '폼의 폭

Global FH As Long '폼의 높이

Global CW(100) As Long '컨트롤의 폭

Global CH(100) As Long '컨트롤의 높이

Global CL(100) As Long '컨트롤의 왼쪽 위치

Global ctop(100) As Long '컨트롤의 상단 위치

Global CF(100) As Single '컨트롤의 문자 크기

[폼에서]

Private Sub Form_Load()

Call free_size(Me)

End Sub

Private Sub Form_Resize()

Call free_resize(Me)

End Sub

도표인쇄는 어떻게하지?

다음은 화면상의 도표이다.

프린터 버튼 루틴을 통해서 화면인쇄를 한 결과

VB프로그램을 개발하는 사람이라면 누구나 가장 곤혹스러워 하는 부분이 인쇄 부분일 것이다.

Crystal Repoter도 기능에 비하면 사용이 복잡하고 DataRepoter 또한 불편한 기능이 효과 보다 더 많다. 인쇄전용 OCX를 돈주고 사자니 또 배포하려니 여간 부담이 되지 않을 수 없다. 편리한 만큼 돈이 아주 많이 든다. 그래서 간단한 도표 정도는 정교하지는 않지만 필자가 오래 전에 만들었던 루틴을 사용하면 기본적인 도표는 거의 인쇄가 가능하다. 좀 무식하게 짜여진 부분이 있으니 독자 여러분이 고쳐 사용하도록 하면 좋겠다.

Sub PrintGrid(grdcontrol As Control, _

intToPMARGIN As Long, _

intLeftMargin As Long, _

sngScale As Single, _

printscale As Integer, _

rgbvalue As Boolean, _

fixedprint As Integer, _

show_form As Boolean)

Dim str_format As String

Dim LANDSCAPE_X As Long

Dim PORTRAIT_Y As Long

Dim lefttab As Long

lefttab = 50

Screen.MousePointer = 11

If printscale < 8 Then

strFontName = "Small fonts"

Else

strFontName = "바탕체"

End If

With frmscreen

.FontName = strFontName

.FontSize = printscale

.FontTransparent = True

.FontStrikethru = False

End With

'----------------------

Dim MAX_STR As String

Dim MAX_LEN As Integer

Dim MAX_H As Long

Dim MAX_w As Long

Dim FIXED_C As Long

Dim intTextHeight As Long

StART_C = 0

end_c = grdcontrol.Cols - 1

'-------------------------

'강조된셀 칠하기

Dim FIXED_H As Long

FIXED_H = 0

If grdcontrol.FixedRows > 0 Then

For i = 0 To grdcontrol.Rows - 1

FIXED_H = FIXED_H + grdcontrol.RowHeight(i) * sngScale

Next i

End If

If rgbvalue = True Then

frmscreen.Line (intLeftMargin, intToPMARGIN) _

-(intLeftMargin + grdcontrol.ColWidth(0) * sngScale, intToPMARGIN + FIXED_H), RGB(224, 223, 224), BF

Else

frmscreen.Line (intLeftMargin, intToPMARGIN) _

-(intLeftMargin + grdcontrol.ColWidth(0) * sngScale, intToPMARGIN + FIXED_H), , B

End If

DoEvents

If grdcontrol.FixedCols > 0 Then

'Add a block light gray background to columns > 0, if fixed

FIXED_C = 0

For i = 0 To grdcontrol.Cols - 1

FIXED_C = FIXED_C + grdcontrol.ColWidth(i) * sngScale

End If

If rgbvalue = True Then

frmscreen.Line (intLeftMargin + grdcontrol.ColWidth(0) * sngScale, intToPMARGIN) _

-(intLeftMargin + FIXED_C, intToPMARGIN + grdcontrol.RowHeight(0) * sngScale), RGB(224, 223, 224), BF

Else

frmscreen.Line (intLeftMargin + grdcontrol.ColWidth(0) * sngScale, intToPMARGIN) _

-(intLeftMargin + FIXED_C, intToPMARGIN + grdcontrol.RowHeight(0) * sngScale), , B

End If

DoEvents

frmscreen.Width = intLeftMargin + FIXED_C + 500

frmscreen.Height = intToPMARGIN + FIXED_H + 500

DoEvents

'Print the text from the grid 글자찍기

intTextHeight = frmscreen.TextHeight("0")

For intCol = 0 To grdcontrol.Cols - 1

If intCol = 0 Then

intStartWidth = intLeftMargin

End If

intStartHeight = intToPMARGIN

frmscreen.CurrentY = intStartHeight + grdcontrol.RowHeight(0) / 4

frmscreen.CurrentX = intStartWidth + lefttab

For intRow = 0 To grdcontrol.Rows - 1

If intRow < grdcontrol.FixedRows Then

Select Case fixedprint

Case 0

frmscreen.Print grdcontrol.TextArray(intCol + grdcontrol.Cols * intRow)

Case Else

MAX_STR = grdcontrol.TextArray(intCol + grdcontrol.Cols * intRow)

MAX_LEN = Len(grdcontrol.TextArray(intCol + grdcontrol.Cols * intRow))

MAX_H = 0

jump = 1

frmscreen.CurrentY = intStartHeight + MAX_H + (grdcontrol.RowHeight(intRow) * sngScale \ 5)

frmscreen.CurrentX = intStartWidth + lefttab

If MAX_LEN < fixedprint Then

frmscreen.Print MAX_STR

Exit Do

End If

If (jump + fixedprint - 1) > MAX_LEN Then

tt = (jump + fixedprint - 1) - MAX_LEN

frmscreen.Print Mid(MAX_STR, jump, tt)

Exit Do

Else

frmscreen.Print Mid(MAX_STR, jump, fixedprint)

End If

MAX_H = MAX_H + intTextHeight * sngScale

jump = jump + fixedprint

Loop

End Select

Else

'multi line_print

Dim w_str As Integer

Dim H_str As String

Dim int_line_x As Long

Dim add_line_y As Long

str_format = grdcontrol.TextArray(intCol + grdcontrol.Cols * intRow)

add_line_y = intStartHeight + grdcontrol.RowHeight(0) / 8

w_str = 0

int_line_x = 0

Do While w_str <= Len(str_format)

If int_line_x >= (grdcontrol.ColWidth(intCol) - intTextHeight) Then

int_line_x = 0

add_line_y = add_line_y + frmscreen.TextHeight("0")

frmscreen.CurrentY = add_line_y

frmscreen.CurrentX = intStartWidth + lefttab

Else

frmscreen.CurrentY = add_line_y

frmscreen.CurrentX = intStartWidth + int_line_x + lefttab

End If

w_str = w_str + 1

H_str = Mid(str_format, w_str, 1)

Select Case H_str

Case Chr(10)

Case Chr(13)

int_line_x = 0

add_line_y = add_line_y + frmscreen.TextHeight(H_str)

frmscreen.CurrentY = add_line_y

frmscreen.CurrentX = intStartWidth + lefttab

Case "0" To "9"

frmscreen.Print Mid(str_format, w_str, 1)

int_line_x = int_line_x + frmscreen.TextHeight(H_str) / 2

Case "A" To "Z"

frmscreen.Print Mid(str_format, w_str, 1)

int_line_x = int_line_x + frmscreen.TextHeight(H_str) / 2

Case "a" To "z"

frmscreen.Print Mid(str_format, w_str, 1)

int_line_x = int_line_x + frmscreen.TextHeight(H_str) / 2

Case Else

frmscreen.Print Mid(str_format, w_str, 1)

int_line_x = int_line_x + frmscreen.TextHeight(H_str)

End Select

Loop

End If

'Get the current height of grid

frmscreen.CurrentY = intStartHeight

frmscreen.CurrentX = intStartWidth

intStartHeight = intStartHeight + grdcontrol.RowHeight(intRow) * sngScale

DoEvents

Next intRow

intStartWidth = intStartWidth + grdcontrol.ColWidth(intCol) * sngScale

Next intCol

'Print the grid LINE of the control

Dim last_line As Long

Dim comp1 As String

Dim comp2 As String

intStartHeight = intToPMARGIN

For intRow = 0 To grdcontrol.Rows - 1

intStartWidth = intLeftMargin

For intCol = 0 To grdcontrol.Cols - 1

MAX_w = grdcontrol.ColWidth(intCol) * sngScale

Call line_가로(intRow, intStartWidth, intStartHeight, MAX_w, grdcontrol.RowHeight(intRow) * sngScale)

intStartWidth = intStartWidth + grdcontrol.ColWidth(intCol) * sngScale

Next intCol

intStartHeight = intStartHeight + grdcontrol.RowHeight(intRow) * sngScale

DoEvents

Next intRow

'테두리그리기

DoEvents

frmscreen.Caption = "화면인쇄 "

Screen.MousePointer = 0

If show_form = True Then

frmscreen.Show 1

End If

End Sub

Public Sub line_가로(cunt, xpos&, ypos&, linetabx&, linetaby&)

frmscreen.Line (xpos&, ypos&)-(xpos&, ypos& + linetaby&)

frmscreen.Line (xpos& + linetabx&, ypos&)-(xpos& + linetabx&, ypos& + linetaby&)

frmscreen.Line (xpos&, ypos&)-(xpos& + linetabx&, ypos&)

frmscreen.Line (xpos&, ypos& + linetaby&)-(xpos& + linetabx&, ypos& + linetaby&)

End Sub

Function FindFont(Font As Variant) As Integer

Dim intCtr As Integer

For intCtr = 0 To Printer.FontCount - 1

If Font = Printer.Fonts(intCtr) Then

FindFont = True

Exit Function

End If

Next intCtr

FindFont = False

End Function

Public Sub line_display(cunt, xpos&, ypos&, linetabx&, linetaby&)

If ((cunt - 1) Mod 5) = 0 Then

frmscreen.Line (xpos&, ypos&)-(xpos& + linetabx&, ypos&), , B

frmscreen.Line (xpos&, ypos& + linetaby&)-(xpos& + linetabx&, ypos& + linetaby&), , B

frmscreen.Line (xpos&, ypos& + linetaby& + 2)-(xpos& + linetabx&, ypos& + linetaby& + 2), , B

frmscreen.Line (xpos&, ypos& + linetaby& + 3)-(xpos& + linetabx&, ypos& + linetaby& + 3), , B

Else

frmscreen.Line (xpos&, ypos& + linetaby&)-(xpos& + linetabx&, ypos& + linetaby&), , B

End If

End Sub

위 폼의 Fg1(위)도표와 Fg2(아래)도표 XPrintGrid로 인쇄하는 방법

Call XPrintGrid(fg1, 2300, 900, 1, 8, True, 2, 50)

’ fg1도표를 세로 2300트윕, 가로 900트윕, 크기는 100%(=1), 글자크기는 8, 고정셀 음영 True,

고정셀은 2자씩 인쇄, 셀안에서 50트윕 띄워서

Call XPrintGrid(fg2, return_line + 100, 900, 1, 8, True, 2, 50)

’ fg2도표를 세로 fg1세로끝 +100트윕, 가로 900트윕, 크기는 100%(=1), 글자크기는 8, 고정셀 음영 True, 고정셀은 2자씩 인쇄, 셀안에서 50트윕 띄워서

Pic_teacher = Left(teacher_name(Val(ha$), Class), 3) ‘이미지 파일 알아애기

strFileName = system_path & "\photo\" + pic_teacher + ".bmp"

If Dir(strFileName, 0) <> "" Then ‘파일이 있는가 없는가 조사

’있으면 사진 인쇄

Printer.PaintPicture Image1.Picture, 11800, 900, 1000, 1000

End If

위 폼의 Fg1(위)도표 print_step_merge로 인쇄하는 방법

‘모듈에 선언

Gloval mergeprint_step as Integer

‘프린터할 부분

mergeprint_step = 8 '왼쪽셀이 오른쪽 셀8개로 부분되기 때문에

Call print_step_merge(fg1, 2000, 800, 1, 8, False, 2, 50, 2, 21)

Printer.NewPage

Call print_step_merge(fg1, 2000, 800, 1, 8, False, 2, 50, 22, 41)

Printer.EndDoc

셀의 Rows 값이 320개가 넘기 때문에 도표를 한 용지에 그대로 찍을 수 없다

각 타이틀은 그대로 인쇄되면서 다음 내용이 이어져 인쇄가 되어야 한다

VSView3.ocx를 활용한 인쇄

'Option Explicit

Dim MyPage% 'Keep the output view to be printed

Dim OldOrientation 'Don't mess with my printer settings

Private Sub Command1_Click()

vsPrinter.PreviewPage = vsPrinter.PreviewPage - 1

End Sub

Private Sub cmb_printers_Click()

Dim s$

vsPrinter.Device = cmb_printers.List(cmb_printers.ListIndex)

'------------------------------------------------------

' Show selected printer attributes

'------------------------------------------------------

s = "DPI: " & Str$(vsPrinter.DPI) & Chr(13)

s = s & "Port: :" & vsPrinter.Port & Chr(13)

s = s & "Driver: :" & vsPrinter.Driver

lStatus = s

End Sub

Private Sub cmbOrientation_Click()

MousePointer = 11

vsPrinter.Orientation = cmbOrientation.ListIndex

cmbZoom_Click

'If MyPage >= 0 Then Command1_Click MyPage

MousePointer = 0

End Sub

Private Sub cmbZoom_Click()

vsPrinter.Visible = False

MousePointer = 11

'Change the screen size to zoom value

vsPrinter.Zoom = Val(cmbZoom)

MousePointer = 0

vsPrinter.Visible = True

End Sub

Private Function BoxText(Row%, col%) As String

'--------------------------------------------------------

' set the text for the boxes on the FlowChart sample

'--------------------------------------------------------

Static mValue%

mValue = mValue + 1

BoxText = "{\line VideoSoft vsView \line \b Box # \ul\i " & Format(mValue) & "}"

End Function

Private Function BoxX(Row%, col%, w!) As Single

BoxX = vsPrinter.MarginLeft + 500 + col * w * 1.2

End Function

Private Function BoxY(Row%, col%, h!) As Single

Dim Y!

Y = 1 / (2 ^ col) * (Row + 0.5) * 8 * h * 1.2

BoxY = vsPrinter.MarginTop + Y

End Function

Private Sub Command2_Click()

vsPrinter.PreviewPage = vsPrinter.PreviewPage + 1

End Sub

Private Sub Command3_Click()

SetupPrint.Show 1

End Sub

Private Sub Form_Load()

Dim i%, s$

'------------------------------------------------------

' save orientation to clean up later

'------------------------------------------------------

OldOrientation = vsPrinter.Orientation

MyPage = -1 ' no current page

'------------------------------------------------------

' preset zoom levels (you can choose your own)

'------------------------------------------------------

With cmbZoom

.AddItem "30"

.AddItem "50"

.AddItem "75"

.AddItem "100"

.AddItem "120"

.ListIndex = 0

End With

'------------------------------------------------------

' orientation (you cannot choose your own)

'------------------------------------------------------

With cmbOrientation

.AddItem "Portrait"

.AddItem "Landscape"

.ListIndex = Printer.Orientation - 1

End With

'------------------------------------------------------

' ready, set default page to 0

'------------------------------------------------------

MyPage = 0

With vsPrinter

.Preview = True ' Show preview to screen

.PreviewPage = 1 ' default preview page to first page

'------------------------------------------------------

' show available devices

' and honor Windows default selection

'------------------------------------------------------

Dim curdev%

For i = 0 To .NDevices - 1

cmb_printers.AddItem .Devices(i)

If .Devices(i) = .Device Then curdev = i

cmb_printers.ListIndex = curdev

End With

Call free_size(Me)

End Sub

Private Sub Form_Resize()

Call free_resize(Me)

End Sub

Public Sub vsprint_photo(v_img As Control, v_x0&, v_y0&, v_x1&, v_y1&, v_x2&, v_y2&)

vsPrinter.CurrentX = v_x0&

vsPrinter.CurrentY = v_y0&

vsPrinter.X1 = v_x0& + v_x1&

vsPrinter.Y1 = v_y0& + v_y1&

vsPrinter.X2 = v_x0& + v_x1& + v_x2&

vsPrinter.Y2 = v_y0& + v_y1& + v_y2&

vsPrinter.Picture = v_img.Picture

vsPrinter.CurrentY = v_y0& + v_y1& + v_y2&

vsPrinter = ""

End Sub

Public Sub vsprint_start(v_fontname As String, v_fontsize As Integer, v_TableBorder As Integer, v_pageBorder As Integer)

' remember page for use with Print command

MyPage = Index%

' we have a print job, so let's enable these guys

PRINTVIEW.cmbZoom.Enabled = True

'PRINTVIEW.cmdPrint.Enabled = True

PRINTVIEW.cmbOrientation.Enabled = True

' start the print preview job

PRINTVIEW.vsPrinter.Action = 3 ' StartDoc

'If vsPrinter.error Then Beep: Exit Sub

' set default style

With PRINTVIEW.vsPrinter

.FontName = v_fontname

.FontSize = v_fontsize

.FontBold = False

.FontItalic = False

.TextAlign = 0 'Left

.TableBorder = v_TableBorder

.PageBorder = v_pageBorder

.PenStyle = 0

.BrushStyle = 0

.PenWidth = 2

.PenColor = 0

.BrushColor = 0

.TextColor = 0

.Columns = 1

End With

End Sub

Public Sub vsprint_end(sp)

' restore defaults

MyPage = sp

' all done

PRINTVIEW.vsPrinter.Action = 6 'End Document

End Sub

Public Sub VSPRINT(fgrid As Control)

ReDim cell_str(500, 500) As String

Dim f$, body$, tw, savx

Dim sp%

Dim header As String

'headline****************************************

old_h = 0

For intRow = 0 To fgrid.FixedRows - 1

old_w = 0

For intCol = 0 To fgrid.Cols - 1

fgrid.col = intCol

fgrid.Row = intRow

If fgrid.CellWidth > fgrid.ColWidth(intCol) Then

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

old_w = old_w + fgrid.CellWidth * sngScale

memo_w = fgrid.CellWidth

add_w = 0

For intcol2 = intCol + 1 To fgrid.Cols - 1

add_w = add_w + fgrid.ColWidth(intcol2)

old_w = old_w + 3

If add_w >= memo_w Then

Exit For

End If

intCol = intcol2 - 1

Else

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

old_w = old_w + fgrid.ColWidth(intCol) * sngScale

End If

Next intCol

old_h = old_h + fgrid.RowHeight(intRow) * sngScale

Next intRow

'***************************************************

' initialize

f = ""

tw = 0

header = ""

For intCol = 0 To fgrid.Cols - 2

header = header & fgrid.TextMatrix(0, intCol) & "|"

f = f & cell_str(0, intCol) & "|"

tw = tw + Val(cell_str(0, intCol))

header = header & fgrid.TextMatrix(0, fgrid.Cols - 1) & ";"

f = f & cell_str(0, fgrid.Cols - 1) & ";"

tw = tw + Val(cell_str(0, fgrid.Cols - 1))

If (fgrid.Rows - 1) >= 1 Then

For intRow = 0 To fgrid.FixedRows

body = ""

For intCol = 0 To fgrid.Cols - 2

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

PRINTVIEW.vsPrinter.AddTable f, header, body, RGB(255, 255, 0)

For intRow = fgrid.FixedRows + 1 To fgrid.Rows - 1

body = ""

For intCol = 0 To fgrid.Cols - 2

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

PRINTVIEW.vsPrinter.Table = f + body

End If

Erase cell_str

End Sub

Public Sub vsprint_결재(xpos As Long, ypos As Long, str_q1 As String, str_q2 As String, str_q3 As String, str_q4 As String)

Dim memo_size As Integer

Dim count_str As Integer

Dim write_str(1 To 4) As String

write_str(1) = str_q1

write_str(2) = str_q2

write_str(3) = str_q3

write_str(4) = str_q4

count_str = 0

For CT = 1 To 4

If write_str(CT) <> "" Then

count_str = count_str + 1

End If

vsPrinter.BrushColor = RGB(190, 255, 190)

vsPrinter.TextAlign = taCenterTop

If str_q1 <> "" Then

vsPrinter.TextBox " 확 인", xpos, ypos, 300, 900, True, False, True

vsPrinter.TextBox str_q1, xpos + 300, ypos, 800, 300, False, False, True

vsPrinter.TextBox "", xpos + 300, ypos + 300, 800, 600, False, False, True

vsPrinter.TextAlign = 0 'Left

Else

vsPrinter.TextAlign = 0 'Left

Exit Sub

End If

If str_q2 <> "" Then

vsPrinter.TextBox str_q2, xpos + 1100, ypos, 800, 300, False, False, True

vsPrinter.TextBox "", xpos + 1100, ypos + 300, 800, 600, False, False, True

vsPrinter.TextAlign = 0 'Left

Else

vsPrinter.TextAlign = 0 'Left

Exit Sub

End If

If str_q3 <> "" Then

vsPrinter.TextBox str_q3, xpos + 1900, ypos, 800, 300, False, False, True

vsPrinter.TextBox "", xpos + 1900, ypos + 300, 800, 600, False, False, True

vsPrinter.TextAlign = 0 'Left

Else

vsPrinter.TextAlign = 0 'Left

Exit Sub

End If

If str_q4 <> "" Then

vsPrinter.TextBox str_q4, xpos + 2700, ypos, 800, 300, False, False, True

vsPrinter.TextBox "", xpos + 2700, ypos + 300, 800, 600, False, False, True

vsPrinter.TextAlign = 0 'Left

Else

vsPrinter.TextAlign = 0 'Left

Exit Sub

End If

End Sub

Public Sub vsprint_제목(str_q As String, fs As Integer, xpos As Long, ypos As Long)

memo_size = vsPrinter.FontSize

With vsPrinter

.FontSize = fs

.CurrentY = ypos

.CurrentX = xpos

End With

vsPrinter = str_q

vsPrinter.FontSize = memo_size

End Sub

Public Sub VSPRINT_분할(fgrid As Control, start_row, end_row)

ReDim cell_str(500, 500) As String

Dim f$, body$, tw, savx

Dim sp%

Dim header As String

'headline****************************************

old_h = 0

For intRow = 0 To fgrid.FixedRows - 1

old_w = 0

For intCol = 0 To fgrid.Cols - 1

fgrid.col = intCol

fgrid.Row = intRow

If fgrid.CellWidth > fgrid.ColWidth(intCol) Then

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

old_w = old_w + fgrid.CellWidth * sngScale

memo_w = fgrid.CellWidth

add_w = 0

For intcol2 = intCol + 1 To fgrid.Cols - 1

add_w = add_w + fgrid.ColWidth(intcol2)

old_w = old_w + 3

If add_w >= memo_w Then

Exit For

End If

intCol = intcol2 - 1

Else

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

old_w = old_w + fgrid.ColWidth(intCol) * sngScale

End If

Next intCol

old_h = old_h + fgrid.RowHeight(intRow) * sngScale

Next intRow

'***************************************************

' initialize

f = ""

tw = 0

header = ""

For intCol = 0 To fgrid.Cols - 2

header = header & fgrid.TextMatrix(0, intCol) & "|"

f = f & cell_str(0, intCol) & "|"

tw = tw + Val(cell_str(0, intCol))

header = header & fgrid.TextMatrix(0, fgrid.Cols - 1) & ";"

f = f & cell_str(0, fgrid.Cols - 1) & ";"

tw = tw + Val(cell_str(0, fgrid.Cols - 1))

xt = 0

For intRow = start_row To end_row

xt = xt + 1

body = ""

For intCol = 0 To fgrid.Cols - 2

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

If xt = 1 Then

PRINTVIEW.vsPrinter.AddTable f, header, body, RGB(255, 255, 0)

Else

PRINTVIEW.vsPrinter.Table = f + body

End If

Erase cell_str

End Sub

Public Sub VSPRINT_2중(fgrid As Control)

ReDim cell_str(500, 500) As String

Dim f$, body$, savx

Dim tw As Long

Dim sp%

Dim header As String

f = ""

tw = 0

header = ""

'headline****************************************

old_h = 0

old_w = 0

For intCol = 0 To fgrid.Cols - 2

fgrid.col = intCol

fgrid.Row = intRow

If fgrid.CellWidth > fgrid.ColWidth(intCol) Then

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth + 20))

header = header & fgrid.TextMatrix(intRow, intCol) & "|"

f = f & cell_str(intRow, intCol) & "|"

tw = tw + Val(cell_str(intRow, intCol))

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

old_w = old_w + fgrid.CellWidth

memo_w = fgrid.CellWidth

add_w = 0

For intcol2 = intCol + 1 To fgrid.Cols - 1

add_w = add_w + fgrid.ColWidth(intcol2)

If add_w >= memo_w Then

Exit For

End If

intCol = intcol2 - 1

Else

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

header = header & fgrid.TextMatrix(intRow, intCol) & "|"

f = f & cell_str(intRow, intCol) & "|"

tw = tw + Val(cell_str(intRow, intCol))

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

old_w = old_w + fgrid.ColWidth(intCol)

End If

Next intCol

'***************************************************

fgrid.col = fgrid.col - 1

intCol = fgrid.col - 1

fgrid.Row = intRow

If fgrid.CellWidth > fgrid.ColWidth(intCol) Then

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth + 20))

header = header & fgrid.TextMatrix(intRow, intCol) & "|"

f = f & cell_str(intRow, intCol) & "|"

tw = tw + Val(cell_str(intRow, intCol))

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

old_w = old_w + fgrid.CellWidth

memo_w = fgrid.CellWidth

add_w = 0

For intcol2 = intCol + 1 To fgrid.Cols - 1

add_w = add_w + fgrid.ColWidth(intcol2)

If add_w >= memo_w Then

Exit For

End If

intCol = intcol2 - 1

Else

cell_str(intRow, intCol) = Trim(Str(fgrid.CellWidth))

header = header & fgrid.TextMatrix(intRow, intCol) & "|"

f = f & cell_str(intRow, intCol) & "|"

tw = tw + Val(cell_str(intRow, intCol))

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

old_w = old_w + fgrid.ColWidth(intCol)

End If

header = header & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

f = f & cell_str(intRow, fgrid.Cols - 1) & ";"

tw = tw + Val(cell_str(intRow, fgrid.Cols - 1))

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

PRINTVIEW.vsPrinter.Table = f + body

intRow = 1

f = ""

tw = 0

header = ""

body = ""

'headline****************************************

old_h = 0

old_w = 0

For intCol = 0 To fgrid.Cols - 2

fgrid.col = intCol

fgrid.Row = intRow

cell_str(intRow, intCol) = Trim(Str(fgrid.ColWidth(intCol)))

'MsgBox cell_str(intRow, intCol)

header = header & fgrid.TextMatrix(intRow, intCol) & "|"

f = f & cell_str(intRow, intCol) & "|"

tw = tw + Val(cell_str(intRow, intCol))

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

old_w = old_w + fgrid.ColWidth(intCol)

Next intCol

'***************************************************

header = header & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

f = f & cell_str(intRow, fgrid.Cols - 1) & ";"

tw = tw + Val(cell_str(intRow, fgrid.Cols - 1))

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

PRINTVIEW.vsPrinter.Table = f + body

xt = 0

For intRow = 2 To fgrid.Rows - 1

xt = xt + 1

body = ""

For intCol = 0 To fgrid.Cols - 2

body = body & fgrid.TextMatrix(intRow, intCol) & "|"

body = body & fgrid.TextMatrix(intRow, fgrid.Cols - 1) & ";"

PRINTVIEW.vsPrinter.Table = f + body

Erase cell_str

End Sub

Public Sub VSPRINT_flexgrid(fgrid As Control)

PRINTVIEW.vsPrinter.RenderControl = fgrid.hWnd

End Sub

RoboPrint.ocx를 이용한 도표인쇄

RoboPrint의 특징은 VSview3보다 rtf(rich textfile format) 형식의 인쇄가 매우 용이한 것이 특징이다. 또한 VSview3는 MSFlexGrid의 내용을 그대로 화면에 떠 올릴수 없으나 RoboPrint는 가능하다. 물론 VSview3에서도 불가능한 것은 아니지만 또 다른 Videosoft사의 vsflexgrid.ocx를 추가로 구입하여냐 한다. 두회사 모두 도표 인쇄에서의 문제는 Rows값이 클 경우는 도표가 페이지 크기로 나뉘어서 우리가 원치 않는 타입의 인쇄가 이루어 진다는 것이다. 특히 셀이 여러개 합병된 상태에서 코딩으로 매 페이지마다 고정 컬럼의 타이틀를 만들기가 어렵다. 그것을 가단히 해결하는 것이 flexgrid.hwnd를 이용 직접 ocx개체이 띄우는 것인데 그렇게 된다면 폼에서 프로그램을 짤 때 도표를 쪼개는 식으로 나타내 주어야 한다.

� 메서드 및 속성 요약 정리

▶SampleMdi.Roboprint1.LVPrint

▶SampleMdi.Roboprint1.Preview

▶Roboprint1.Zoom = 12000/ Screen.width

▶RoboPrint.TopTitle [=string]

▶RoboPrint.FootTitle [=string]

The Alignment property syntax has these parts:

▶Roboprint1 [= number]

LLeft 0 (Default) Text is left-aligned.

RRight 1 Text is right-aligned; control is left aligned.

Ccenter 2 Text is centered.

▶object.ShowPrinterAlways = [Boolean]

True The Dialog Printer is showed before the Print action.

False (Default)The Dialog Printer isn뭪 showed before the Print action.

▶object.RepeatHeader = [Boolean]

True (Default) the Titles Columns of the Grid is Printed in each page.

False The Titles Columns of the Grid is Printed only in the First occur.

▶Roboprint. PrevBkColor [= color]

▶object.Orientation = [Number]

0 Portrait Orientation

1 Landscape Orientation

▶object.GridLines = [Boolean]

True (Default) Prints Borders if the GridControl.Grid = True

▶object.FromPage [= number]

▶object.ToPage [= number]

▶RoboPrint.Copies [= number]

▶RoboPrint.BtnPrintToolTipText [= string]

▶object.BorderText = [Boolean]

True (Default) Prints Borders if the TextControl.BorderStyle = 1- Fixed Single

▶Roboprint1 [= number]

Returns or sets a value that determines the alignment of FootTitle and TopTitle.

LLeft 0 (Default) Text is left-aligned.

RRight 1 Text is right-aligned; control is left aligned.

Ccenter 2 Text is centered.

Excel을 이용한 도표 인쇄

Excel를 이용한 인쇄는 Excel를 써본 사람이라면 편리함과 다양성에 원하는 모양을 원하는 대로 다 만들어 준다. 그러나 미리 양식 폼을 만들어야 하므로 데이터의 가로 세로 길이가 동시에 변하는 자료 출력에는 손이 매우 많이 가므로 결국에 가서는 이것도 쉽지 않는 게로구먼! 그렇지 뭐하나 그냥 되는 게 있간! 한 두 가지 하기엔 아주 편리하지만 조금만 복잡해도 지루해진다. 필자도 마찬가지여서 Excel를 활용한 모든 도표가 자동으로 인쇄되는 서브루틴을 만들지 않았다. 다음 증보판이 된다면 그때는 꼭 넣도록 하겠다. 죄송~

Dim exl As Excel.Application

Dim ws As Excel.Worksheet

Private Sub Command6_Click()

On Error GoTo ERRHANDLE:

On Error Resume Next

Set exl = GetObject(, "Excel.Application")

If Err.Number = 429 Then

Set exl = CreateObject("Excel.Application")

End If

'작성된 보고서 양식을 오픈한다.

exl.Workbooks.Open (program_path + "\" + "학급단표.xls")

'데이터베이스로부터 인쇄할 자료를 읽어 Excel로 넘긴다.

Dim rs As rdoResultset

Dim Query As String

Dim COLS As Integer

Dim Rows As Integer

Dim DestRange As String

Dim Row As Integer, Col As Integer

Rows = fg1.Rows - 1

exl.ActiveSheet.Range("A7:O7").Copy

DestRange = "A8:O" + CStr(6 + Rows - 3)

exl.ActiveSheet.Range(DestRange).Insert

For c = 0 To fg1.COLS - 1

For r = 0 To 50: 'fg1.Rows - 1

exl.Cells(r + 6, c + 1).Value = fg1.TextMatrix(r, c)

Next r

Next c

'처리된 행의 수를 되돌려준다.

DataTransfer = True

'Excel의 미리보기를 이용한다.

exl.WindowState = xlMaximized

exl.Visible = True

exl.ActiveSheet.PrintPreview

exl.Visible = False

'사용된 보고서 양식을 닫는다.

exl.ActiveWorkbook.Close False

exl.Quit

Exit Sub

ERRHANDLE:

MsgBox "엑셀이 설치되어 있어야 합니다"

End Sub

Private Sub Form_Unload(Cancel As Integer)

ex1.Quit ’종료

End Sub

기타 학습에 필요한 인쇄하기

이번 내용은 인쇄에 실제적으로 쓰이지는 않지만 초보자 입장에서 그래픽 인쇄가 어떻게 이루어 지는가를 쉽게 보여주고 학습할 수 있는 코스라 생각한다

Public Sub Printfrm(Pfrm As Form)

Pfrm.MousePointer = 11

' set fontsize for printer

Printer.FontSize = 8.25

' move then (0,0) on the printer object to center form on the page

Printer.ScaleLeft = -((Printer.Width - Pfrm.Width) / 2)

Printer.ScaleTop = -((Printer.Height - Pfrm.Height) / 2)

' set line thickness.

DrawWidth = 2

'draw form border

Printer.Line (0, 0)-Step(Pfrm.Width, Pfrm.Height), , B

'draw bottom of title bar

Printer.Line (0, barhgt)-Step(Pfrm.Width, 0)

'move x and y to center; then print "form" in the title bar

Printer.CurrentX = (Pfrm.Width - Printer.TextWidth("form1")) / 2

Printer.CurrentY = (barhgt - Printer.TextHeight("form1")) / 2

Printer.Print "form1"

' move the (0,0) on the printer object to the upper-left corner of

' the form's client area

SetClientPrintOrigin card

' redraw form lines on the printer

LinesOnPrinter

'cycle through the controls collection of the form

For ctlcnt = 0 To Pfrm.Controls.Count - 1

If TypeOf Pfrm.Controls(ctlcnt) Is CommandButton Then

DrawCmd Pfrm.Controls(ctlcnt)

ElseIf TypeOf Pfrm.Controls(ctlcnt) Is PictureBox Then

DrawPic Pfrm.Controls(ctlcnt)

ElseIf TypeOf Pfrm.Controls(ctlcnt) Is Label Then

'drawlbl Pfrm.controlsz(ctlcnt)

End If

Next ctlcnt

'print contents of printer object

Printer.EndDoc

'change cursor back to default

Pfrm.MousePointer = 0

End Sub

Private Sub Command5_Click()

Printfrm Me

End Sub

Public Sub Form_Paint()

DrawWidth = 2

'line(1450,360)-step(0,4040),qbcolor(8)

'line(2500,4950)-step(2532,922),qbcolor(8),b

End Sub

Public Sub LinesOnPrinter()

DrawWidth = 2

' Printer.Line (1450, 360)-Step(0, 4040), QBColor(0)

' Printer.Line (2500, 4950)-Step(2532, 922), QBColor(0), B

End Sub

Public Sub DrawCmd(cmdctrl As Control)

'save the control width and height in local variables

dx = cmdctrl.Width

dy = cmdctrl.Height

'save the control x and y position in local variables

cmdx = cmdctrl.Left

cmdy = cmdctrl.Top

'save the caption of the command button

captxt = cmdctrl.Caption

' set the outline width of the redrawn button

DrawWidth = 2

'move the x- and y-coordinates of the printer object to

' the control's location on the form

Printer.CurrentX = cmdx

Printer.CurrentY = cmdy

'draw a box to represent the button outline

Printer.Line -Step(dx, dy), , B

' move the x- and y-coordinates of the printer object

' to center the caption of the command button horizontally

' and vertically in the box on the printer object

Printer.CurrentX = cmdx + ((dx - Printer.TextWidth(captxt)) / 2)

Printer.CurrentY = cmdy + ((dy - Printer.TextHeight(captxt)) / 2)

' printer the caption on the printer object

Printer.Print cmdctrl.Caption

End Sub

Public Sub SetClientPrintOrigin(card)

Printer.CurrentX = 1000

Printer.CurrentY = 1000

End Sub

점점 짙어지는 배경 만들기

HTML 문서 배경에 많이 쓰이는 배경 만들기이다. 제어판에 디스플레이 색상표를 하이컬러 이상으로 잡아야 제대로 된 음영이 나타난다.

Call DrawBackGround

Private Sub DrawBackGround()

Const intBLUESTART% = 255

Const intBLUEEND% = 0

Const intBANDHEIGHT% = 2

Const intSHADOWSTART% = 8

Const intSHADOWCOLOR% = 0

Const intTEXTSTART% = 4

Const intTEXTCOLOR% = 15

Dim sngBlueCur As Single

Dim sngBlueStep As Single

Dim intFormHeight As Integer

Dim intFormWidth As Integer

Dim intY As Integer

'높이와 너비에 대한 시스템 값을 가져옵니다.

intFormHeight = ScaleHeight

intFormWidth = ScaleWidth

'단계 크기와 설치 시작값을 계산합니다.

sngBlueStep = intBANDHEIGHT * (intBLUEEND - intBLUESTART) / intFormHeight

sngBlueCur = intBLUESTART

'설치 화면을 그립니다.

For intY = 0 To intFormHeight Step intBANDHEIGHT

Line (-1, intY - 1)-(intFormWidth, intY + intBANDHEIGHT), RGB(0, 0, sngBlueCur), B

sngBlueCur = sngBlueCur + sngBlueStep

Next intY

End Sub

날짜관련 포맷

다음은 Format 함수를 사용하여 주어진 값을 Visual Basic 내부에 정의되어 있는 형식이나 아니면 사용자 정의 형식으로 변환하는 예제입니다. 날짜 구분 기호(/), 시간 구분 기호(:) , 오전/오후 리터럴에 대해서 시스템이 표시하는 실제 출력 형식은 그 코드가 실행되고 있는 시스템의 국가별 설정이 무엇으로 되어있느냐에 따라서 달라진다.

MyTime과 MyDate는 현재 시스템의 간단하게 표시 시간 설정과 간단하게 표시 날짜 설정을 사용해 개발 환경 내에 표시됩니다.

Dim MyTime, MyDate, MyStr

MyTime = #17:04:23#

MyDate = #January 27, 1993#

' 현재 시스템 시간을 자세하게 표시 시간 형식으로 정의된 시스템에 반환

MyStr = Format(Time, "Long Time")

' 현재 시스템 날짜를 자세하게 표시 날짜 형식으로 정의된 시스템에 반환.

MyStr = Format(Date, "Long Date")

MyStr = Format(MyTime, "h:m:s") ' "17:4:23"을 반환합니다.

MyStr = Format(MyTime, "hh:mm:ss AMPM") ' "오후 05:04:23"을 반환합니다.

MyStr = Format(MyDate, "dddd, mmm d yyyy") ' "수요일”을 반환합니다.

' 1993년 1월 27

' 유형이 지원되지 않으면 문자열을 반환합니다.

MyStr = Format(23) ' "23"을 반환합니다.

' 사용자 정의 유형

MyStr = Format(5459.4, "##,##0.00") ' "5,459.40"을 반환합니다.

MyStr = Format(334.9, "###0.00") ' "334.90"을 반환합니다.

MyStr = Format(5, "0.00%") ' "500.00%"을 반환합니다.

MyStr = Format("HELLO", "<") ' "hello"를 반환합니다.

MyStr = Format("This is it", ">") ' "THIS IS IT"을 반환합니다.

Dim dtmD As Date

dtmD=#11/17/99 6:19:20 PM#

dtmD=DateSerial(1999, 11, 17) 'Date형식으로 바꾸어 준다.

dtmD=TimeSerial(18, 19, 20) 'Time "

dtmD=DateValue("11/17/99")

dtmD=TimeValue("18:19:20")

Format(dtmD, "General Date") '11/17/99?6:12:20 PM

Format(dtmD, "Long Date") 'Sunday, November 17, 1999

Format(dtmD, "Medium Date") '17-Nov-99

Format(dtmD, "Short Date") '11/17/99

Format(dtmD, "Long Time") '6:19:20 PM

Format(dtmD, "Medium Time") '06:19 PM

Format(dtmD, "Short Time") '18:19

strA = Format(dtmD, "m/d/yyyy hh:mm AM/PM") '11/17/1999?06/19 PM

strA = Format(dtmD, "mmmm") 'November

세부사항 추출

Month(dtmD) '11

Day(dtmD) '17

Year(dtmD) '1999

Hour(dtmD) '18

Minute(dtmD) '19

Second(dtmD) '20

WeekDay(dtmD) '1

시간 계산

CDate(expression) As Date

dtmD = Now + TimeSerial(0, 1000, 0) '1000분을 더하여 출력

select * from A where B between

convert(smalldatetime,'1999-09-09') and

convert(smalldatetime,'1999-10-10')

오늘 부터 1주일 전에 내용 쿼리

Dim strNowDate as String

Dim str7Date as String

strNowDate = Format(NOW, "yyyy-mm-dd") & "23:59:59"

str7Date = Format(NOW - 7, "yyyy-mm-dd") & " 00:00:00"

MSComm을 이용한 Serial 통신(OMR카드리딩)

�MSComm 컨트롤 상수

▶Handshake 상수: 값 설명

comNone 0 초기 접속 신호 없음

comXonXoff 1 XOn/XOff 초기 접속 신호

comRTS 2 RTS/CTS 초기 접속 신호

comRTSXOnXOff 3 RTS와 Xon/XOff 초기 접속 신호

▶OnComm 상수 :값 설명

comEvSend 1 이벤트 보냄

comEvReceive 2 이벤트 받음

comEvCTS 3 CTS 회선 변경

comEvDSR 4 DSR 회선 변경

comEvCD 5 CD 회선 변경

comEvRing 6 호출음 검출

comEvEOF 7 파일 끝

▶Error 상수 :값 설명

comEventBreak 1001 중지 신호 수신

comEventCTSTO 1002 CTS 시간 초과

comEventDSRTO 1003 DSR 시간 초과

comEventFrame 1004 프레이밍 오류

comEventOverrun 1006 포트 오버런

comEventCDTO 1007 CD 시간 초과

comEventRxOver 1008 수신 버퍼 초과

comEventRxParity 1009 패리티 오류

comEventTxFull 1010 전송 버퍼 꽉 참

comEventDCB 1011 포트에 대한 장치 제어 블록(DCB) 검색 중 예기치 못한 오류

▶InputMode 상수: 값 설명

comInputModeText 0 (기본값)데이터가 Input 속성을 통해서 텍스트로 변환됨.

comInputModeBinary 1 데이터가 Input 속성을 통해서 이진 데이터로 변환됨.

� 모뎀을 사용하는 기본적인 직렬 통신 예제

Private Sub Form_Load ()

' 버퍼에 입력할 문자열을 지정합니다.

Dim Instring As String

' 통신 포트 COM1을 사용합니다.

MSComm1.CommPort = 1

' 9600 전송 속도, 패리티 없음, 8 데이터, 1 중지 비트를

' 지정합니다.

MSComm1.Settings = "9600,N,8,1"

' 입력된 문자를 버퍼 전체에서 읽을 수 있도록 알려줍니다.

MSComm1.InputLen = 0

' 통신 포트를 엽니다.

MSComm1.PortOpen = True

' 모뎀에 준비 명령을 보냅니다.

MSComm1.Output = "ATV1Q0" & Chr$(13) ' 모뎀이

' "확인"의 응답하는 것을 확인합니다.

' 직렬포트에 신호가 돌아올 때까지 기다립니다.

DoEvents

Buffer$ = Buffer$ & MSComm1.Input

Loop Until InStr(Buffer$, "OK" & vbCRLF)

' 직렬포트에서 "확인" 응답 신호를 읽습니다.

' 직렬포트를 닫습니다.

MSComm1.PortOpen = False

End Sub

�OnComm 이벤트 예제

오류나 이벤트를 처리하려면 관련되는 Case 문의 뒤에 코드를 삽입하면 된다

Private Sub MSComm_OnComm ()

Select Case MSComm1.CommEvent

' 각 case 문 아래에 코드를 위치시켜

' 이벤트나 오류를 처리

' 오류

Case comBreak ' 중지 신호 수신

Case comFrame ' 구조적 오류

Case comOverrun ' 데이터 손실

Case comRxOver ' 수신 버퍼 초과

Case comRxParity ' 패리티 오류

Case comTxFull ' 전송 버퍼 꽉 참

Case comDCB ' DCB 검색 중 예기치 못한 오류

' 이벤트

Case comEvCD ' CD 회선 변경

Case comEvCTS ' CTS 회선 변경

Case comEvDSR ' DSR 회선 변경

Case comEvRing ' 호출음 검출

Case comEvReceive ' 이벤트 받음

Case comEvSend ' 이벤트 보냄

Case comEvEof ' 파일 끝

End Select

End Sub

� OMR Card 리딩 예제

『For r = 1 To loose_time: Next』에서 ’타임머로 대치하여 쓰면 컴퓨터에 따라 다운될 수 있다. 컴퓨터의 속도에 맞게 loosetime 값을 적당히 조절하여 쓰여만 한다. 값이 작으면 너무 빨라져 컴퓨터가 먹통이 되고, 크면 너무 느려져 답답하기 때문이다.

Private Sub Form_Load ()

If select_comport = 1 Then

MSComm1.Settings = "9600,N,7,1" 'com1일경우

MSComm1.CommPort = 1

Else

MSComm1.Settings = "9600,N,7,2" 'com2일경우

MSComm1.CommPort = 2

End If

MSComm1.PortOpen = True

MSComm1.InputLen = 0

End Sub

Public Sub reading_SR()

Automatic = -1

Diagnosis = stanby()

If Diagnosis = 0 Then Exit Sub

MSComm1.Output = Chr$(17) + Chr$(13) ‘SR-305의 규정된 통신신호 값

For r = 1 To loose_time: Next

MSComm1.Output = Chr$(5) + Chr$(13) ‘SR-305의 규정된 통신신호 값

For r = 1 To loose_time: Next ’타임머를 쓰면 컴퓨터에 따라 다운될 수 있다

DoEvents

coun = 0

coun = coun + 1

If MSComm1.InBufferCount Then '버퍼에 내용이 차면

RR$ = MSComm1.Input

DoEvents

Select Case Left(RR$, 1) ‘처음 1바이트는 에러 신호

Case "0"

Exit Do

Case Else

Select Case Left(RR$, 1)

Case "1"

err_term = "다시한번리딩"

Label8.Caption = err_term

MsgBox err_term, 16

Case "2"

err_term = "카드가 딸려오지 않음"

Label8.Caption = err_term

MsgBox err_term, 16

Case "3"

err_term = "카드 데이타 에러"

Label8.Caption = err_term

MsgBox err_term, 16

Case "4"

err_term = "카드가 뒤집힘"

Label8.Caption = err_term

MsgBox srrmsg, 16

Case "5"

err_term = "카드가 없음"

Label8.Caption = err_term

MsgBox

err_term, 16

Case Else

Call card_re_doing

End Select

Exit Sub

End Select

End If

If coun = (loose_time * 1000) Then

Call card_re_doing

Exit Sub

End If

Loop

MSComm1.Output = Chr$(16) + "C" + Chr$(13) ‘SR-305의 규정된 통신신호 값

For r = 1 To loose_time: Next

MSComm1.Output = omrmark_ct + Chr$(&HD) ’omrmark_ct 카드란 수

For r = 1 To loose_time: Next

If MSComm1.InBufferCount >= Val(omrmark_ct) * 30 Then

om = MSComm1.Input

Exit Do

End If

Loop

om = Trim(om)

For r = 1 To loose_time: Next

DoEvents

Loop

End Sub

Public Function stanby()

stanby = 1

'통신포트가 준비완료이면 빠져라

If MSComm1.CTSHolding Then Exit Do

MSComm1.RTSEnable = True

'If comm1.CTSHolding And comm1.DSRHolding Then Exit Do

If MSComm1.CTSHolding Then Exit Do

Res = DoEvents()

i = i + 1

If i >= 3000 Then

MsgBox "통신에러", 16

stanby = 0

Automatic = 0

i = 0

Exit Function

End If

Loop

End Function

【참고】OMR 마크 번역하기

om의 실제 데이터를 보면 184DA23F10376F100211.... 식으로 값을 리더기로부터 전달받는다. 이 값은 카드의 세로줄(12줄)을 3등분한 Bit 값이 ASCII 문자열로 변환되어 받기 때문에 다시 가로 표기로 해석하기 위해서 번역을 하여야 만 한다.

	제1란	제2란
Bit	0011 0010 0001	1100 1011 1010
ASCII	3 2 1	C B A

Public Sub read_convert_data(om)

Dim KAK_CT As Integer

For i = 1 To 60

a$(i) = Mid$(om, i * 3 - 2, 3)

Next i

For i = 1 To 60

headercode(i) = Val("&h" + a$(i))

headercode(i) = headercode(i) And &HFFC

For i = 1 To 60

DAP_str(i) = ""

For headbar = 1 To (omrmark_dab - 1)

header_str(headbar) = ""

If headercode(headbar) = 0 Then header_str(headbar) = header_str(headbar) + "N"

If (headercode(headbar) And 1) = 1 Then header_str(headbar) = header_str(headbar) + "X"

If (headercode(headbar) And 2) = 2 Then header_str(headbar) = header_str(headbar) + "Y"

If (headercode(headbar) And 4) = 4 Then header_str(headbar) = header_str(headbar) + "0"

If (headercode(headbar) And 8) = 8 Then header_str(headbar) = header_str(headbar) + "1"

If (headercode(headbar) And 16) = 16 Then header_str(headbar) = header_str(headbar) + "2"

If (headercode(headbar) And 32) = 32 Then header_str(headbar) = header_str(headbar) + "3"

If (headercode(headbar) And 64) = 64 Then header_str(headbar) = header_str(headbar) + "4"

If (headercode(headbar) And &H80) = 128 Then header_str(headbar) = header_str(headbar) + "5"

If (headercode(headbar) And &H100) = &H100 Then header_str(headbar) = header_str(headbar) + "6"

If (headercode(headbar) And &H200) = &H200 Then header_str(headbar) = header_str(headbar) + "7"

If (headercode(headbar) And &H400) = &H400 Then header_str(headbar) = header_str(headbar) + "8"

If (headercode(headbar) And &H800) = &H800 Then header_str(headbar) = header_str(headbar) + "9"

If Len(RTrim$(header_str(headbar))) >= 2 Then header_str(headbar) = "W"

'주관식위치 한 줄 전체를 그대로 사용한다

For headbar = omrmark_joo1 To omrmark_joo2