http://synapsoft.co.kr/jsp/recruit/14t.html
사다리타기와 관련한 사이냅소프트 입사 문제 샘플이라고 합니다.
https://slipp.net/wiki/pages/viewpage.action?pageId=19530034
또 여기에서 스터디 주제이기도 합니다.
사다리타기 게임을 파워포인트와 VBA를 이용해 구현해보려 합니다.
먼저 샘플과 같은 사다리가 주어졌을 때 한칸씩 내려오는 처리부터 시작하려고 샘플을 만들어 보았습니다.
단, 여기서는 가로줄이 연속으로 있지 않고 반듯한 가로줄인 경우에 한정하여 사다리게임을 구현합니다.
사다리를 2차원 배열로 선언합니다.
SDR(6,11) 정도로 선언하고 모든 값을 0으로 초기화 시킵니다.
고맙게도 Redim 명령은 변수를 초기화 시켜줍니다.
세로줄은 SDR(1), SDR(2),,,,,SDR(5), SDR(6)로 대응됩니다.
그리고 가로줄이 있으면 SDR(1,1) =1 이런식으로 표시를 해줍니다.
초기화를 식으로 나타내면
Sub sample_SDR()
'initialize sadari(ladder)
ReDim SDR(0 To MAXCOL, 0 To MAXROW)
SDR(1, 1) = 1
SDR(1, 6) = 1
SDR(1, 9) = 1
'SDR(2, 1) = 1 ' ?? 가로줄이 연속인 경우는 제외
SDR(2, 3) = 1
SDR(2, 5) = 1
SDR(2, 8) = 1
SDR(3, 4) = 1
SDR(3, 7) = 1
SDR(3, 10) = 1
SDR(4, 2) = 1
SDR(4, 6) = 1
SDR(4, 8) = 1
SDR(5, 3) = 1
SDR(5, 5) = 1
SDR(5, 7) = 1
End Sub
2) SDR(i, j) 에 들어 있는 값이 만약 1이라면 , 오른쪽 줄로로 갑니다.
실제 ppt 슬라이드에서 라인 그리는 것은 일단 AddLine 으로 하되 Style은 Dot 스타일로 점선으로 그리고 나서
사다리 번호를 눌렀을 때는 Style 을 다시 Solid로 바꿔주기만 하면 그려주는 효과가 나옵니다.
그리고 다른 사다리 번호를 누르면 다시 모두 점선으로 바꾸고 그 줄을 따라서만 Solid 로 바꿔줍니다.
나머지는 첨부한 예제 pptm 과 소스를 참고하세요.
허접한 소스이지만 명시된 부분을 제외하고 저작권은 저에게 있습니다.
copyright (c) konahn 2016
' SADARI(Ladder), a sample game to choose the victim
' Developed and tested under MS Office™ 2010
' by konahn@naver.com 2016
'
Public Declare ptrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Public MAXCOL As Integer
Const MAXCOL = 6
Const MIN = 3
Const MAX = 8 ' max count of people
Const DEFAULT_SLIDE = 2 'the default slide to show the ladder on
Const MAXROW = 10 '
Const MAXRND = 4 ' max count of random ladder row
Const MARGIN = 100 'boundary margin
Dim txtFile As String
Dim SDR() As Integer
Sub sample_SDR()
'initialize sadari(ladder)
ReDim SDR(0 To MAXCOL, 0 To MAXROW)
SDR(1, 1) = 1
SDR(1, 6) = 1
SDR(1, 9) = 1
'SDR(2, 1) = 1 '??
SDR(2, 3) = 1
SDR(2, 5) = 1
SDR(2, 8) = 1
SDR(3, 4) = 1
SDR(3, 7) = 1
SDR(3, 10) = 1
SDR(4, 2) = 1
SDR(4, 6) = 1
SDR(4, 8) = 1
SDR(5, 3) = 1
SDR(5, 5) = 1
SDR(5, 7) = 1
End Sub
Sub go()
Dim i, j, r As Integer
Dim w, h As Integer
Dim lineNo, linePay, myLineV, myLineH As Shape
Dim length As Integer
Dim pay As String
Dim temp(), prevRnd(MAXRND) As Integer 'temporary array for random number
Dim myLayout As CustomLayout
Dim mySlide As Slide
'Initialize sample SDR array
sample_SDR
Randomize
' delete Slides after #1, if any.
If ActivePresentation.Slides.count >= DEFAULT_SLIDE Then
For i = ActivePresentation.Slides.count To DEFAULT_SLIDE Step -1
ActivePresentation.Slides(i).Delete
Next
End If
' Add slide at the end
Set myLayout = ActivePresentation.Slides(1).CustomLayout
Set mySlide = ActivePresentation.Slides.AddSlide(DEFAULT_SLIDE, myLayout)
'get line width & height
lineW = (ActivePresentation.PageSetup.SlideWidth - 2 * MARGIN) / (MAXCOL - 1)
lineH = (ActivePresentation.PageSetup.SlideHeight - 2 * MARGIN) / (MAXROW)
'draw lines
For i = 1 To MAXCOL
'top title, person no
Set lineNo = ActivePresentation.Slides(DEFAULT_SLIDE).Shapes.AddTextbox(msoTextOrientationHorizontal, _
MARGIN + (i - 1) * lineW - 20, 20, 50, 40)
With lineNo
.Name = "lineNo" & i
.TextFrame.TextRange.Characters.Text = i
.TextFrame.TextRange.Font.Color.RGB = RGB(250, 250, 250) 'RGB(150, 250, 150)
.TextFrame2.TextRange.Font.Size = 50
.TextFrame2.TextRange.Font.Bold = msoTrue
.TextFrame2.TextRange.Font.Shadow.Visible = msoTrue
.ActionSettings(ppMouseClick).Action = ppActionRunMacro
.ActionSettings(ppMouseClick).Run = "on_Click"
End With
For j = 0 To MAXROW
With ActivePresentation.Slides(DEFAULT_SLIDE)
'draw vertical lines
Set myLineV = .Shapes.AddLine(MARGIN + (i - 1) * lineW, MARGIN + j * lineH, _
MARGIN + (i - 1) * lineW, MARGIN + (j + 1) * lineH)
'set line property
With myLineV
.Name = "lineV" & i & j
.Line.ForeColor.RGB = RGB(150, 150, 230)
.Line.DashStyle = msoLineRoundDot
.Line.DashStyle = msoLineSysDot
.Line.Style = msoLineSingle
.Line.Weight = 3
End With
'draw horizontal lines
If SDR(i, j) = 1 Then
Set myLineH = .Shapes.AddLine(MARGIN + (i - 1) * lineW, MARGIN + j * lineH, _
MARGIN + (i) * lineW, MARGIN + j * lineH)
'set line property
With myLineH
.Name = "lineH" & i & j
.Line.ForeColor.RGB = RGB(150, 150, 230)
.Line.DashStyle = msoLineRoundDot
.Line.DashStyle = msoLineSysDot
.Line.Style = msoLineSingle
.Line.Weight = 3
End With
End If
End With
Next j
'bottom title, prize or penalty
Set linePay = ActivePresentation.Slides(DEFAULT_SLIDE).Shapes.AddTextbox(msoTextOrientationHorizontal, _
MARGIN + (i - 1) * lineW - 20, MARGIN + lineH * (MAXROW + 1), 100, 40)
With linePay
.Name = "linePay" & i
.TextFrame.TextRange.Characters.Text = i
.TextFrame.TextRange.Font.Color.RGB = RGB(47, 125, 253)
.TextFrame2.TextRange.Font.Size = 50
.TextFrame2.TextRange.Font.Bold = msoTrue
.TextFrame2.TextRange.Font.Shadow.Visible = msoTrue
.TextFrame2.AutoSize = msoAutoSizeTextToFitShape 'make the text fit the textbox
End With
Next i
ActivePresentation.SlideShowWindow.View.GotoSlide (DEFAULT_SLIDE)
End Sub
'when the line no is clicked, draw/show one of the ladder line
Sub on_click(myShape As Shape)
Dim no As Integer
Dim curLine, j As Integer
Dim lineV, lineH As Shape
no = Mid(myShape.Name, 7, 1) 'LineNo1,2,3,4~
curLine = no
With ActivePresentation.Slides(DEFAULT_SLIDE)
'erase all lines, set the line styles back to original
For Each lineV In .Shapes
If Left(lineV.Name, 5) = "lineV" Or Left(lineV.Name, 5) = "lineH" Then
lineV.Line.ForeColor.RGB = RGB(150, 150, 230)
lineV.Line.DashStyle = msoLineRoundDot
lineV.Line.DashStyle = msoLineSysDot
lineV.Line.Style = msoLineSingle
lineV.Line.Weight = 3
End If
Next lineV
'draw(set) a ladder line for the #no line
For j = 0 To MAXROW
' if there's a hozontal line on the right
'On Error Resume Next
If SDR(curLine, j) = 1 Then
Set lineH = .Shapes("lineH" & curLine & j)
lineH.Line.ForeColor.RGB = RGB(230, 150, 150)
lineH.Line.DashStyle = msoLineSolid
lineH.Line.Style = msoLineSingle
lineH.Line.Weight = 5
curLine = curLine + 1 ' move to the right
' if there's a hozontal line on the left
ElseIf curLine > 1 Then
If SDR(curLine - 1, j) = 1 Then
curLine = curLine - 1 ' move to the left
Set lineH = .Shapes("lineH" & curLine & j)
lineH.Line.ForeColor.RGB = RGB(230, 150, 150)
lineH.Line.DashStyle = msoLineSolid
lineH.Line.Style = msoLineSingle
lineH.Line.Weight = 5
End If
End If
' draw vertical line
Set lineV = .Shapes("lineV" & curLine & j)
lineV.Line.ForeColor.RGB = RGB(230, 150, 150)
lineV.Line.DashStyle = msoLineSolid
lineV.Line.Style = msoLineSingle
lineV.Line.Weight = 5
Next j
End With
End Sub
Sub NameShape(myS As Shape)
'give a name to the clicked shaped. Give them easier names rather than difficult "corner rounded rectangle 2"
Dim Name$
On Error GoTo AbortNameShape
Name$ = myS.Name
Name$ = InputBox$("Give this shape a name", "Shape Name", Name$)
If Name$ <> "" Then
myS.Name = Name$
End If
Exit Sub
AbortNameShape:
MsgBox err.Description
End Sub
Sadari_sample.pptmPowerpoint 2010 에서 제작되었습니다.
매크로 사용를 허가해주셔야 합니다.
다음에는 사다리 가로줄을 랜덤함수로 초기화 하여 제대로 작동하는 버전을 올리겠습니다.
참가인원수도 조절할 수 있고
당첨된 액수나 벌칙도 입력할 수 있도록 할 것입니다.
'PPT GAME' 카테고리의 다른 글
| Pick Me 선택 게임 (15) | 2020.05.26 |
|---|---|
| 고전게임 갤러그 유형 적탄 피하기 데모판 (0) | 2017.01.12 |
| Color Confusion (0) | 2017.01.12 |
| (Color Quiz) 색깔 퀴즈 (2) | 2017.01.12 |
| Matching Words: 짝 맞추기(짝 찾기, 기억력) 게임 (9) | 2016.11.15 |
| HotSeat 스피드 퀴즈 (10) | 2016.09.13 |
| ppt 사다리타기 2 (6) | 2016.06.14 |
| Hidden Picture (1) | 2016.05.19 |
최근댓글