VB – Form Follows Energy

2010/05/132021/11/11

[VBA]TwipsPerPixel

비주얼 베이직 6.0이하에서는 화면의 크기를 트윕(twip)으로 표시한다.

Screen.TwipsPerPixelX
Screen.TwipsPerPixelY

1 2	Screen.TwipsPerPixelX Screen.TwipsPerPixelY

VBA에서는 없기에 다음과 같은 함수를 이용해야 한다. (source : MSDN)

Option Explicit
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function TwipsPerPixelX() As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long

lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelX = 1440&amp; / GetDeviceCaps(lngDC, LOGPIXELSX)
ReleaseDC HWND_DESKTOP, lngDC

End Function

'--------------------------------------------------
Function TwipsPerPixelY() As Single
'--------------------------------------------------
'Returns the height of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long

lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelY = 1440&amp; / GetDeviceCaps(lngDC, LOGPIXELSY)
ReleaseDC HWND_DESKTOP, lngDC

End Function

Option Explicit

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _

ByVal hdc As Long) As Long

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _

ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0

Const LOGPIXELSX As Long = 88

Const LOGPIXELSY As Long = 90

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

Function TwipsPerPixelX() As Single

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

'Returns the width of a pixel, in twips.

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

Dim lngDC As Long

lngDC = GetDC(HWND_DESKTOP)

TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)

ReleaseDC HWND_DESKTOP, lngDC

End Function

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

Function TwipsPerPixelY() As Single

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

'Returns the height of a pixel, in twips.

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

Dim lngDC As Long

lngDC = GetDC(HWND_DESKTOP)

TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)

ReleaseDC HWND_DESKTOP, lngDC

End Function

2010/05/102019/07/09

공기상태 계산 엑셀 프로그램(Visual Air 2010)

건축환경 및 설비 분야에서 공기의 상태값(psychrometrics)을 아는 것이 매우 중요하다.

(Excepted from Wikipedia) Although the principles of psychrometry apply to any physical system consisting of gas-vapor mixtures, the most common system of interest is the mixture of water vapor and air, because of its application in heating, ventilating, and air-conditioning and meteorology. In human terms, our thermal comfort is in large part a consequence of not just the temperature of the surrounding air, but (because we cool ourselves via perspiration) the extent to which that air is saturated with water vapor.
공기 상태를 계산하는 엑셀 프로그램을 여기에 올린다.

사용전 엑셀 보안 설정
– 도구 -> 매크로 -> 보안 -> “보안 수준” 탭에서 “보통”을 선택 (Excel 2003이하)

사용법
1) 시트 안에 있는 “계산기” 단추를 누른다.
사용자 삽입 이미지 2) 알고 있는 두 값을 선택해서 그 값을 입력한 다음 “계산” 단추를 누른다.
예) 건구온도 20도, 상대습도 55%를 입력해서 나머지 값을 구하고자 할 경우 다음과 같이 입력한다.

3) 계산결과는 엑셀 시트와 대화상자 동시에 출력이 된다.
사용자 삽입 이미지 4) 첨부 엑셀 파일(You can download the following file)

psychrometrics.xls

2010/04/202014/11/05

[프로그램등록] Visual Air (software for psychrometic chart)

공기의 물리적인 상태값은 공기와 관련한 수치계산의 기본이 된다. 공조 설비에서 취급하는 공기는 습공기이기 때문에, 공기조화에 관한 계산은 습공기의 성질을 충분히 파악한 상태에서 가능하다. 이런 습공기의 상태값에는 밀도, 수증기압, 절대습도, 상대습도, 노점온도, 습구온도 등과 함께 습공기가 안고 있는 열량인 엔탈피가 있다.
습공기의 상태값은 표로 제시되기도 하지만, 모든 경우에 대한 자료를 주지 못한다. 이에 가장 기본적인 자료로서 습공기선도를 사용하게 되는데, 습공기의 상태값을 구하는데 사용됨과 동시에 공기조화 프로세스를 설계, 해석하는데도 사용된다.
따라서, 습공기에 대한 이론적인 것을 살펴보고, 상태값을 계산하는 함수와 함께 습공기선도를 그리는 함수를 작성하는 프로그램을 만들었다.
프로그램 제작은 사용자 인터페이스가 좋은 윈도우 환경에서 쓸 수 있게 Visual Basic 6.0 Professional Version으로 하였다.

