Changeset 688
- Timestamp:
- Mar 11, 2009, 4:56:32 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/basic/prompt.sbp
r685 r688 632 632 'Prompt graphic command functions 633 633 634 Sub Circle(x As Long , y As Long, radius As Double, ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long) 635 Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long 636 637 Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode)) 634 Sub Circle(x As Double, y As Double, radius As Double, ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long) 635 Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode)) 638 636 Dim hBrush As HBRUSH 639 637 If bFill Then … … 643 641 End If 644 642 645 Dim h DC= GetDC(_PromptSys_hWnd)646 Dim hOldPenDC = SelectObject(h DC, hPen)647 Dim hOldBrushDC = SelectObject(h DC, hBrush)643 Dim hdc = GetDC(_PromptSys_hWnd) 644 Dim hOldPenDC = SelectObject(hdc, hPen) 645 Dim hOldBrushDC = SelectObject(hdc, hBrush) 648 646 Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen) 649 647 Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush) 650 648 651 Dim radi2 As Long 652 Dim iRadius As Long 653 If Aspect<1 Then 654 radi2 = (radius * Aspect) As Long 655 iRadius = radius As Long 649 Dim yRadius As Double 650 Dim xRadius As Double 651 If Aspect = 1 Then 652 yRadius = radius 653 xRadius = radius 654 ElseIf Aspect < 1 Then 655 yRadius = radius * Aspect 656 xRadius = radius 656 657 Else 657 radi2 = radius As Long 658 iRadius = (radius / Aspect) As Long 659 End If 660 661 If StartPos=0 And EndPos=0 Then 662 Ellipse(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2) 663 Ellipse(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2) 658 yRadius = radius 659 xRadius = radius / Aspect 660 End If 661 662 Dim x1 = (x - xRadius) As Long 663 Dim x2 = (x + xRadius) As Long 664 Dim y1 = (y - yRadius) As Long 665 Dim y2 = (y + yRadius) As Long 666 667 If StartPos = 0 And EndPos = 0 Then 668 Ellipse(hdc, x1, y1, x2, y2) 669 Ellipse(_PromptSys_hMemDC, x1, y1, x2, y2) 664 670 Else 665 Dim sw As Boolean 666 StartPos *= 100 667 EndPos *= 100 668 669 If StartPos<0 Or EndPos<0 Then 670 sw = True 671 Dim isPie As Boolean 672 If StartPos < 0 Or EndPos < 0 Then 673 isPie = True 671 674 StartPos = Math.Abs(StartPos) 672 675 EndPos = Math.Abs(EndPos) 673 676 Else 674 sw= False677 isPie = False 675 678 End If 676 679 677 If StartPos<=78.5 Then 678 i1=78 679 i2=Int(StartPos) 680 ElseIf StartPos<=235.5 Then 681 StartPos -= 78.5 682 i1=78-Int(StartPos) 683 i2=78 684 ElseIf StartPos<=392.5 Then 685 StartPos -= 235.5 686 i1=-78 687 i2=78-Int(StartPos) 688 ElseIf StartPos<=549.5 Then 689 StartPos -= 392.5 690 i1=-78+Int(StartPos) 691 i2=-78 692 ElseIf StartPos<=628 Then 693 StartPos -= 549.5 694 i1=78 695 i2=-78+Int(StartPos) 680 Dim scaleRadial = (x + y) * 0.5 681 Dim startX = (x + ActiveBasic.Math.Cos(StartPos) * scaleRadial) As Long 682 Dim startY = (y - ActiveBasic.Math.Sin(StartPos) * scaleRadial) As Long 683 Dim endX = (x + ActiveBasic.Math.Cos(EndPos) * scaleRadial) As Long 684 Dim endY = (y - ActiveBasic.Math.Sin(EndPos) * scaleRadial) As Long 685 686 If isPie Then 687 Pie(hdc, x1, y1, x2, y2, startX, startY, endX, endY) 688 Pie(_PromptSys_hMemDC, x1, y1, x2, y2, startX, startY, endX, endY) 689 Else 690 Arc(hdc, x1, y1, x2, y2, startX, startY, endX, endY) 691 Arc(_PromptSys_hMemDC, x1, y1, x2, y2, startX, startY, endX, endY) 696 692 End If 697 698 If EndPos<=78.5 Then 699 i3=78 700 i4=Int(EndPos) 701 ElseIf EndPos<=235.5 Then 702 EndPos -= 78.5 703 i3=78-Int(EndPos) 704 i4=78 705 ElseIf EndPos<=392.5 Then 706 EndPos -= 235.5 707 i3=-78 708 i4=78-Int(EndPos) 709 ElseIf EndPos<=549.5 Then 710 EndPos -= 392.5 711 i3=-78+Int(EndPos) 712 i4=-78 713 ElseIf EndPos<=628 Then 714 EndPos -= 549.5 715 i3=78 716 i4=-78+Int(EndPos) 717 End If 718 719 If sw Then 720 Pie(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4) 721 Pie(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4) 722 Else 723 Arc(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4) 724 Arc(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4) 725 End If 726 End If 727 728 SelectObject(hDC, hOldPenDC) 729 SelectObject(hDC, hOldBrushDC) 730 ReleaseDC(_PromptSys_hWnd, hDC) 693 End If 694 695 SelectObject(hdc, hOldPenDC) 696 SelectObject(hdc, hOldBrushDC) 697 ReleaseDC(_PromptSys_hWnd, hdc) 731 698 SelectObject(_PromptSys_hMemDC, hOldPen) 732 699 SelectObject(_PromptSys_hMemDC, hOldBrush) … … 912 879 '呼び出し方法は以下のようになります(コンパイラがパラメータの並びを最適化します) 913 880 'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2] 914 ActiveBasic.Prompt.Detail.Circle(x As Long, y As Long, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)881 ActiveBasic.Prompt.Detail.Circle(x, y, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor) 915 882 End Macro 916 883
Note:
See TracChangeset
for help on using the changeset viewer.