CreateFontIndirect와 마찬가지로 이번에는 CreateFont를 사용하여 문자열의 표시시 각도 주어 표시하는 예이다.

다음 결과 이미지이다.



다음은 소스이다

' 논리적 폰트 생성 문자열을 회전하면서 출력한다
Option Explicit

Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const PROOF_QUALITY = 2
Const DEFAULT_PITCH = 0
Const LOGPIXELSY = 90

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Sub Form_Load()
    Dim Angle As Long ' 각도

    With Picture1
        .AutoRedraw = True
        For Angle = 0 To 350 Step 30
            DeleteObject SelectObject(.hdc, CreateMyFont(24, Angle))
            .CurrentX = .ScaleWidth / 2
            .CurrentY = .ScaleHeight / 2
            Picture1.Print "테스트"
        Next Angle
    End With
End Sub

' nSize는 포인트 단위이다.
Private Function CreateMyFont(ByVal nSize As Integer, ByVal nDegrees As Long) As Long ' 논리 폰트를 생성한다.
    CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(Me.Hdc, LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function

 예에서서는 논리 폰트를 생성하고, DC에 폰트를 할당하여, 해당 개체의 Print 메소드를 사용해서 결과를 얻었다.

윈도우의 모든 창을 최소화 하는 방법 3가지를 설명할건 한다.
윈도우의 모든 창을 최소화 하기 위해서는 다음과 같은 방법이 있다.
1. 윈도우 창 최소화 하는 바로가기를 실행한다.
2. keybd_event API를 사용해서 윈도우+D키나 윈도+M키를 보낸다
3. Microsoft Shell Controls And Automation 참조한후 Shell 개체를 생성 MinimizeAll 메소드를 호출한다.

다음은 초기 화면이다.


각 버튼을 클릭하면 윈도우에 있는 모든 창이 최소화 된다.

다음은 소스이다 간단하다.
' Microsoft Shell Controls And Automation 참조시킨다
' 윈도우의 모든 창 최소화
Option Explicit

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const MAPVK_VK_TO_VSC = 0
Private Const VK_LWIN = &H5B
Private Const vk_d = &H44
Private Const vk_m = &H4D

Private Sub Command1_Click() ' Shell.MinimizeAll
    Dim sh As Shell32.Shell
    Set sh = New Shell32.Shell
   
    sh.MinimizeAll
    Set sh = Nothing
End Sub

Private Sub Command2_Click() ' 윈도우+ D
    Dim keyscan As Long

    keyscan = MapVirtualKey(VK_LWIN, MAPVK_VK_TO_VSC)
    Call keybd_event(VK_LWIN, keyscan, 0, 0)
    keyscan = MapVirtualKey(vk_d, MAPVK_VK_TO_VSC)
    Call keybd_event(vk_d, keyscan, 0, 0)

    keyscan = MapVirtualKey(vk_d, MAPVK_VK_TO_VSC)
    Call keybd_event(vk_d, keyscan, KEYEVENTF_KEYUP, 0)
    keyscan = MapVirtualKey(VK_LWIN, MAPVK_VK_TO_VSC)
    Call keybd_event(VK_LWIN, keyscan, KEYEVENTF_KEYUP, 0)
End Sub

Private Sub Command3_Click() ' 윈도우+M
    Dim keyscan As Long
   
    keyscan = MapVirtualKey(VK_LWIN, MAPVK_VK_TO_VSC)
    Call keybd_event(VK_LWIN, keyscan, 0, 0)
    keyscan = MapVirtualKey(vk_m, MAPVK_VK_TO_VSC)
    Call keybd_event(vk_m, keyscan, 0, 0)

    keyscan = MapVirtualKey(vk_m, MAPVK_VK_TO_VSC)
    Call keybd_event(vk_m, keyscan, KEYEVENTF_KEYUP, 0)
    keyscan = MapVirtualKey(VK_LWIN, MAPVK_VK_TO_VSC)
    Call keybd_event(VK_LWIN, keyscan, KEYEVENTF_KEYUP, 0)
End Sub

추가로
모든 윈도우를 최소화 하는 바로가기 아이콘을 삭제했다면 다음과 같은 방법을 다시 만들수 있다.
텍스트 파일을 하나 만든다.
텍스트 파일에 아래의 내용을 복사한다.
[Shell]
Command=2
IconFile=explorer.exe,3
[Taskbar]
Command=ToggleDesktop
복사를 했다면 저장을 하고, 파일명의 확장자를 txt에서 scf로 고친다.
아이콘을 더블 클릭하면 윈도우의 모든 창이 최소화 된다.

CreateFontIndirect는 CreateFont는 논리적 폰트를 생성하는 것은 같다.
그러나 CreateFontIndirect는 CreateFont와 달리는 논리적 폰트에 대한 생성 정보를 함수의 인수로 각각 지정하지 않고, LOGFONT라는 구조체를 사용해서 폰트의 정보를 지정하는것이 다르다.

아래는 CreateFontIndirect를 사용해서 폰트를 회전시겨 세로로 표시되게 하는 논리적 폰트 생성한 이미지이다.


상단의 가로로 출력된 문자열은 원래의 폰트에 대한 출력이고, 아래의 세로로 표시된 문자열은 CreateFontIndirect를 사용해 생성한 논리적 폰트로 출력을 표시한 것이다.

다음은 소스이다.
' 논리적 폰트 생성 문자열을 회전해서 세로로 출력
Option Explicit

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Form_Load()
    Dim RotateMe As LOGFONT ' 논리적 폰트 생성 정보
    Dim FontHandle As Long ' 생성한 폰트 핸들
    Dim PreviousFontHandle As Long ' 이전 폰트 핸들
   
    With Picture1
        .AutoRedraw = True
        Picture1.Print "테스트" ' 원 폰트 출력 모양
        RotateMe.lfEscapement = 270 * 10 ' 세로로 출력하는 논리적 폰트
        RotateMe.lfHeight = (20 * -20) / Screen.TwipsPerPixelY
        FontHandle = CreateFontIndirect(RotateMe)
        PreviousFontHandle = SelectObject(.hdc, FontHandle)
        .CurrentX = 500
        .CurrentY = 300
        Picture1.Print "테스트"
        PreviousFontHandle = SelectObject(.hdc, PreviousFontHandle)
        Call DeleteObject(FontHandle)
    End With
End Sub


LOGFONT 구조체의 각 멤버는 다음과 같다.

  • lfHeight ━ 폰트의 높이를 논리적인 단위로 지정, 0일 경우 디폴트 크기
  • lfWidth ━ 폰트의 폭(넓이)을 지정, 0이면 폰트 높이에 따라 폭을 자동 결정
  • lfEscapement ━ 폰트의 각도를 0.1도(1이 0.1도) 단위로 결정, 이 각도는 문자가 출력될 X축과 문자열과의 각도이며 일상적인 360분법의 각도체계를 사용한다.
  • lfOrientation ━ 글자 한자와 X축과의 각도 지정. lfEscapement는 전체 문자열의 각도이고, lfOrientation는 문자열의 구성하는 개별 문자의 각도이다.
  • lfWeight ━ 폰트의 두께. 0~1000 범위, 보통 굵기는 4.
  • lfItalic ━ 이탤릭 여부. 1이면 적용, 0이면 적용 않함
  • lfUnderline ━ 밑줄 여부. 1이면 적용, 0이면 적용 않함
  • lfStrikeOut ━ 취소선 여부. 1이면 적용, 0이면 적용 않함
  • lfCharSet ━ 문자 집합
  • lfOutPrecision ━ 출력의 정밀도
  • lfClipPrecision ━ 클립핑 정밀도
  • lfQuality ━ 출력 품질. 논리적 폰트를 물리적 폰트에 얼마나 근적시킬 것인지를 지정
  • lfPitchAndFamily ━ 글꼴의 피치와 그룹 설정
  • lfFacename ━ 글꼴의 이름
  • 파일의 등록정보에 버전 텝이 있는 파일에 대한 버전 정보를 얻는 방법이다.
    GetFileVersionInfo을 사용해서 파일의 경로를 얻으면 파일 버전 정보 블럭을 얻고
    VerQueryValue를 다시 호출해서 파일 버전 정보 블럭에서 원하는 정보 블럭을 지정할 수 있다.

    예의 초기 이미지 화면이다


    다음 이미지는 GetFileVersionInfo을 사용한 파일 정보를 얻은 화면이다.


    이 정보 외에 다른 블럭의 정보를 다른 정보를 볼수 있다.

    다음은 소스이다.
    ' 작성일   : 2011.09.21
    ' 작성자   : 이정재
    ' 저작권   : 이정재
    ' 이메일   : blackm128@hanmail.net
    ' 소스번호 : 00096

    ' 파일 버전 정보를 얻는다
    Option Explicit

    Private Type VersionInformationType ' 파일 버전 정보
        StructureVersion As String ' 구조 버전
        FileVersion As String ' 파일 버전
        ProductVersion As String ' 개발 버전
        FileFlags As String ' 파일 플래그
        TargetOperatingSystem As String ' OS 정보
        FileType As String ' 파일 타입
        FileSubtype As String ' 파일 서브 타입
    End Type

    Private Type VS_FIXEDFILEINFO
        dwSignature As Long
        dwStrucVersion As Long
        dwFileVersionMS As Long
        dwFileVersionLS As Long
        dwProductVersionMS As Long
        dwProductVersionLS As Long
        dwFileFlagsMask As Long
        dwFileFlags As Long
        dwFileOS As Long
        dwFileType As Long
        dwFileSubtype As Long
        dwFileDateMS As Long
        dwFileDateLS As Long
    End Type

    Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
    Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
    Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)

    Private Const VersionSeperator As String = "."

    Private Const VS_FF_DEBUG = &H1
    Private Const VS_FF_INFOINFERRED = &H10
    Private Const VS_FF_PATCHED = &H4
    Private Const VS_FF_PRERELEASE = &H2
    Private Const VS_FF_PRIVATEBUILD = &H8
    Private Const VS_FF_SPECIALBUILD = &H20

    Private Const VOS_DOS = &H10000
    Private Const VOS_NT = &H40000
    Private Const VOS__WINDOWS16 = &H1
    Private Const VOS__WINDOWS32 = &H4
    Private Const VOS_OS216 = &H20000
    Private Const VOS_OS232 = &H30000
    Private Const VOS__PM16 = &H2
    Private Const VOS__PM32 = &H3

    Private Const VFT_APP = &H1
    Private Const VFT_DLL = &H2
    Private Const VFT_DRV = &H3
    Private Const VFT_FONT = &H4
    Private Const VFT_STATIC_LIB = &H7
    Private Const VFT_UNKNOWN = &H0
    Private Const VFT_VXD = &H5

    Private Const VFT2_DRV_COMM = &HA
    Private Const VFT2_DRV_DISPLAY = &H4
    Private Const VFT2_DRV_INSTALLABLE = &H8
    Private Const VFT2_DRV_KEYBOARD = &H2
    Private Const VFT2_DRV_LANGUAGE = &H3
    Private Const VFT2_DRV_MOUSE = &H5
    Private Const VFT2_DRV_NETWORK = &H6
    Private Const VFT2_DRV_PRINTER = &H1
    Private Const VFT2_DRV_SOUND = &H9
    Private Const VFT2_DRV_SYSTEM = &H7
    Private Const VFT2_DRV_VERSIONED_PRINTER = &HC
    Private Const VFT2_UNKNOWN = &H0

    Private Const VFT2_FONT_RASTER = &H1
    Private Const VFT2_FONT_TRUETYPE = &H3
    Private Const VFT2_FONT_VECTOR = &H2

    Private Sub Form_Activate()
        txtFileName.SetFocus
    End Sub

    Private Sub Label2_Click()

    End Sub

    Private Sub txtFileName_KeyDown(KeyCode As Integer, Shift As Integer)
        Dim Result As VersionInformationType ' 파일 버전 정보
       
        If Not KeyCode = vbKeyReturn Then Exit Sub
        If Len(Trim(txtFileName.Text)) = 0 Then Exit Sub
        If VersionInformation(txtFileName.Text, Result) Then   ' 파일 버전 정보를 얻는다.
            With Result ' 버전 정보 문자열을 생성한다.
                labResults.Caption = "File:                " & txtFileName.Text & vbCrLf
                labResults.Caption = labResults.Caption & "File Version:        " & .FileVersion & vbCrLf
                labResults.Caption = labResults.Caption & "Product Version:     " & .ProductVersion & vbCrLf
                labResults.Caption = labResults.Caption & "Structure Version:   " & .StructureVersion & vbCrLf
                labResults.Caption = labResults.Caption & "File Type:           " & .FileType & vbCrLf
                labResults.Caption = labResults.Caption & "File Subtype:        " & .FileSubtype & vbCrLf
                labResults.Caption = labResults.Caption & "File Flags:          " & .FileFlags & vbCrLf
                labResults.Caption = labResults.Caption & "Target OS:           " & .TargetOperatingSystem & vbCrLf
            End With
        Else ' 파일 버전 정보를 얻지 못했다면
            MsgBox " 파일 정보를 얻지 못했읍니다."
        End If
    End Sub

    Private Sub Form_Load()
        txtFileName.Text = Environ("ComSpec")
    End Sub

    Private Function VersionInformation(ByVal FileName As String, ByRef Result As VersionInformationType) As Boolean ' 파일 정보를 얻는다.
        Dim Buffer() As Byte ' 파일 정보 저장할 버퍼
        Dim InfoSize As Long ' 파일 정보 크기
        Dim InfoBlockAddress As Long ' 파일 정보의 블럭 주소
        Dim InfoBlock As VS_FIXEDFILEINFO ' 파일 정보 블럭
        Dim InfoBlockSize As Long ' 파일 정보의 블럭 크기
        Dim TempWord(1) As Integer ' 더블 워드를 워드로

        VersionInformation = False ' 초기화
        InfoSize = GetFileVersionInfoSize(FileName, 0&) ' 파일 정보 크기를 얻는다.
        If InfoSize = 0 Then Exit Function ' 파일 정보 크기를 얻지 못했다면

        ReDim Buffer(1 To InfoSize) ' 버퍼 할당
        If GetFileVersionInfo(FileName, 0&, InfoSize, Buffer(1)) = 0 Then Exit Function  ' 파일 정보를 얻지 못햇다면
        If VerQueryValue(Buffer(1), "\", InfoBlockAddress, InfoBlockSize) = 0 Then Exit Function ' 파일 정보 블럭을 얻지 못했다면

        MoveMemory InfoBlock, InfoBlockAddress, InfoBlockSize ' 얻은 파일 정보 블럭 복사

        With InfoBlock
            MoveMemory TempWord(0), VarPtr(.dwStrucVersion), LenB(.dwStrucVersion) ' 구조 버전 정보
            Result.StructureVersion = TempWord(1) & VersionSeperator & TempWord(0)
            MoveMemory TempWord(0), VarPtr(.dwFileVersionMS), LenB(.dwFileVersionMS) ' 파일 버전 정보
            Result.FileVersion = TempWord(1) & VersionSeperator & TempWord(0)
            MoveMemory TempWord(0), VarPtr(.dwFileVersionLS), LenB(.dwFileVersionLS)
            Result.FileVersion = Result.FileVersion & VersionSeperator & TempWord(1) & VersionSeperator & TempWord(0)
           
            MoveMemory TempWord(0), VarPtr(.dwProductVersionMS), LenB(.dwProductVersionMS) ' 파일 버전 정보
            Result.ProductVersion = TempWord(1) & VersionSeperator & TempWord(0)
            MoveMemory TempWord(0), VarPtr(.dwProductVersionLS), LenB(.dwProductVersionLS)
            Result.ProductVersion = Result.ProductVersion & VersionSeperator & TempWord(1) & VersionSeperator & TempWord(0)

            If (.dwFileFlags And VS_FF_DEBUG) = VS_FF_DEBUG Then Result.FileFlags = Result.FileFlags & " Debug " ' 파일 플래그
            If (.dwFileFlags And VS_FF_INFOINFERRED) = VS_FF_INFOINFERRED Then Result.FileFlags = Result.FileFlags & " Info "
            If (.dwFileFlags And VS_FF_PATCHED) = VS_FF_PATCHED Then Result.FileFlags = Result.FileFlags & " Patched "
            If (.dwFileFlags And VS_FF_PRERELEASE) = VS_FF_PRERELEASE Then Result.FileFlags = Result.FileFlags & " PreRel "
            If (.dwFileFlags And VS_FF_PRIVATEBUILD) = VS_FF_PRIVATEBUILD Then Result.FileFlags = Result.FileFlags & " Private "
            If (.dwFileFlags And VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD Then Result.FileFlags = Result.FileFlags & " Special "
            If Result.FileFlags = "" Then Result.FileFlags = "Unknown"
            Result.FileFlags = Trim(Replace(Result.FileFlags, "  ", " "))

            If (.dwFileOS And VOS_DOS) = VOS_DOS Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " DOS " ' 파일 OS
            If (.dwFileOS And VOS_NT) = VOS_NT Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " NT "
            If (.dwFileOS And VOS__WINDOWS16) = VOS__WINDOWS16 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit Windows "
            If (.dwFileOS And VOS__WINDOWS32) = VOS__WINDOWS32 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit Windows "
            If (.dwFileOS And VOS_OS216) = VOS_OS216 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit OS/2 "
            If (.dwFileOS And VOS_OS232) = VOS_OS232 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit OS/2 "
            If (.dwFileOS And VOS__PM16) = VOS__PM16 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit Presentation Manager "
            If (.dwFileOS And VOS__PM32) = VOS__PM32 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit Presentation Manager "
            If Result.TargetOperatingSystem = "" Then Result.TargetOperatingSystem = "Unknown"
            Result.TargetOperatingSystem = Trim(Replace(Result.TargetOperatingSystem, "  ", " "))
           
            On Error Resume Next ' 파일 타입
            Result.FileType = Switch(.dwFileType = VFT_APP, "App", _
                                    .dwFileType = VFT_DLL, "DLL", _
                                    .dwFileType = VFT_DRV, "Driver", _
                                    .dwFileType = VFT_FONT, "Font", _
                                    .dwFileType = VFT_VXD, "VxD", _
                                    .dwFileType = VFT_STATIC_LIB, "Lib")
            If Err.Number > 0 Then Result.FileType = "Unknown"
            On Error GoTo 0

            Select Case .dwFileType ' 파일 서브 타입
                Case VFT_DRV
                    Result.FileSubtype = Switch(.dwFileSubtype = VFT2_DRV_PRINTER, "Printer drv", _
                                                .dwFileSubtype = VFT2_DRV_KEYBOARD, "Keyboard drv", _
                                                .dwFileSubtype = VFT2_DRV_LANGUAGE, "Language drv", _
                                                .dwFileSubtype = VFT2_DRV_DISPLAY, "Display drv", _
                                                .dwFileSubtype = VFT2_DRV_MOUSE, "Mouse drv", _
                                                .dwFileSubtype = VFT2_DRV_NETWORK, "Network drv", _
                                                .dwFileSubtype = VFT2_DRV_SYSTEM, "System drv", _
                                                .dwFileSubtype = VFT2_DRV_INSTALLABLE, "Installable", _
                                                .dwFileSubtype = VFT2_DRV_SOUND, "Sound drv", _
                                                .dwFileSubtype = VFT2_DRV_COMM, "Comm drv", _
                                                .dwFileSubtype = VFT2_UNKNOWN, "Unknown")
                Case VFT_FONT
                    Result.FileSubtype = Switch(.dwFileSubtype = VFT2_FONT_RASTER, "Raster Font", _
                                                    .dwFileSubtype = VFT2_FONT_TRUETYPE, "TrueType Font", _
                                                    .dwFileSubtype = VFT2_FONT_VECTOR, "Vector Font", _
                                                    .dwFileSubtype = VFT2_UNKNOWN, "Unknown")
            End Select
        End With

        VersionInformation = True
    End Function

     

    Like 연산자의 형식은 다음과 같다. 필드명 like 패턴문자열이다.
    이때 패턴 문자열에 부쿼리를 사용한다.
    부쿼리가 들어가 자리에는 부쿼리 이전의 패턴 문자열이 있다면 문자열 닫음으로 막아주고, 마찬가지로 부쿼리 이후도 패턴 문자열이 있다면 문자열 시작으로 열어주어야 하고, 패턴 문자열들과 부 쿼리 사이에 문자열이 연결 될 수 있도록 +로 연결하여 준다.
    그러면 하나의 패턴 문자열이 된다.

    예를 들면 이런 형식이다.
    '패턴문자열' + (부쿼리) + '패턴 문자열' + (부쿼리) + '패턴 문자열'
    여기서 부쿼리는 하나의 필드와 하나의 레코드만 반환하는 SELECT 쿼리 이어야 한다.

    실 예를 들면 다음과 같다.
    fielda like '%' + (select fieldb from operator  where fieldc = 1) + '%'
    패턴문자열은 부쿼리가 반환하는 필드 내용을 포함하는 모든 문자열에 적용된다.

    'SQL' 카테고리의 다른 글

    select into와 insert into select의 차이  (0) 2012.08.16
    엑세스에서 Replace  (0) 2011.10.04
    ActiveX DLL 프로젝트와 EXE 프로젝트를 같은 프로젝트 그룹에 추가하게 되면 EXE 프로젝트에서 ActiveX DLL 프로젝트에서 DLL을 생성하지 않아도 참조할수 있게 된다.


    다른 클래스 프로젝트도 마찬가지이다.

    ExtractIcon API dll이나 exe 파일에서 아이콘을 추출해 내는 API이다. 그러면 이 API를 활용해서 확장에 부여된 아이콘을 추출해 보자.

    확장자에 설정된 아이콘의 정보는 레지스트리에 저장되 있다.
    만약 텍스트 파일 확장자인 .TXT의 확장자에 대한 아이콘 정보를 얻기 위해 레지스트리에서 다음과 같이 값을 얻어야 한다.

    실행에서 RegEdit를 입력하면 레지스트리 에디터 프로그램을 실행할수 있다.
    레지스트리에서 루트 키중에 HKEY_CLASSES_ROOT키 아래에 확장자에 대한 정보가 저장되어 있다.


    HKEY_CLASSES_ROOT 아래에 .확장자 이름으로 된 키를 찾느다. 여기 에서는 .txt가 되겠다


    해당 키에 기본값에는 확장자에 대한 이름이 지정되어 있다. .txt에는 txtfile로 되어 있다.

    다시 HKEY_CLASSES_ROOT키 아래에서 이전에 확장자에 할당될 이름과 같은 키를 찾는다. 여기서 txtfile


    찾은 키의 DefaultIcon의 기본값을 읽으면 해당 이름의 확장자에 할당된 아이콘이 어떤 파일에 들어있고, 그 파일에서 몇번째의 아이콘인지를 알수 있다.


    이 정보를 가지고 API를 사용하여 아이콘 핸들을 추출하여, DC에 그리면 된다.

    다음 예제 소스의 초기 화면이다.


    텍스트 박스에 .을 포함한 파일명이나 확장자를 입력하면 그 확장자에 대한 아이콘 정보를 얻어 픽처박스에 아이콘을 그린다.
    다음 이미지는 텍스트 박스에 엔터를 입력한 후의 결과 이미지이다.



    아래는 위 이미지에 대한 소스입니다.
    ' 확장자에 할당된 아이콘을 추출한다.
    Option Explicit

    Private Const ERROR_SUCCESS = 0
    Private Const BufferSize = 500
    Private Const HKEY_CLASSES_ROOT = &H80000000

    Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Declare Function DrawIcon Lib "user32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
    Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
    Private Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

    Private Sub SetStringButter(Buffer As String, BufferLength As Long) ' 버퍼 할당
        BufferLength = BufferSize ' 버퍼 길이
        Buffer = Space$(BufferLength) ' 버퍼 할당
    End Sub

    Private Function GetStringInButter(ByVal Buffer As String, ByVal BufferLength As Long) As String ' 버퍼에 포함된 문자열을 반환, 어디까지 문자열 종료 까지만
        GetStringInButter = Left(Buffer, BufferLength - 1)
    End Function

    Public Sub GetDefaultIcon(ByVal FileName As String, ByVal Picture_hDC As Long)
        Dim GetInfoIconStatus As Boolean ' 아이콘 정보를 얻었는지에 대한 상태 플래그
        Dim ReturnValue As Long ' 반환값
        Dim RegKeyHandle As Long ' 레지스트리 키 핸들
        Dim Buffer As String ' 버퍼,확장자에 할당한 이름,아이콘 정보,아이콘 파일
        Dim BufferLength As Long ' 버퍼 길이,버퍼에 저장된 데이타 길이
        Dim IconNumber As Long ' 아이콘 번호
        Dim CommaPositon As Long ' 콤마 위치
        Dim IconHandle As Long ' 아이콘 핸들
       
        GetInfoIconStatus = False ' 아이콘 상태 플래그 초기화
        FileName = Mid$(FileName, InStrRev(FileName, ".")) ' 학장자만 얻는다 . 포함
        ReturnValue = RegOpenKey(HKEY_CLASSES_ROOT, FileName, RegKeyHandle) ' 확장자에 대한 레지스트리 키를 오픈한다.
        If ReturnValue = ERROR_SUCCESS Then ' 확장자 키를 오픈 성공이라면
            SetStringButter Buffer, BufferLength ' 버퍼 할당
            ReturnValue = RegQueryValueEx(RegKeyHandle, vbNullString, 0, 0, Buffer, BufferLength)
            Call RegCloseKey(RegKeyHandle)
            If ReturnValue = ERROR_SUCCESS Then ' 확장자에 할당한 이름을 읽어 왔다면
                Buffer = GetStringInButter(Buffer, BufferLength)
                ReturnValue = RegOpenKey(HKEY_CLASSES_ROOT, Buffer & "\DefaultIcon", RegKeyHandle)
                If ReturnValue = ERROR_SUCCESS Then ' 확장자에 할당된 이름에 대한 아이콘 정보가 있는 키 오픈에 성공 했다며
                    SetStringButter Buffer, BufferLength ' 버퍼 할당
                    ReturnValue = RegQueryValueEx(RegKeyHandle, vbNullString, 0, 0, Buffer, BufferLength)
                    Call RegCloseKey(RegKeyHandle)
                    If ReturnValue = ERROR_SUCCESS Then ' 아이콘 정보를 얻었다면
                        Buffer = GetStringInButter(Buffer, BufferLength)
                        CommaPositon = InStrRev(Buffer, ",")
                        If Not CommaPositon < 1 Then ' 제대로된 아이콘 정보가 있다면
                            IconNumber = Trim$(Mid$(Buffer, CommaPositon + 1))
                            Buffer = Trim$(Left(Buffer, CommaPositon - 1))
                            GetInfoIconStatus = True ' 아이콘 정보 얻음
                        End If
                    End If
                End If
            End If
        End If
       
        If Not GetInfoIconStatus Then ' 아이콘 정보를 얻지 못했다면
            SetStringButter Buffer, BufferLength ' 버퍼 할당
            BufferLength = GetSystemDirectory(Buffer, BufferLength) + 1
            Buffer = GetStringInButter(Buffer, BufferLength) & "\SHELL32.DLL"
            IconNumber = IIf(StrComp(FileName, ".exe", vbTextCompare), 0, 2)
        End If

        ' 아이콘을 추출하고 DC에 그린다
        IconHandle = ExtractIcon(App.hInstance, Buffer, IconNumber) ' 아이콘 파일에서 추출
        If Not IconHandle = 1 And Not IconHandle = 0 Then ' 아이콘을 추출했다면
            ReturnValue = DrawIcon(Picture_hDC, 0, 0, IconHandle) ' 아이콘을 DC에 그리고
            ReturnValue = DestroyIcon(IconHandle) ' 추출한 아이콘을 제거(파일에서 제거가 아니다)
        End If
    End Sub

    Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
        If Not KeyCode = vbKeyReturn Then Exit Sub
        If Not CBool(InStr(Text1.Text, ".")) Then Exit Sub
        Picture1.Cls
        GetDefaultIcon Text1.Text, Picture1.hDC
        Text1.SetFocus
    End Sub

    Private Sub Form_Activate()
        Call Text1.SetFocus
    End Sub

    Private Sub Form_Load()
        Text1.Text = ".txt"
    End Sub

     

    폼 모듈이나 다른 클래스 모듈에서, DLL에 포함된 클래스에서 생성한 폼의 텍스트 박스에 입력한 값을
    DLL의 클래스를 생성한 모듈에 전달하기 위해서는 여러가지 방법이 있을수 있다.

    여기서는 이벤트를 사용하는 방법을 설명하겠다.
    아주 단순한 구조이다.

    DLL의 클래스에 개체(인스턴스)를 생성한 모듈을 폼 모듈이라 가정하겠다.
    폼 모듈에서는 withevents를 사용헤서 DLL의 클래스의 개체를 저장할 변수를 생성한다.
    그러면 DLL의 클래스 개체에서 발생한 이벤트를 폼 모듈에서 처리할 수 있게 된다.
    ' 실행하기 전에, 클래스 프로젝트에서 Dll 파일을 한번 생성한후에, 본 프로제트의 참조에 dll 참조를 추가시켜야 한다.
    Option Explicit

    Private WithEvents Cls As Project2.Class1

    Private Sub Cls_CloseForm(ByVal Message As String)
        MsgBox Message
        Me.Show
    End Sub

    Private Sub Form_Load()
        Set Cls = New Project2.Class1
        Me.Hide
    End Sub

    개체의 클래스가 포함된 DLL의 클래스 모듈에서는 발생시킬 이벤트를 선언하여 주고
    DLL에 포함시킬 폼의 텍스트 박스에 대한 이벤트를 받기 위해서 withevents를 사용한 개체변수를 하나 생성한다.
    그러면 DLL에 포함된 폼의 텍스트 박스에서 발생하는 이벤트를 클래스 모듈에서 받을수 있다.
    텍스트 박스에서 이벤트가 발생하면, RaiseEvent를 사용해서 상단에 선언한 이벤트를 발생시키면
    이 클래스의 개체를 생성한 모듈에서도 이벤트를 받게 된다.
    Option Explicit

    Public Event CloseForm(ByVal Message As String)

    Private WithEvents clsTextBox As TextBox

    Private Sub Class_Initialize()
        frmCls.Show
        Set clsTextBox = frmCls.Text1
    End Sub

    Private Sub clsTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
        If Not KeyCode = vbKeyReturn Then Exit Sub
        RaiseEvent CloseForm(clsTextBox.Text)
        Set clsTextBox = Nothing
        Unload frmCls
    End Sub

    다음은 텍스트 박스를 올리기 위한 폼 모듈이다. 먼저 DLL에 폼 모듈을 추가시키고 폼 모듈을 추가하고 텍스트 박스 올리는것으로 끝이다. 다른 특별한 코드가 필요치 않다.
    Option Explicit

    Private Sub Command1_Click()
        Unload Me
    End Sub

    아래 이미지는 위 소스를 실행시키면 나타나는 DLL에서 생성한 폼이 나타난다. DLL 클래스의 개체를 폼한하고 있는 폼 모듈은 Hide로 해놨다.


    DLL 클래스에서 생서한 폼의 텍스트 박스에 메세지를 입력한 이미지이다.

    텍스트 박스에서 엔터를 치게되면 DLL 클래스에서 이벤트를 발생시키게 되고, 이를 폼 모듈에서 받게 된다.
    폼 모듈에서는 이 이벤트에 대한 이벤트 프로시저에 전달된 값에 대한 메세지 박스를 표시하도록 코드 실행 이미지이다.

    텍스트 박스에 입력한 메세지와, 메세지 박스에 표시된 메세지가 같음을 알수 있다. 이것은 DLL에서 이벤트 발생시 이벤트의 인수로 텍스트박스의 값을 전달하도록 코드가 되있기 때문이다, 확인 버튼을 누리면 메인 폼이 다시 보인다.

    이런 방법으로 값을 전달하면 된다. 이걸 응용해서 사용하면 여러 이벤트에 대한 값을 전달해 줄 수 있다.

    이번에는 저번 글에 이어 다차원 베지어 곡선을 그리는 방법을 보자, 즉 초기 점의 3개 이상의로된 점으로 된 경로에 대한 배지어 곡선을 그리는 것이다.
    지난번과 같은 소스이면 여기 다차원, 즉 여러개의 점을 지원하기 위해 약간 변경되어 있다.
    다음 그림은 2차원 베지어 곡선이다. 직선이 2개인 경로에 대한  베지어 곡선을 그린 예이다.


    다음 이미지는 베지어 곡선을 그려 나가는 중


    다음 이미지는 3차원 곡선에 대한 베지어 곡선을 그리기 위한 초기 화면이다.


    다음 이미지는 3차원 경로에 대한 베지어 곡선을 그려 나가는 이미지이다.


    다음 이미지는 다차원 경로에 대한 베지어 곡선을 그리기 위한 초기 화면으로 8개의 점으로 된 경로이다.


    다차원 경로에 대한 베이저 곡선을 그려나가는 이미지


    다차원 곡선에 대한 완료된 베지어 곡선을 그린 이미지이다.

    여기서 한가지 베지어 곡선에서 경로의 시작점은 베지어 곡선의 시작점이 되고, 경록의 마지막 점은 베지어 곡선도 마지막 점이 된다.

    다음은 소스이다.
    Option Explicit ' 모든 변수는 선언된 뒤에 사용 할 수 있다.
    Option Base 1

    Private Const XPoint = 1 ' 점 위치의 X좌표 첨자
    Private Const YPoint = 2 ' 점 위치의 Y좌표 첨자
    Private Const StartDotNumber = 3 ' 시작점 수
    Private Const AddPercent = 0.01 ' 변경 비율

    Private HarfDot As Long ' 점의 반지름
    Private DotPoint() As Long ' 현재 점의 위치
    Private Dimension() As Long ' 각 차수 시작 첨자
    Private DotBezier() As Long ' 베지어 곡선 좌표
    Private SelectDot As Long ' 현재 마우스로 선택된 점의 인덱스 번호

    Private Sub CreatePoint(ByVal index As Long) ' 점을 생성한다.
        With picClient
            DotPoint(XPoint, index) = Rnd(1) * .Width
            DotPoint(YPoint, index) = Rnd(1) * .Height
        End With
    End Sub

    Private Function GetDimension(ByVal index As Long) As Long ' 점의 어떤 차원의 점인지를 얻는다
        For GetDimension = UBound(Dimension) To 1 Step -1
            If index >= Dimension(GetDimension) Then Exit For
        Next GetDimension
    End Function

    Private Sub DisplayPoint(ByVal index As Long) ' 점을 표시한다.
        Dim LoadConffirm As Boolean ' 표시하기 위한 점 컨트롤이 로드된 컨트롤인지 확인

        On Error Resume Next
        LoadConffirm = shpPoint(index).Visible
        If Err.Number > 0 Then Load shpPoint(index) ' 에러라면 로드하지 않은 컨트롤
        On Error GoTo 0
        With shpPoint(index)
            .BackColor = QBColor(GetDimension(index))
            .Left = DotPoint(XPoint, index) - HarfDot
            .Top = DotPoint(YPoint, index) - HarfDot
            .Visible = True
        End With
    End Sub
    '
    Private Sub DrawLine(ByVal index As Long, ByVal Befor As Boolean, ByVal Clear As Boolean) ' 점과 점을 잊는 선을 그린다.
        Dim x2 As Long ' 연결할 점의 좌표
        Dim y2 As Long

        x2 = DotPoint(XPoint, index + IIf(Befor, -1, 1)) ' 연결할 점의 좌표를 얻는다.
        y2 = DotPoint(YPoint, index + IIf(Befor, -1, 1))
        picClient.Line (DotPoint(XPoint, index), DotPoint(YPoint, index))-(x2, y2), IIf(Clear, picClient.BackColor, QBColor(GetDimension(index)))
    End Sub

    Private Function CursorInDot(ByVal x As Long, ByVal y As Long) As Long ' 커서가
        For CursorInDot = GetDotNumber To 1 Step -1
            If DotPoint(XPoint, CursorInDot) - HarfDot <= x And DotPoint(XPoint, CursorInDot) + HarfDot >= x And _
                DotPoint(YPoint, CursorInDot) - HarfDot <= y And DotPoint(YPoint, CursorInDot) + HarfDot >= y Then
                Exit For
            End If
        Next CursorInDot
    End Function

    Private Function GetDotNumber() As Long ' 점 수
        GetDotNumber = UBound(DotPoint, 2)
    End Function

    Private Sub cmdStart_Click() ' 시작
        timProcess = True
        cmdStart.Enabled = False
    End Sub

    Private Function GetLastIndexInDimension(Dimen As Long) As Long ' 차원의 마지막 점의 인덱스 -1
        If UBound(Dimension) = Dimen Then
            GetLastIndexInDimension = GetDotNumber - 1
        Else
            GetLastIndexInDimension = (Dimension(Dimen + 1) - 1) - 1
        End If
    End Function

    Private Sub Form_Load()
        Dim forDotCounter As Long ' 점 카운터
       
        Randomize ' 난수 발생기를 초기화 한다
        HarfDot = shpPoint(0).Width / 2 ' 점의 반지름
        ReDim Dimension(1) ' 1차원
        ReDim DotPoint(YPoint, StartDotNumber) ' 포인터가 저장될 배열의 초기화
        Dimension(1) = 1 ' 1차원 포인터의 시작 첨자
        picClient.AutoRedraw = True
        For forDotCounter = 1 To StartDotNumber ' 점을 생성한다.
            CreatePoint forDotCounter
        Next forDotCounter
        For forDotCounter = 1 To StartDotNumber ' 점을 표시한다.
            DisplayPoint forDotCounter
        Next forDotCounter
        For forDotCounter = 2 To StartDotNumber ' 점과 점을 잇는 직선을 그린다.
            DrawLine forDotCounter, True, False
        Next forDotCounter
    End Sub

    Private Sub picClient_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        If Not Button = vbLeftButton Then Exit Sub ' 왼쪽 버튼일때만 처리
        SelectDot = CursorInDot(x, y) ' 선택된 점 지정
    End Sub

    Private Sub picClient_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' 점 이동시
        Dim forDotCounter As Long ' 점 카운터
       
        Me.MousePointer = IIf(CursorInDot(x, y) = 0, vbDefault, vbCrosshair)
        If Not Button = vbLeftButton Or SelectDot = 0 Then Exit Sub ' 왼족 버튼과, 점을 선택한경우만 처리
        If Not SelectDot = GetDotNumber Then
            DrawLine SelectDot, False, True
        End If
        If Not SelectDot = 1 Then
            DrawLine SelectDot, True, True
        End If
        DotPoint(XPoint, SelectDot) = x
        DotPoint(YPoint, SelectDot) = y
        DisplayPoint SelectDot
        For forDotCounter = GetDotNumber - 1 To 1 Step -1
            DrawLine forDotCounter, False, False
        Next
    End Sub

    Private Sub picClient_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
        SelectDot = 0
    End Sub

    Private Sub timProcess_Timer() ' 베지어 곡선을 그린다
        Static T As Double ' 비율
        Static Bx As Long ' 이전 베지어 곡선 마지막 좌표
        Static By As Long ' 이전 베지어 곡선 마지막 좌표
        Dim CurrentDimension As Long ' 현재 차운
        Dim ForPointerCounter As Long ' 현재 포인터 인덱스
        Dim LastPointIndex As Long ' 현재 차원의 마지막 점의 인덱스-1
        Dim NextDimensionDotIndex As Long ' 현재 직선에 대한 다음 차원의 점 인덱스 번호

        timProcess.Enabled = False
        If T >= 1 Then ' 비율 계산, 및 초기화
            Exit Sub
        Else
            T = T + AddPercent
            labRateValue.Caption = Format(T, "0.00")
            CurrentDimension = 1
            ForPointerCounter = 1
        End If
       
        Do
            If Not UBound(Dimension) = CurrentDimension Then ' 새로운 차원이 첨이 생긴 경우, 이전에 그렸던 직선을 지우기 위함
                LastPointIndex = GetLastIndexInDimension(CurrentDimension + 1)
                For ForPointerCounter = Dimension(CurrentDimension + 1) To LastPointIndex
                    DrawLine ForPointerCounter, False, True
                Next ForPointerCounter
            End If
           
           
            LastPointIndex = GetLastIndexInDimension(CurrentDimension)
       
            For ForPointerCounter = Dimension(CurrentDimension) To LastPointIndex
                If ForPointerCounter = Dimension(CurrentDimension) And UBound(Dimension) = CurrentDimension Then
                    ReDim Preserve Dimension(CurrentDimension + 1)
                    Dimension(CurrentDimension + 1) = GetDotNumber + 1
                End If
                NextDimensionDotIndex = Dimension(CurrentDimension + 1) + (ForPointerCounter - Dimension(CurrentDimension))
                If GetDotNumber < NextDimensionDotIndex Then ReDim Preserve DotPoint(YPoint, NextDimensionDotIndex)
                DotPoint(XPoint, NextDimensionDotIndex) = DotPoint(XPoint, ForPointerCounter) + (DotPoint(XPoint, ForPointerCounter) - DotPoint(XPoint, ForPointerCounter + 1)) * T * -1
                DotPoint(YPoint, NextDimensionDotIndex) = DotPoint(YPoint, ForPointerCounter) + (DotPoint(YPoint, ForPointerCounter) - DotPoint(YPoint, ForPointerCounter + 1)) * T * -1
                DisplayPoint NextDimensionDotIndex
            Next
            CurrentDimension = CurrentDimension + 1 ' 다음 차원
       
            For ForPointerCounter = 1 To GetDotNumber - 1
                If GetDimension(ForPointerCounter) = GetDimension(ForPointerCounter + 1) Then
                    DrawLine ForPointerCounter, False, False
                End If
            Next
        Loop While Not GetDotNumber - Dimension(CurrentDimension) = 0 ' 마지막 차원의 점이 하나일 때까지 반복
        ' 이전 이벤트의 마지막 점과, 현재의 마지막 점을 연결하여 베지어 곡선을 그린다
        If T = AddPercent Then
            ReDim DotBezier(YPoint, 1)
            DotBezier(XPoint, 1) = DotPoint(XPoint, 1)
            DotBezier(YPoint, 1) = DotPoint(YPoint, 1)
        End If
        ReDim Preserve DotBezier(YPoint, UBound(DotBezier, 2) + 1)
        DotBezier(XPoint, UBound(DotBezier, 2)) = DotPoint(XPoint, GetDotNumber)
        DotBezier(YPoint, UBound(DotBezier, 2)) = DotPoint(YPoint, GetDotNumber)

        For ForPointerCounter = UBound(DotBezier, 2) To 2 Step -1
            picClient.Line (DotBezier(XPoint, ForPointerCounter), DotBezier(YPoint, ForPointerCounter))-(DotBezier(XPoint, ForPointerCounter - 1), DotBezier(YPoint, ForPointerCounter - 1)), vbRed
        Next ForPointerCounter
        timProcess.Enabled = True
    End Sub

    위 소스의 공식은 베지어 곡선을 그리는 방법이 이런것이다를 표시하기 위해 베지어 곡선을 구하는 공식을 각 단계별로 풀어서 사용했다고 보시면 됩니다. 따라서 속도는 느립니다. 빠른 속도를 원핫시면 베지어 곡선을 구하는 공식이 있읍니다. 그 공식을 적용하시면 빠른 곡선을 그리실수 있읍니다.


    베지어 곡선(bezie-curve)이란

    에서 베지어 곡선 수학 공신 관련 링크를 참조하세요

    다음 예제는 베지어 곡선을 그리는 예로 1차 곡선입니다.
    즉 시작하는 점은 2개의 점이며 이를 잊는 직선으로 되있을 경우에 베지어 곡선을 그리는 결과를 나타냅니다.

    초기 화면은 다음과 같습니다. 두점과 그를 잊는 직선으로 이루어진 경로가 있을 경우의 베지어 곡선입니다.


    시작 버튼을 누르게 되면 베지어 곡선을 그리게 되며, 시작 버튼을 누리기 전에 점을 클릭해서 드래그 하면
    점의 위치를 변경할수 있읍니다.

    다음은 소스 입니다.
    Option Explicit ' 모든 변수는 선언된 뒤에 사용 할 수 있다.
    Option Base 1

    Private Const XPoint = 1
    Private Const YPoint = 2

    Private HarfDot As Long ' 점의 반지름
    Private Pointer() As Long ' 현재 점의 위치
    Private Dimension() As Long ' 각 차수 시작 첨자
    Private SelectDot As Long ' 현재 마우스로 선택된 점의 인덱스 번호

    Private Sub CreatePoint(ByVal index As Long) ' 점을 생성한다.
        Pointer(XPoint, index) = Rnd(1) * picClient.Width
        Pointer(YPoint, index) = Rnd(1) * picClient.Height
    End Sub

    Private Function GetDimension(ByVal index As Long) As Long ' 점의 어떤 차원의 점인지를 얻는다
        For GetDimension = UBound(Dimension) To 1 Step -1
            If index >= Dimension(GetDimension) Then Exit For
        Next GetDimension
    End Function

    Private Sub DisplayPoint(ByVal index As Long) ' 점을 표시한다.
        Dim LoadConffirm As Boolean
       
        On Error Resume Next
        LoadConffirm = shpPoint(index).Visible
        If Err.Number > 0 Then Load shpPoint(index)
        On Error GoTo 0
        With shpPoint(index)
            .BackColor = QBColor(GetDimension(index))
            .Left = Pointer(XPoint, index) - HarfDot
            .Top = Pointer(YPoint, index) - HarfDot
            .Visible = True
        End With
    End Sub

    Private Sub DrawLine(ByVal index As Long, ByVal Befor As Boolean, ByVal Clear As Boolean) ' 점과 점을 잊는 선을 그린다.
        Dim x2 As Long ' 연결할 점의 좌표
        Dim y2 As Long
        Dim C As Long ' 연결할 선의 색
       
        x2 = Pointer(XPoint, index + IIf(Befor, -1, 1)) ' 연결할 점의 좌표를 얻는다.
        y2 = Pointer(YPoint, index + IIf(Befor, -1, 1))
        picClient.Line (Pointer(XPoint, index), Pointer(YPoint, index))-(x2, y2), IIf(Clear, picClient.BackColor, QBColor(GetDimension(index)))
    End Sub

    Private Function CursorInDot(ByVal x As Long, ByVal y As Long) As Long ' 커서가
        For CursorInDot = UBound(Pointer, 1) To 1 Step -1
            If Pointer(XPoint, CursorInDot) - HarfDot <= x And Pointer(XPoint, CursorInDot) + HarfDot >= x And _
                Pointer(YPoint, CursorInDot) - HarfDot <= y And Pointer(YPoint, CursorInDot) + HarfDot >= y Then
                Exit For
            End If
        Next CursorInDot
    End Function

    Private Function GetDotNumber() As Long ' 점 수
        GetDotNumber = UBound(Pointer, 2)
    End Function

    Private Sub cmdStart_Click() ' 시작
        timProcess = True
        cmdStart.Enabled = False
    End Sub

    Private Sub Form_Load()
        Randomize ' 난수 발생기를 초기화 한다
       
        HarfDot = shpPoint(0).Width / 2 ' 점의 반지름
        ReDim Dimension(1) ' 1차원
        ReDim Pointer(YPoint, 2) ' 포인터가 저장될 배열의 초기화, 초기 점 2개에 좌표(x,y)
        Dimension(1) = 1 ' 1차원 포인터의 시작 첨자
        picClient.AutoRedraw = True
        CreatePoint 1 ' 점을 생성한다.
        CreatePoint 2
        DisplayPoint 1 ' 점을 표시한다.
        DisplayPoint 2
        DrawLine 2, True, False
    End Sub

    Private Sub picClient_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        If Not Button = vbLeftButton Then Exit Sub ' 왼쪽 버튼일때만 처리
        SelectDot = CursorInDot(x, y) ' 선택된 점 지정
    End Sub

    Private Sub picClient_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
        If Not Button = vbLeftButton Or SelectDot = 0 Then Exit Sub ' 왼족 버튼과, 점을 선택한경우만 처리
        If Not SelectDot = UBound(Pointer, 1) Then
            DrawLine SelectDot, False, True
        End If
        If Not SelectDot = 1 Then
            DrawLine SelectDot, True, True
        End If
        Pointer(XPoint, SelectDot) = x
        Pointer(YPoint, SelectDot) = y
        DisplayPoint SelectDot
        If Not SelectDot = UBound(Pointer, 1) Then
            DrawLine SelectDot, False, False
        End If
        If Not SelectDot = 1 Then
            DrawLine SelectDot, True, False
        End If
    End Sub

    Private Sub picClient_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
        SelectDot = 0
    End Sub

    Private Sub timProcess_Timer()
        Static T As Double ' 비율
        Static Bx As Long ' 이전 베지어 곡선 마지막 좌표
        Static By As Long ' 이전 베지어 곡선 마지막 좌표
        Dim CurrentDimension As Long ' 현재 차운
        Dim ForPointerCounter As Long ' 현재 포인터 인덱스
        Dim LastPointIndex As Long ' 현재 차원의 마지막 점의 인덱스-1
        Dim NextDimensionDotIndex As Long ' 현재 직선에 대한 다음 차원의 점 인덱스 번호
       

        timProcess.Enabled = False
        If T >= 1 Then ' 비율 계산, 및 초기화
            Exit Sub
        Else
            T = T + 0.01
            labRateValue.Caption = Format(T, "0.00")
            CurrentDimension = 1
            ForPointerCounter = 1
        End If


        If UBound(Dimension) = CurrentDimension Then
            LastPointIndex = UBound(Pointer, 1) - 1
        Else
            LastPointIndex = (Dimension(CurrentDimension + 1) - 1) - 1
        End If


        For ForPointerCounter = Dimension(CurrentDimension) To LastPointIndex
            If ForPointerCounter = Dimension(CurrentDimension) And UBound(Dimension) = CurrentDimension Then
                ReDim Preserve Dimension(CurrentDimension + 1)
                Dimension(CurrentDimension + 1) = UBound(Pointer, 1) + 1
            End If
            NextDimensionDotIndex = Dimension(CurrentDimension + 1) + (ForPointerCounter - Dimension(CurrentDimension))
            If UBound(Pointer, 1) < NextDimensionDotIndex Then ReDim Preserve Pointer(YPoint, NextDimensionDotIndex)
            Pointer(XPoint, NextDimensionDotIndex) = Pointer(XPoint, ForPointerCounter) + (Pointer(XPoint, ForPointerCounter) - Pointer(XPoint, ForPointerCounter + 1)) * T * -1
            Pointer(YPoint, NextDimensionDotIndex) = Pointer(YPoint, ForPointerCounter) + (Pointer(YPoint, ForPointerCounter) - Pointer(YPoint, ForPointerCounter + 1)) * T * -1
            DisplayPoint NextDimensionDotIndex
        Next
        CurrentDimension = CurrentDimension + 1 ' 다음 차원
        If GetDotNumber - Dimension(CurrentDimension) = 0 Then ' 이전 이벤트의 마지막 점과, 현재의 마지막 점을 연결하여 베지어 곡선을 그린다
            If Bx = 0 Then
                Bx = Pointer(XPoint, 1)
                By = Pointer(YPoint, 1)
            End If
            picClient.Line (Bx, By)-(Pointer(XPoint, GetDotNumber), Pointer(YPoint, GetDotNumber)), vbRed
            Bx = Pointer(XPoint, GetDotNumber)
            By = Pointer(YPoint, GetDotNumber)
        End If
        timProcess.Enabled = True
    End Sub

    다음 번에는 시작점이 3개인 즉, 직선이 2개인 경로를 갖는 경우의 베지어 곡선을 그려보겠읍니다.

    베지어 곡선에 대한 설명 웹페이지는 만다.
    단순하게 만들면, 베지어 곡선은 지정된 점들을 연결한 경로에서 추출해 내는 곡선을 말한다.
    추출하는 방법은 N개의 점의 있으면 점과 이웃 점을 연결하면 N-1개의 직선이 생긴다.
    이 N-1개의 직선들에 각각 균등한 비율로 한개의 점을 생성하면 N-1개의 직선상에 N-1개의 점이 생긴다.
    N-1개의 점들에서 서로 이웃하는 점을 연결하면 N-2개의 직선이 생기다.
    이를 똑깥이 N-1개 직선에서 균등한 비율로 한개의 점을 생성하는 방법으로 점을 얻고, 서로 연결한다.
    이런 작업을 반복하여 1개의 직선을 얻고 그 직선위에 위에서 사용한 균등한 비율로 점을 얻는다.
    이 점을 연결한 것이 베지어 곡선이다.


    베지어 곡선의 숙학적인 이해 http://eunchul.com/Algorithms/BezierCurves/BezierCurves.htm

    wikipedia 베지어 곡선 http://en.wikipedia.org/wiki/B%C3%A9zier_curve

    위키백과 베지어 곡선 http://ko.wikipedia.org/wiki/%EB%B2%A0%EC%A7%80%EC%97%90_%EA%B3%A1%EC%84%A0

    바탕화면의 이미지를 복사한 후, 그 위에 마우스 정보를 얻어 마우스 이미지를 그리는 방식이다.

    초기 화면은 다음과 같다.


    다음 이미지는 스샷하기 버튼을 눌러 마우스 커서를 포함한 스크린샷을 한 이미지다


    다음은 소스이다.
    ' 마우스 커서를 포함한 스크린샷
    Option Explicit

    Private Type POINTAPI
        x As Long
        y As Long
    End Type

    Private Type ICONINFO
        fIcon As Long
        xHotspot As Long
        yHotspot As Long
        hbmMask As Long
        hbmColor As Long
    End Type

    Private 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
    Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
    Private Declare Function GetCursor Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Const SRCCOPY = &HCC0020


    Private Sub Command1_Click()
        Dim hdc As Long ' 바탕화면 DC 핸들
        Dim MPos As POINTAPI ' 마우스 좌표
        Dim hCursor As Long ' 마우스 커서 핸들
        Dim CursorInfo As ICONINFO ' 커서 정보
       
        With Me
            .AutoRedraw = True
            .ScaleMode = vbPixels
            hdc = GetDC(GetDesktopWindow())
            Call BitBlt(.hdc, 0, 0, .ScaleWidth, .ScaleHeight, hdc, 0, 0, SRCCOPY) ' 바탕화면 이미지를 DC에 복사한다.
            Call GetCursorPos(MPos)
            hCursor = GetCursor()
            Call GetIconInfo(hCursor, CursorInfo)
            DrawIcon .hdc, MPos.x - CursorInfo.xHotspot, MPos.y - CursorInfo.yHotspot, hCursor ' 마우스 커서를 DC에 그린다.
            .Refresh
            ReleaseDC GetDesktopWindow(), hdc
        End With
    End Sub

    정규식이란 ━ 문자열에서 특정 문자열을 검색, 치환, 추출 하기 위한 패턴을 말한다.
    정규식을 사용하기 위해서는 프로젝트 메뉴의 참조에서 Microsoft VBScript Regular Expressions 5.5을 추가하셔야 합니다.

    예의 초기 이미지 입니다.


    변경 버튼 누른 후에 원래 문자열에서 정규식 패턴에 일치하는 문자열을 대치 문자열로 변경하 이미지 입니다.



    소스입니다
    ' 정규식 참조 링크 http://msdn.microsoft.com/en-us/library/1400241x(v=VS.85).aspx
    Option Explicit ' 모든 변수는 선언되 뒤에 사용한다.

    Private Sub cmdChangeString_Click()
        Dim regEx As RegExp
       
        If Len(txtRegularPattern.Text) = 0 Then Exit Sub ' 정규식 패턴
        If Len(txtSourceString.Text) = 0 Then Exit Sub ' 원래 문자열
        If Len(txtChangeString.Text) = 0 Then Exit Sub ' 대치 문자열
        Set regEx = New RegExp
        With regEx
            .Global = True ' 일치하는 횟수에 관계 없이
            .Pattern = Trim(txtRegularPattern.Text) ' 정규식 패턴
            .IgnoreCase = True ' 대소문자를 구분하지 않을 것이냐
            labDescStringValue.Caption = .Replace(txtSourceString.Text, txtChangeString.Text)
        End With
        Set regEx = Nothing
    End Sub

    Private Sub Form_Load() ' 폼의 메모리 로드시 발생
        txtRegularPattern.Text = "\[[a-z]\]" ' 정규식 패턴
        txtSourceString.Text = "테[a]트[b] 문[1]자[K]열 [a]입니다."
        txtChangeString.Text = "Test"
    End Sub



     

    정수부는 그대로 사용하고, 실수부를 얻어 분자로, 실수부의 문자수에 따라 10의 역승을 구해 분모로 하고, 5,3,2로 가면서 약분하여 얻는 방식이다.
    소스의 처리한 이미지 입니다.



    소스는 다음과 같습니다.
    ' 소수를 분수로 표시하기(소수 부분만 정수 부분은 그대로)
    Option Explicit

    Private Sub txtFloat_KeyDown(KeyCode As Integer, Shift As Integer)
        If Not KeyCode = vbKeyReturn Then Exit Sub
        If InStr(1, txtFloat.Text, ".") = 0 Then Exit Sub
       
        Dim stringNumber As String ' 수치를 문자열로
        Dim IntegerNumber As Long ' 정수부
        Dim RealNumber As Long ' 실수부
        Dim MultilerNumber As Long ' 실수부에 수에 대한 승수
       
        stringNumber = txtFloat.Text
        MultilerNumber = InStr(stringNumber, ".")
        IntegerNumber = Val(Left(stringNumber, MultilerNumber - 1))
        RealNumber = Val(Mid(stringNumber, MultilerNumber + 1))
        MultilerNumber = 10 ^ Len(CStr(RealNumber))
       
        While RealNumber Mod 5 = 0 And MultilerNumber Mod 5 = 0 ' 약분한다.
            RealNumber = RealNumber / 5
            MultilerNumber = MultilerNumber / 5
        Wend
        While RealNumber Mod 3 = 0 And MultilerNumber Mod 3 = 0
            RealNumber = RealNumber / 3
            MultilerNumber = MultilerNumber / 3
        Wend
        While RealNumber Mod 2 = 0 And MultilerNumber Mod 2 = 0
            RealNumber = RealNumber / 2
            MultilerNumber = MultilerNumber / 2
        Wend
       
        MsgBox IIf(IntegerNumber > 0, IntegerNumber & " ", "") & RealNumber & "/" & MultilerNumber
    End Sub

    create~rgn 형태의 함수로 영역을 생성하고, SetWindowRgn을 사용하여 영역을 윈도우에 적용 시키는 것까지는 아실겁니다.
    다음에는 두 영역을 조합하여 하나의 새로운 영역을 생성하는 CombineRgn 함수 입니다.
    CombineRgn 조합한 영역을 저장할 영역의 핸들,조합에 사용할 영역 핸들1,조합에 사용할 영역 핸들2,조합 방법입니다.
    여기서 조합한 영역이 저장할 변수에는 이미 영역의 핸들이 지정되어 있어야 합니다. 그렇치 않으면 조합한 영역을 할당하지 못합니다.
    조합 방법에 사용할 수 있는 상수는 다음과 같습니다.

    상수 설명
    RGN_AND 1 두 영역의 공통부분만 합침
    RGN_COPY 5 첫번째 영역(hSrcRgn1)을 복사
    RGN_DIFF 4 첫번째 영역(hrgnSrc1)에서 두번째 영역을 제외한 부분만 합침
    RGN_OR 2 두 영역을 합침
    RGN_XOR 3 두 영역을 공통 부분을 제외한 부분을 뺀 부분만 합침


    다음은 예제의 초기 화면입니다.


    CombineRgn으로 두 영역을 조합하여 SetWindowRgn을 사용하여 윈도우에 적용한 이미지 입니다.


    가운데 뻥 뚤린 원이 되었죠.
    이런 효과를 꼭 SetWindowRgn이 아닌 다른 함수를 사용해서 효과를 볼수 있읍니다.

    소스입니다.
    Option Explicit

    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Const RGN_DIFF = 4

    Private Sub Form_Load()
        Dim OutSide As Long ' 외부 영역
        Dim InSide As Long ' 내부 영역
        Dim Desc As Long ' 조합 결과 영역
       
        With Form1
            .ScaleMode = vbPixels
            OutSide = CreateEllipticRgn(0, 0, .ScaleWidth, .ScaleHeight) ' 영역 생성
            InSide = CreateEllipticRgn(0 + 20, 0 + 20, .ScaleWidth - 20, .ScaleHeight - 20)
            Desc = CreateEllipticRgn(0, 0, .ScaleWidth, .ScaleHeight)
            Call CombineRgn(Desc, OutSide, InSide, RGN_DIFF) ' 영역 조합
            DeleteObject OutSide ' 영역 삭제
            DeleteObject InSide
            Call SetWindowRgn(.hwnd, Desc, True) ' 영역 윈도우에 할당
        End With
    End Sub

    SetWindowRgn로 폼(윈도우)를 원형으로 만든다음 시계 이미지를 윈도우에 입히고, 타이머를 돌려서 현재 시간에 대한 내용을 초침,분침,시침으로 표시합니다.

    초기 윈도우는 다음과 같습니다.


    위와 같은 윈도우 이미지를 SetWindowRgn을 사용해서 원형으로 만들고 이미지를 입히고, 타이머에 따라 시간을 표시합니다.
    다음 이미지는 실행 결과 입니다.



    소스는 다음과 같습니다.

    Option Explicit ' 모든 변수는 선언된 뒤에 사용 가능하다.

    Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

    Private Pos_x(1 To 60) As Double ' 초침 X 좌표
    Private Pos_y(1 To 60) As Double ' 초침 Y 좌표
    Private Pos_xx(1 To 60) As Double ' 분침 X 좌표
    Private Pos_yy(1 To 60) As Double ' 분침 Y 좌표
    Private Pos_xxx(1 To 12) As Double ' 시침 X 좌표
    Private Pos_yyy(1 To 12) As Double ' 시침 Y 좌표

    Private SecondColor As Long ' 초침 색
    Private MinuteColor As Long ' 분침 색
    Private HourColor As Long ' 초침 색

    Private Sub Form_DblClick()
        Me.Visible = False
        Unload Me
    End Sub

    Private Sub Form_Load()
        Const fwp = 105
        Const fhp = 105

        Dim CircleH As Long ' 원형 영역
        Dim ForCounter As Long ' For Counter
        Dim pi As Double ' 파이
       
        pi = Atn(1) * 4 ' 파이 값
        CircleH = CreateEllipticRgn(0, 0, 103, 102) ' 원 영역 생성
        With Me
            SetWindowRgn .hWnd, CircleH, True ' 원을 폼에 적용
            .BackColor = vbBlack
            .Picture = LoadPicture(VB.App.Path + "\clock.bmp")
            .Move Screen.Width - (fwp + 10) * Screen.TwipsPerPixelX, _
                10 * Screen.TwipsPerPixelY, _
                fwp * Screen.TwipsPerPixelX, _
                fhp * Screen.TwipsPerPixelY
            .ScaleMode = vbPixels
        End With
        SecondColor = RGB(128, 128, 128)
        MinuteColor = RGB(128, 64, 128)
        HourColor = RGB(64, 128, 64)
       
        For ForCounter = 1 To 60 ' 각 초를 가리키는 초침에 좌표
            Pos_x(ForCounter) = 35 * Cos(-(pi / 2) + (ForCounter * (pi / 30)))
            Pos_y(ForCounter) = 35 * Sin(-(pi / 2) + (ForCounter * (pi / 30)))
        Next ForCounter
        For ForCounter = 1 To 60 ' 각 분을 가리키는 분침에 좌표
            Pos_xx(ForCounter) = 51 + 0.9 * Pos_x(ForCounter)
            Pos_yy(ForCounter) = 50 + 0.9 * Pos_y(ForCounter)
        Next ForCounter
        For ForCounter = 1 To 12 ' 각 시를 가리키는 시침에 좌표
            Pos_xxx(ForCounter) = 51 + 0.7 * Pos_x(ForCounter * 5)
            Pos_yyy(ForCounter) = 50 + 0.7 * Pos_y(ForCounter * 5)
        Next ForCounter
        For ForCounter = 1 To 60 ' 각 초를 가리키는 초침에 좌표
            Pos_x(ForCounter) = 51 + Pos_x(ForCounter)
            Pos_y(ForCounter) = 50 + Pos_y(ForCounter)
        Next ForCounter
    End Sub
    '
    Private Sub Timer1_Timer()
        Dim CurrentTime As Date
        Dim Second As Long
        Dim Minute As Long
        Dim Hour As Long
        Dim second_Prv As Long
        Dim minute_Prv As Long
        Dim hour_Prv As Long
        Dim TempTime As Long
       
        CurrentTime = Now
        Second = VBA.Second(CurrentTime)
        If Second = 0 Then Second = 60
        second_Prv = Second - 1
        If second_Prv = 0 Then second_Prv = 60
        Minute = VBA.Minute(CurrentTime)
        If Minute = 0 Then Minute = 60
        minute_Prv = Minute - 1
        If minute_Prv = 0 Then minute_Prv = 60
        Hour = VBA.Hour(CurrentTime) Mod 12
        If Hour = 0 Then Minute = 12
        hour_Prv = Hour - 1
        If hour_Prv = 0 Then hour_Prv = 12

        DrawSecond second_Prv, False ' 이전 초를 지운다
        If Second = 60 Then  ' 초가 60초라면, 분침을 1 올리는 시간
            DrawMinute minute_Prv, False
            If Minute = 60 Then ' 분이 60 분이라면, 시침을 1 올리는 시간
                DrawHour hour_Prv, False
            End If
        End If
        DrawHour Hour, True ' 시침을 그린다
        DrawMinute Minute, True ' 분침을 그린다
        DrawSecond Second, True ' 초침을 그린다
    End Sub

    Private Sub DrawSecond(Second As Long, DrawType As Boolean) ' 초를 그린다
        Me.Line (51, 50)-(Pos_x(Second), Pos_y(Second)), IIf(DrawType, SecondColor, vbWhite) ' 초를 그린다.
    End Sub

    Private Sub DrawMinute(Minute As Long, DrawType As Boolean) ' 분을 그린다
        Dim Draw_Color As ColorConstants
        Dim ForCounterI As Long
        Dim ForcounterJ As Long
      
        Draw_Color = IIf(DrawType, MinuteColor, vbWhite)
        For ForCounterI = 50 To 52
            For ForcounterJ = 49 To 51
                Me.Line (ForCounterI, ForcounterJ)-(Pos_xx(Minute), Pos_yy(Minute)), Draw_Color
            Next ForcounterJ
       Next ForCounterI
    End Sub

    Private Sub DrawHour(Hour As Long, DrawType As Boolean) ' 시를 그린다
        Dim Draw_Color As ColorConstants
        Dim ForCounterI As Long
        Dim ForcounterJ As Long

        Draw_Color = IIf(DrawType, HourColor, vbWhite)
        For ForCounterI = 50 To 52
             For ForcounterJ = 49 To 51
                 Me.Line (ForCounterI, ForcounterJ)-(Pos_xxx(Hour), Pos_yyy(Hour)), Draw_Color
             Next ForcounterJ
        Next ForCounterI
    End Sub

    PC에 팩스 모뎀이 설치되어 있다면 팩스 보낼수 있는 응용프로그램을 사용해서 팩스를 보낼수 있읍니다.
    그러나 PC에 팩스 모뎀이 없다면 팩스를 보내기 위해서는 팩스 서버가 설치 되어 있어야 합니다. 일반인 들에게는 만만치 않은 내용이죠. 그래서 급한경우 인터넷으로 팩스를 무료로 보낼수 있는 사이트를 소개핪니다.


    회원 가입을 하면 적립금 500원이 적립됩니다.(위 이미지의 절립하기 회원가입 버튼)
    팩스 발송 가격을 보니 45.5원이라고 되어 있으니 10번정도는 보낼수 있겠내요.
    사이트 주소는
    http://enfax.ppurio.com/mgr/index.qri?act=landing_page&flag=3

    '기타 > 무료' 카테고리의 다른 글

    동영상 변환 툴 Umile Encoder  (0) 2011.10.03

    Width와 Height는 해당 태그의 실제 표시되는 영역의 크기를 지정한다.
    이때 Padding(실제 표시 영역에서 Border 까지의 공백을 말한다), Boder(실제 표시되는 영역 외곽선 Padding을 추가한 외곡선을 말한다)를 의 두께, Margine(Border에서 다른 태그와의 공백을 말한다)를 제외한 실제로 표시되는 영역의 크기이다.


    위 이미지에서 파란색 부분이 Width와 Height이며,
    파란색 박스의 경계선과 검은색 사각형 사이의 공백을 padding
    검은색 박스를 border
    border과 최고 바깥의 회색빛 사각형 영역 사이의 공백을 margin이다

    길이는 고정적 길이, 상대적 길이, auto로 표시할 수 있다
    고정적 길이는 윈도우나 영역의 크기가 변경 되더라도 변경되지 않는 길이이고, 고정적 단위로는 mm(밀리미터:1mm), cm(센티미터:1cm), in(인치미터:1in), pt(포이트:1pt), px(픽셀:1px), pica,em,ex가 있다.
     표기 단위  의미 
    px  픽셀 수 픽셀 수
     in 인치  인치 단위
     mm 미리미터 미리미터 단위
     pt  포인트 수 1/72인치를 1포인트 
     dp  해상도 비의존의 픽셀 수 실제 픽셀 수는 사용 중 화면의 해상도에 의해 변함 
     sp  폰트사이즈를 고려한 픽셀 수 유저가 설정하고 있는 폰트사이즈를 고려한 픽셀 수 
    상대적 길이는 영역이나 대상의 전체 크기에 대한 상대적 크기이다, 상대적 단위로는 %(퍼센트:1%)를 사용한다.
    auto는 브라우저의 기본 값이다.

    windth와 height에는 실제 표시되는 영역만을 나타낸다.
    width 속성은 실제 표시되는 영역의 폭 길이, widht:길이;
    height 속성은 실제 표시되는 영역의 높이, height:길이;

    padding은 위의 width와 height의 사각형과 border 사이의 공백을 말합니다.
    padding 속성 다음에는 4개 까지의 길이를 쓸수 있다.
    길이는 고정적 길이와 상대적 길이로 지정할 수 있다.
    하나의 길이만 지정하면 길이는 위,아래,왼쪽,오른쪽 모두 동일한 길이로 padding을 적용. padding:길이;
    두개의 길이를 지정하면  첫번째 길이는 위,아래의 padding 길이고, 두번째 길이는 왼쪽,오른쪽의 padding 길이다. padding:길이 길이;
    세개의 길이를 지정하면  첫번째 길이는 위 padding 길이, 두번째 길이는 왼쪽,오른쪽 padding 길이, 세번째 길이는 아래쪽 padding 길이다. padding:길이 길이 길이;
    네개의 길이를 지정하면 첫번째 길이는 위 padding 길이, 두번째 길이는 왼쪽 padding 길이, 세번째 길이는 아래쪽 padding 길이, 네번째 길이는 오른쪽 padding 길이다. padding:길이 길이 길이 길이;
    padding 속성 외에 각 방향에 따른 속성을 사용해서 지정할 수 있다.
    paddin-top속성은 위 margin의 길이를 지정한다. padding-top:길이;
    padding-bottom 속성은 아래 margin의 길이를 지정한다. padding-bottom:길이;
    padding-left 속성은 왼쪽 margin의 길이를 지정한다. padding-left:길이;
    padding-right 속성은 오른쪽 margin의 길이를 지정한다. padding-right:길이;

    margin 속성은 border와 최고 바깥의 박스와의 공백을 magin이라 했다
    margin 속성 다음에는 4개 까지 길이를 쓸수 있다.
    길이는 고정적인 길이, 상대적 길이, austo를 지정할 수 있다.
    하나의 길이만 지정하면 길이는 위,아래,왼쪽,오른쪽 모두 동일한 길이로 margin을 적용. margine:길이;
    두개의 길이를 지정하면  첫번째 길이는 위,아래의 margin 길이고, 두번째 길이는 왼쪽,오른쪽의 margin 길이다. margine:길이 길이;
    세개의 길이를 지정하면  첫번째 길이는 위 margin 길이, 두번째 길이는 왼쪽,오른쪽 margin 길이, 세번째 길이는 아래쪽 margin 길이다. margine:길이 길이 길이;
    네개의 길이를 지정하면 첫번째 길이는 위 margin 길이, 두번째 길이는 왼쪽 margin 길이, 세번째 길이는 아래쪽 margin 길이, 네번째 길이는 오른쪽 margin 길이다. margine:길이 길이 길이 길이;
    margin 속성 외에 각 방향에 따른 속성을 사용해서 지정할 수 있다.
    margin-top속성은 위 margin의 길이를 지정한다. margin-top:길이;
    margn-bottom 속성은 아래 margin의 길이를 지정한다. margin-bottom:길이;
    margin-left 속성은 왼쪽 margin의 길이를 지정한다. margin-left:길이;
    margin-right 속성은 오른쪽 margin의 길이를 지정한다. margin-right:길이;

    'CSS' 카테고리의 다른 글

    규칙  (0) 2011.09.08

    아래 이미지 처럼 ,미디어 플레이와 같은 윈도우의 모양이 사각형 모양이 아닌 폼을 많이 보셨을 겁니다.


    원래 윈도우의 처음 모양은 다 직사각형입니다. 여기에 여러 형태의 영역을 만들어, 이 영역을 윈도우 형태에 적용시켜 윈도우에 생성한 영역의 모양을 적용시키는 형태입니다. 예를 들면 원모양의 영역을 만들고 그 영역을 위의 함수 SetWindowRgn을 사용하여 윈도우에 적용시키면 됩니다. 커맨드 버튼이다,텍스트 박스나 이런것도 하나의 윈도우이므로 모양 변경은 얼마던지 가능합니다.
    아래 이미지는 텍스트 박스에 영역을 적용 시키는 이미지 입니다. 이런식으로 어떤 윈도우에도 적용 가능합니다.


    영역을 생성하는 API 함수는 여러가지가 존재하며, 두 영역의 조합해서 하나의 영역을 생성하는 함수도 있읍니다.
    Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Public Declare Function CreateEllipticRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
    Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Public Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
    Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
    이 외에도 여러지가 존재합니다. 그 부분은 MSDN을 참고 하시기 바랍니다. 위 함수들을 사용해서 영역에 대한 핸들을 구합니다.

    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    생성한 영역을 원하는 윈도우의 핸들과 함께 SetWindowRgn을  호출하시면 됩니다. 이때 해당 함수가 성공적으로 수행되면 적용된 영역과, 영역의 핸들은 삭제됩니다.

    다음은 윈도우(폼)를  원형으로 만드는 예입니다.
    Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

        Dim CircleH As Long ' 원형 영역
        
        CircleH = CreateEllipticRgn(0, 0, 103, 102) ' 원 영역 생성
        SetWindowRgn Text1.hWnd, CircleH, True ' 원을 폼에 적용

    생가보다 간단하죠, 다음에는 영역을 조합하여 가운데가 뻥뚤린 윈도우를 한번 만들어 봅시다.

    윈도우에서 이미지 파일을 클릭하면 이미지 파일과 연결된 프로그램이 실행된다.
    (탐색기의 도구 메뉴에 폴더 메뉴를 선택하면 연결된 프로그램을 볼수 있다)

    VB에서 Shell 함수로 이미지 파일을 실행 시키면 실행을 할수가 없다. VB에서 제공되는 Shell 함수는 단지 실행 파일만 실행할수가 있다. 위 그림과 같이 연결된 프로그램을 다 서술해 주어야 한다. 그러나 API 중에 ShellExecute 함수를 사용하면 단지 파일 경로만 지정해 주면 현재 지정된 파일의 확장자와 연결된 프로그램을 실행할수 있다.
    Call ShellExecute(창이 뜰경우 창의 소유자 핸들, 명령, 파일명, 인수, 작업할 디렉토리 경로, 어떤 식으로 보여줄것이냐)

    예를 들면 ShellExecute 0&, "open", App.Path & "\" & "API.BitBlt.BackgroundBlack.GIF", vbNullString, vbNullString, 0&
    위 예는 gif와 연결된 프로그램을 호출한다. 만약 open 대신 printto를 사용했다면 printto에 연결된 프로그램이 실행됩니다.
    URL도 마찬가지 입니다. 파일명 적는 부분에 대신 URL을 적으시면 됩니다. URL도 탐색기의 폴더 옵션에 보면 위 이미지와 비슷한 내용이 나타납니다. 한번씩들 찾아보시길.

    마지막 인수 내용은 다음과 같습니다.
    SW_HIDE 0 윈도우가 감추진 상태
    SW_MAXIMIZE 3 윈도우를 최대화
    SW_SHOW 5 윈도우가 보여지는 상태
    SW_SHOWNORMAL 1 윈도우의 원래 크기, 위치로 보여준다
    SW_RESTORE 9 윈도우를 윈래의 크기로 표시한다
    SW_MINIMIZE 6 윈도우를 최소화
    SW_NORMAL 1 윈도우를 보여준다.
    SW_SHOWDEFAULT 10 해당프로그램(실행파일)시작시 전달되는 StartupInfo구조체중 SW_FLAG 에따라 생성(요것땜시 참고로 엑셀 유저폼에는 최대화, 최소화버튼이 없다)
    SW_SHOWMAXIMIZED 3 최대화 상태로 활성화한다.
    SW_SHOWMINIMIZED 2 최소화상태로 활성화한다
    SW_SHOWNA 8 현재상태로 표시한다.
    SW_SHOWNOACTIVATE 4 윈도우를 최근 크기와 위치로 표시한다
    SW_SHOWMINNOACTIVE 7 최소화 상태로 윈도우를 표시하고, 활성화 상태에 있던 윈도우는 활성환된 상태로 둔다.

    + Recent posts