이 프로그램에 대한 등록증은 아래와 같다.
사용자 삽입 이미지

2010/04/182021/11/11

[VB]코드 생성기

프로그래밍을 하다보면 기계적으로 반복해야 할 일들이 생긴다. 이런 일들로 일일이 타이핑을 한다는 것은 매우 지루하고 따분한 일이다. 그래서 코드을 자동으로 생성하도록 할 필요가 생긴다.
곧 개발환경의 매크로를 이용하거나, Perl과 같은 문자열 처리기를 통하여 코드를 자동처리하도록 한다.
다음의 사이트도 그 중의 하나이다.

http://kimsk99.springnote.com/pages/63531
– 미리 지정된 텍스트를 현재 커서위치(실렉트된 것)에 삽입하는 매크로
– 현재 편집중인 파일과 같은 이름이고 확장자만 cpp <-> h 로 바뀐 파일을 열어주는 매크로

http://www.devpia.com/Maeul/Contents/Detail.aspx?BoardID=51&MAEULNo=20&no=8423&ref=8423
– 이름과 날짜를 입력
– 수평 라인 주석을 입력

Sub InsertHorizontalLine()
  Dim lineString = "//----------------------------------------------------------------------------" + vbCrLf
  Dim sel As TextSelection = DTE.ActiveDocument().Selection()
  sel.Text() = lineString
End Sub

Sub InsertHorizontalLine()

Dim lineString = "//----------------------------------------------------------------------------" + vbCrLf

Dim sel As TextSelection = DTE.ActiveDocument().Selection()

sel.Text() = lineString

End Sub

http://serious-code.net/tc/tag/Visual%20Studio%20Macro
– 선택된 라인들에서 중복된 라인들은 삭제하고 나머지를 정렬하기
– 자동으로 getter/setter생성하기

    ' Inserts name and date
Sub Signature()
  Dim sel As TextSelection = DTE.ActiveDocument.Selection
  sel.Insert("// Seungwoo Oh ")
  sel.Insert(Format(Date.Today, "yyyy-MM-dd"))
  sel.Insert(".")
End Sub

' Inserts name and date

Sub Signature()

Dim sel As TextSelection = DTE.ActiveDocument.Selection

sel.Insert("// Seungwoo Oh ")

sel.Insert(Format(Date.Today, "yyyy-MM-dd"))

sel.Insert(".")

End Sub

Function Strip(ByVal strLine As String)
If Len(strLine) > 0 Then
nBegin = 1
nEnd = Len(strLine)
For i = 1 To Len(strLine)
c = Mid(strLine, i, 1)
If c &lt;> " " And c &lt;> Tab And c &lt;> Lf And c &lt;> Cr Then
nBegin = i
Exit For
End If
Next
For i = 1 To Len(strLine)
c = Mid(strLine, Len(strLine) - i + 1, 1)
If c &lt;> " " And c &lt;> Tab And c &lt;> Lf And c &lt;> Cr Then
nEnd = Len(strLine) - i + 1
Exit For
End If
Next
Return Mid(strLine, nBegin, nEnd - nBegin + 1)
Else
Return ""
End If
End Function

Function Strip(ByVal strLine As String)

If Len(strLine) > 0 Then

nBegin = 1

nEnd = Len(strLine)

For i = 1 To Len(strLine)

c = Mid(strLine, i, 1)

If c <> " " And c <> Tab And c <> Lf And c <> Cr Then

nBegin = i

Exit For

End If

For i = 1 To Len(strLine)

c = Mid(strLine, Len(strLine) - i + 1, 1)

If c <> " " And c <> Tab And c <> Lf And c <> Cr Then

nEnd = Len(strLine) - i + 1

Exit For

End If

Return Mid(strLine, nBegin, nEnd - nBegin + 1)

Else

Return ""

End If

End Function

Sub SortCollection(ByRef oCollection As Collection, Optional ByVal bSortAscending As Boolean = True)
    Dim lSort1 As Integer
    Dim lSort2 As Integer
    Dim vTempItem1 As Object Dim vTempItem2 As Object Dim bSwap As Boolean

    For lSort1 = 1 To oCollection.Count - 1
        For lSort2 = lSort1 + 1 To oCollection.Count
            If bSortAscending Then
                If oCollection(lSort1) > oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            Else
                 If oCollection(lSort1) &lt; oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            End If
            If bSwap Then
                vTempItem1 = oCollection(lSort1)
                vTempItem2 = oCollection(lSort2)
                oCollection.Add(vTempItem1, Nothing, lSort2)
                oCollection.Add(vTempItem2, Nothing, lSort1)
                oCollection.Remove(lSort1 + 1)
                oCollection.Remove(lSort2 + 1)
            End If
        Next
    Next
End Sub

Sub SortCollection(ByRef oCollection As Collection, Optional ByVal bSortAscending As Boolean = True)

Dim lSort1 As Integer

Dim lSort2 As Integer

Dim vTempItem1 As Object Dim vTempItem2 As Object Dim bSwap As Boolean

For lSort1 = 1 To oCollection.Count - 1

For lSort2 = lSort1 + 1 To oCollection.Count

If bSortAscending Then

If oCollection(lSort1) > oCollection(lSort2) Then

bSwap = True

Else

bSwap = False

End If

Else

 If oCollection(lSort1) < oCollection(lSort2) Then

bSwap = True

Else

bSwap = False

End If

If bSwap Then

vTempItem1 = oCollection(lSort1)

vTempItem2 = oCollection(lSort2)

oCollection.Add(vTempItem1, Nothing, lSort2)

oCollection.Add(vTempItem2, Nothing, lSort1)

oCollection.Remove(lSort1 + 1)

oCollection.Remove(lSort2 + 1)

End If

End Sub

Sub SortAndRemoveDuplicatedLine()
  Dim objLines As New Collection Dim objSel As TextSelection = ActiveDocument().Selection
  Dim objRanges As TextRanges = objSel.TextRanges Dim objStartPt As EditPoint = objRanges.Item(1).StartPoint.CreateEditPoint()
  Dim objStream As New StringBuilder

  For Each strLine In objSel.Text.Split(Lf)
    strLine = Strip(strLine)
    If objLines.Contains(strLine) = False Then
      objLines.Add(strLine, strLine)
    End If
  Next
  SortCollection(objLines)
  For Each strLine In objLines
    objStream.AppendLine(strLine)
  Next
  objSel.Text = ""
  objStartPt.Insert(objStream.ToString())
End Sub

Sub SortAndRemoveDuplicatedLine()

Dim objLines As New Collection Dim objSel As TextSelection = ActiveDocument().Selection

Dim objRanges As TextRanges = objSel.TextRanges Dim objStartPt As EditPoint = objRanges.Item(1).StartPoint.CreateEditPoint()

Dim objStream As New StringBuilder

For Each strLine In objSel.Text.Split(Lf)

strLine = Strip(strLine)

If objLines.Contains(strLine) = False Then

objLines.Add(strLine, strLine)

End If

SortCollection(objLines)

For Each strLine In objLines

objStream.AppendLine(strLine)

objSel.Text = ""

objStartPt.Insert(objStream.ToString())

End Sub

Using Visual Studio .NET Macros

속성을 위한 매크로

2009/05/292015/12/12

삼각함수 비교

	설명	Excel	VBA	VB6	VB.NET	비고
sin	사인함수	Sin	Sin	Sin	Sin
cos	코사인함수	Cos	Cos	Cos	Cos
tan	탄젠트함수	Tan	Tan	Tan	Tan
arcsin	사인역함수	Asin	–	–	Asin
arccos	코사인역함수	Acos	–	–	Acos
arctan	탄젠트역함수	AtanAtan2	Atn	Atn	AtanAtan2
sinh	하이퍼볼릭사인함수	Sinh	–	–	Sinh
cosh	하이퍼볼릭코사인함수	Cosh	–	–	Cosh
tanh	하이퍼볼릭탄젠트함수	Tanh	–	–	Tanh
arcsinh	하이퍼볼릭사인역함수	Asinh	–	–	–
arccosh	하이퍼볼릭코사인역함수	Acosh	–	–	–
arctanh	하이퍼볼릭탄젠트역함수	Atanh	–	–	–

이상에서 보듯 VB6와 VBA로 프로그래밍을 하고자 하면, 삼각함수의 역함수를 작성해야 한다.
만약 VBA에서 새로 역함수를 작성하지 않고, 엑셀함수를 사용하고자 한다면 다음과 같이 하면 된다.

area = WorksheetFunction.Pi * radius ^ 2
a = WorksheetFunction.Acos(b)

1 2	area = WorksheetFunction.Pi * radius ^ 2 a = WorksheetFunction.Acos(b)

2008/08/282015/12/12

파일경로와 파일이름

1. 프로그램이 시작된 경로를 알아내기
– App.Path 함수를 사용한다.

2. App.Path 사용시 주의할 점
– 루트 디렉토리일 경우 “\”를 함께 반환한다.
– 루트 디렉토리가 아닐 경우, 끝에 “\”가 없다.

3. 더 좋은 App.Path (출처 : http://www.freevbcode.com/ShowCode.asp?ID=878)
항상 끝에 “\”가 붙게 한다.

Public Function AppPath() As String
  Dim NewPath As String
  NewPath = App.Path
  If Right(App.Path, 1) &lt;&gt; "\" Then NewPath = NewPath &amp; "\"
  AppPath = NewPath
End Function

Public Function AppPath() As String

Dim NewPath As String

NewPath = App.Path

If Right(App.Path, 1) <> "\" Then NewPath = NewPath & "\"

AppPath = NewPath

End Function

사용예

'Open "C:\IA Program\입력값\FormData_5장.txt" For Input As #1
Open AppPath &amp; "입력값\FormData_5장.txt" For Input As #1

1 2	'Open "C:\IA Program\입력값\FormData_5장.txt" For Input As #1 Open AppPath & "입력값\FormData_5장.txt" For Input As #1

4. 프로그램 시작 경로에서 파일명 가져오기

Function GetFileName(sFileName As String) As String
Dim FullFilename As String
'
'파일이름
If Right$(Trim$(App.Path), 1) = "\" Then
FullFilename = App.Path + sFileName
Else
FullFilename = App.Path + "\" + sFileName
End If
'
GetFileName = FullFilename
'
End Function

Function GetFileName(sFileName As String) As String

Dim FullFilename As String

'파일이름

If Right$(Trim$(App.Path), 1) = "\" Then

FullFilename = App.Path + sFileName

Else

FullFilename = App.Path + "\" + sFileName

End If

GetFileName = FullFilename

End Function

사용예 : FormData_5장.txt를 프로그램시작경로에서 찾는다.

myFile = GetFileName("FormData_5장.txt")

1	myFile = GetFileName("FormData_5장.txt")

5. 전체파일명에서 경로만 뽑아내기

Function GetPath(strFullFilename As String) As String
  '
  Dim strPath As String
  strPath = Mid(strFullFilename, 1, InStrRev(strFullFilename, "\", , vbTextCompare) - 1)
  If Len(strPath) = 0 Then
    strPath = App.Path
  End If
  GetPath = strPath
  '
End Function

Function GetPath(strFullFilename As String) As String

Dim strPath As String

strPath = Mid(strFullFilename, 1, InStrRev(strFullFilename, "\", , vbTextCompare) - 1)

If Len(strPath) = 0 Then

strPath = App.Path

End If

GetPath = strPath

End Function

호환성 : Visual Basic 5, 6

2007/01/042015/11/12

비주얼베이직(VB)에서 마우스 스크롤이 되는 방법

비주얼 베이직 6.0에서 작업을 하다보면 뜻밖에도 이런 것이 안 되다니 하고 느끼는 것이 있다. 바로 마우스의 휠이 먹히지 않는다는 것이다. 마우스로 화면을 스크롤할 수 없다는 것은 정말이지 뜻밖의 복병이다. 윈도우에서 아무런 문제 없이 사용하던 것이 비주얼베이직에만 오면 딱 그 기능이 멎어버린다. (놀라운 MS사의 센스가 아닐 수 없다!)

이 문제를 해결하려고 하면 아래의 파일을 내려받아서 설치하면 간단하게 해결된다.(왜 이것은 VB6에 기본적으로 포함하지 않는 것도 이상하다. 더군다나 패치에서도 해결할 노력이 없다. SP6까지 오면서 개선된 것이 없다. 다행히도 VB.NET에서는 된다.)

1. 아래의 파일을 내려받는다.
(http://download.microsoft.com/download/e/f/b/efb39198-7c59-4ace-a5c4-8f0f88e00d34/vb6mousewheel.exe)

2. 내려 받은 실행 파일을 클릭하여 실행시킨다.
3. 압축을 풀 폴더를 임의로 선택한다. (단, 위치는 기억한다. 그리고 설치 폴더를 지우면 안 된다.)
4. 다음과 같이 명령어를 입력하여 등록한다.
regsvr32 <압축을 푼 폴더>\VB6IDEMouseWheelAddin.dll
등록되었다는 메시지가 나오면 OK버튼을 클릭한다.
5. Visual Basic 6.0를 실행한다.
6. 메뉴에서 ‘추가기능(Add-Ins)’->추가기능관리자(Add-in Manager)를 선택한다.
7. ‘사용가능한 추가기능’목록 중에서 ‘MouseWheel Fix’를 선택한다.
8. ‘로드 동작’에서 ‘로드/언로드’항목과 ‘시작할 때 로드’항목을 체크(선택)한다.
9. ‘확인’ 버튼을 눌러서 종료한다.

2007/01/032015/12/12

동적 메모리 할당 ReDim에 관하여

처리해야 할 정보의 양에 맞게 변수를 선언하는 것이 프로그래밍의 기본이다.
그러나, 프로그램을 작성하다보면 처리해야 할 정보의 양이 고정되어 있지 않고 상황에 따라 변하는 경우를 자주 만나게 된다. 그렇다면 정보량이 변하는 경우는 어떻게 변수를 선언하고 관리할 것인가?
비주얼베이직에서는 정보량 변화를 수용하기 위하여 변수 크기에 대하여 동적으로 할당할 수 있는 장치를 마련하였다. 그것이 바로 ReDim이다.

그 사용법을 보면 다음과 같다.
1) 최초 변수를 선언할 때, 그 크기를 비워둔다.

Dim Data() As Single

1	Dim Data() As Single

보통 배열을 선언할 때, 그 크기를 “1 To 10″과 같이 그 크기를 명시하지만, 여기서는 크기를 비워두는 것이 핵심이다.

2) 상황에 따라 배열의 크기를 설정한다.

ReDim Data(10) As Single
.....
ReDim Preserve Data(100) As Single
ReDim Preserve Data(NumberOfData) As Single

ReDim Data(10) As Single

.....

ReDim Preserve Data(100) As Single

ReDim Preserve Data(NumberOfData) As Single

상황에 따라 10개가 필요하면 10을 100개가 필요하면 100을, 아니면 특정 변수만큼 필요하면 해당 변수(여기서는 NumberOfData)를 넣어서 그 크기만큼 변수를 만들 수 있다.

이 방법을 사용하는 데 있어서 유의할 것도 있다.
1) 프로그램의 속도가 느려진다.
특히 ReDim을 루프와 같이 반복 계산되는 곳에 두면 프로그램의 속도는 눈에 띄게 느리게 될 것이다. 따라서, 변수의 양이 루프 밖에서도 알 수 있다면 꼭 밖에 두는 것이 현명한 처사이다.

2) 다차원배열의 동적할당
다차원 배열의 동적할당에 있어서는 맨마지막 차원에 대해서만 적용된 것을 명심하자.

Dim MultiData() As Single
....
ReDim MultiData(NumberOfData,3,4) As Single
ReDim MultiData(NumberOfData+1,3,4) As Single '=> 오류발생

ReDim MultiData(3,4,NumberOfData) As Single

ReDim MultiData(3,4,NumberOfData+1) As Single '=> 정상작동

Dim MultiData() As Single

....

ReDim MultiData(NumberOfData,3,4) As Single

ReDim MultiData(NumberOfData+1,3,4) As Single '=> 오류발생

ReDim MultiData(3,4,NumberOfData) As Single

ReDim MultiData(3,4,NumberOfData+1) As Single '=> 정상작동