Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fg / fgdraw.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1994-11-03 | 88.3 KB | 2,656 lines

VERSION 2.00 Begin Form frmFGDrawDemo BackColor = &H00C0C0C0& Caption = "FG Draw Demo" ClientHeight = 6000 ClientLeft = 630 ClientTop = 1425 ClientWidth = 8445 Height = 6690 HelpContextID = 1 Icon = FGDRAW.FRX:0000 Left = 570 LinkTopic = "Form1" ScaleHeight = 400 ScaleMode = 3 'Pixel ScaleWidth = 563 Top = 795 Width = 8565 Begin SSPanel pnlAttribBar BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 2 Font3D = 0 'None Height = 1050 HelpContextID = 14 Left = -15 TabIndex = 8 Top = 4830 Width = 8415 Begin CommonDialog CMDialog1 Prop12 = "" Prop27 = "" Prop28 = FGDRAW.FRX:0302 Action = 0 'Nothing CancelError = 0 'False Color = &H00000000& Copies = 0 DefaultExt = "" DialogTitle = "" Filename = "" Filetitle = "" Filter = "" FilterIndex = 0 Flags = 0 FontBold = 0 'False FontItalic = 0 'False FontName = "" FontSize = 8 FontStrikeThru = 0 'False FontUnderLine = 0 'False FromPage = 0 HelpCommand = 0 HelpContext = 0 HelpFile = "" HelpKey = "" InitDir = "" Max = 0 MaxFileSize = 256 Min = 0 PrinterDefault = -1 'True ToPage = 0 End Begin PictureBox picColorBtns BackColor = &H00C0C0C0& BorderStyle = 0 'None ClipControls = 0 'False Height = 930 HelpContextID = 15 Left = 4290 ScaleHeight = 62 ScaleMode = 3 'Pixel ScaleWidth = 186 TabIndex = 18 Tag = "TT:[Select a Color (DblClick to Edit)]" Top = 60 Width = 2790 Begin FG FG2 Height = 420 Left = 30 Top = 315 Width = 420 End End Begin CommandButton cmdSelectFont BackColor = &H00C0C0C0& Caption = "Font" FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 315 HelpContextID = 17 Left = 2655 TabIndex = 17 Tag = "TT:[Set Font Attributes]" Top = 600 Width = 975 End Begin SSPanel Panel3D4 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 1 Font3D = 0 'None Height = 480 HelpContextID = 18 Left = 2655 TabIndex = 16 Top = 75 Width = 1005 Begin SSRibbon grbTransparent BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False GroupNumber = 7 Height = 390 HelpContextID = 19 Left = 495 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:030A RoundedCorners = 0 'False Tag = "TT:[Transparent]" Top = 45 Value = -1 'True Width = 465 End Begin SSRibbon grbOpaque BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False GroupNumber = 7 Height = 390 HelpContextID = 20 Left = 45 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:04C4 RoundedCorners = 0 'False Tag = "TT:[Opaque]" Top = 45 Width = 465 End End Begin SSPanel Panel3D3 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 1 Font3D = 0 'None Height = 900 HelpContextID = 21 Left = 1755 MousePointer = 10 'Up Arrow TabIndex = 15 Tag = "TT:[Select a Fill Style]" Top = 75 Width = 885 Begin Shape Shape4 BorderColor = &H00000000& BorderStyle = 0 'Transparent DrawMode = 10 'Not Xor Pen FillStyle = 0 'Solid Height = 255 Left = 60 Top = 315 Width = 255 End Begin Shape Shape3 FillStyle = 7 'Diagonal Cross Height = 225 Index = 7 Left = 585 Top = 330 Width = 225 End Begin Shape Shape3 FillStyle = 6 'Cross Height = 225 Index = 6 Left = 585 Top = 75 Width = 225 End Begin Shape Shape3 FillStyle = 5 'Downward Diagonal Height = 225 Index = 5 Left = 330 Top = 585 Width = 225 End Begin Shape Shape3 FillStyle = 4 'Upward Diagonal Height = 225 Index = 4 Left = 330 Top = 330 Width = 225 End Begin Shape Shape3 FillStyle = 3 'Vertical Line Height = 225 Index = 3 Left = 330 Top = 75 Width = 225 End Begin Shape Shape3 FillStyle = 2 'Horizontal Line Height = 225 Index = 2 Left = 75 Top = 585 Width = 225 End Begin Shape Shape3 Height = 225 Index = 1 Left = 75 Top = 330 Width = 225 End Begin Shape Shape3 FillStyle = 0 'Solid Height = 225 Index = 0 Left = 75 Top = 75 Width = 225 End End Begin SSPanel Panel3D2 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 1 Font3D = 0 'None Height = 900 HelpContextID = 22 Left = 1005 MousePointer = 10 'Up Arrow TabIndex = 14 Tag = "TT:[Select a Border Width]" Top = 75 Width = 735 Begin TextBox txtBorderWidth Height = 285 HelpContextID = 23 Left = 195 MousePointer = 3 'I-Beam TabIndex = 19 Text = "32" Top = 555 Width = 465 End Begin Line Line2 BorderWidth = 8 Index = 5 X1 = 270 X2 = 600 Y1 = 660 Y2 = 660 End Begin Shape Shape2 FillStyle = 0 'Solid Height = 60 Left = 60 Shape = 3 'Circle Top = 90 Width = 60 End Begin Line Line2 Index = 1 X1 = 270 X2 = 600 Y1 = 165 Y2 = 165 End Begin Line Line2 BorderWidth = 2 Index = 2 X1 = 270 X2 = 600 Y1 = 240 Y2 = 240 End Begin Line Line2 BorderWidth = 4 Index = 3 X1 = 270 X2 = 600 Y1 = 330 Y2 = 330 End Begin Line Line2 BorderWidth = 8 Index = 4 X1 = 270 X2 = 600 Y1 = 450 Y2 = 450 End Begin Line Line2 BorderColor = &H00000000& Index = 0 X1 = 270 X2 = 600 Y1 = 90 Y2 = 90 End End Begin SSPanel Panel3D1 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 1 Font3D = 0 'None Height = 900 HelpContextID = 24 Left = 75 MousePointer = 10 'Up Arrow TabIndex = 13 Tag = "TT:[Select Bordere Style]" Top = 75 Width = 915 Begin Line Line1 BorderColor = &H00000000& Index = 0 Tag = "TT:[Solid Line]" X1 = 240 X2 = 840 Y1 = 120 Y2 = 120 End Begin Line Line1 BorderStyle = 6 'Inside Solid Index = 6 X1 = 240 X2 = 840 Y1 = 750 Y2 = 750 End Begin Line Line1 BorderColor = &H00808080& Index = 5 X1 = 240 X2 = 840 Y1 = 645 Y2 = 645 End Begin Line Line1 BorderStyle = 5 'Dash-Dot-Dot Index = 4 X1 = 240 X2 = 840 Y1 = 540 Y2 = 540 End Begin Line Line1 BorderStyle = 4 'Dash-Dot Index = 3 X1 = 240 X2 = 840 Y1 = 435 Y2 = 435 End Begin Line Line1 BorderStyle = 3 'Dot Index = 2 X1 = 240 X2 = 840 Y1 = 330 Y2 = 330 End Begin Line Line1 BorderStyle = 2 'Dash Index = 1 X1 = 240 X2 = 840 Y1 = 225 Y2 = 225 End Begin Shape Shape1 FillStyle = 0 'Solid Height = 60 Left = 105 Shape = 3 'Circle Top = 105 Width = 60 End End Begin Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Back" Height = 180 Index = 3 Left = 3630 TabIndex = 12 Top = 765 Width = 660 End Begin Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Font" Height = 180 Index = 2 Left = 3630 TabIndex = 11 Top = 555 Width = 660 End Begin Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Fill" Height = 180 Index = 1 Left = 3645 TabIndex = 10 Top = 300 Width = 630 End Begin Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Border" Height = 180 Index = 0 Left = 3645 TabIndex = 9 Top = 75 Width = 645 End End Begin PictureBox picDrawSpace BackColor = &H00FFFFFF& ClipControls = 0 'False FillColor = &H000000FF& FillStyle = 0 'Solid FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 78 FontStrikethru = -1 'True FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 4665 HelpContextID = 25 Left = 1605 ScaleHeight = 309 ScaleMode = 3 'Pixel ScaleWidth = 439 TabIndex = 2 Top = 60 Width = 6615 Begin FG FG1 Height = 420 Left = 120 Top = 120 Width = 420 End End Begin PictureBox picButtonBarBorder Align = 2 'Align Bottom Height = 15 HelpContextID = 27 Left = 0 ScaleHeight = 0 ScaleWidth = 8415 TabIndex = 1 Top = 5985 Width = 8445 End Begin SSPanel pnlButtonBar BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 2 Font3D = 0 'None Height = 4770 HelpContextID = 28 Left = 0 TabIndex = 0 Top = 15 Width = 1395 Begin SSCommand cmdDeleteGraphic Caption = "-" Font3D = 0 'None FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 19.5 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 330 HelpContextID = 29 Left = 1005 Picture = FGDRAW.FRX:067E RoundedCorners = 0 'False TabIndex = 28 Tag = "TT:[Zoom OUt]" Top = 60 Width = 330 End Begin SSCommand cmdPageDown Font3D = 0 'None Height = 330 HelpContextID = 30 Left = 540 Picture = FGDRAW.FRX:0778 RoundedCorners = 0 'False TabIndex = 27 Top = 4110 Width = 330 End Begin SSCommand cmdStepDown Font3D = 0 'None Height = 330 HelpContextID = 31 Left = 540 Picture = FGDRAW.FRX:0872 RoundedCorners = 0 'False TabIndex = 26 Top = 3795 Width = 330 End Begin SSCommand cmdPageRight Font3D = 0 'None Height = 330 HelpContextID = 32 Left = 1005 Picture = FGDRAW.FRX:096C RoundedCorners = 0 'False TabIndex = 25 Top = 3480 Width = 330 End Begin SSCommand cmdStepRight Font3D = 0 'None Height = 330 HelpContextID = 33 Left = 690 Picture = FGDRAW.FRX:0A66 RoundedCorners = 0 'False TabIndex = 24 Top = 3480 Width = 330 End Begin SSCommand cmdStepLeft Font3D = 0 'None Height = 330 HelpContextID = 34 Left = 375 Picture = FGDRAW.FRX:0B60 RoundedCorners = 0 'False TabIndex = 23 Top = 3480 Width = 330 End Begin SSCommand cmdStepUp Font3D = 0 'None Height = 330 HelpContextID = 35 Left = 540 Picture = FGDRAW.FRX:0C5A RoundedCorners = 0 'False TabIndex = 22 Top = 3165 Width = 330 End Begin SSCommand cmdPageUp Font3D = 0 'None Height = 330 HelpContextID = 36 Left = 540 Picture = FGDRAW.FRX:0D54 RoundedCorners = 0 'False TabIndex = 21 Top = 2850 Width = 330 End Begin SSCommand cmdPageLeft Font3D = 0 'None Height = 330 HelpContextID = 37 Left = 60 Picture = FGDRAW.FRX:0E4E RoundedCorners = 0 'False TabIndex = 20 Top = 3480 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 8 Left = 1005 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:0F48 RoundedCorners = 0 'False Tag = "TT:[Polyline]" Top = 795 Width = 330 End Begin SSCheck chkKeepAspectRatio Font3D = 0 'None Height = 255 HelpContextID = 39 Left = 105 TabIndex = 7 Top = 1935 Value = -1 'True Width = 240 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 15 Left = 690 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1042 RoundedCorners = 0 'False Tag = "TT:[Zoom In]" Top = 1425 Width = 330 End Begin SSCommand cdmZoomOut Caption = "-" Font3D = 0 'None FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 19.5 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 330 HelpContextID = 40 Left = 1005 RoundedCorners = 0 'False TabIndex = 5 Tag = "TT:[Zoom OUt]" Top = 1425 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 14 Left = 375 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:113C RoundedCorners = 0 'False Tag = "TT:[Free Hand Draw]" Top = 1425 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 13 Left = 60 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1236 RoundedCorners = 0 'False Tag = "TT:[TextOut" Top = 1425 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 12 Left = 1005 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1330 RoundedCorners = 0 'False Tag = "TT:[RoundRect]" Top = 1110 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 11 Left = 690 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:142A RoundedCorners = 0 'False Tag = "TT:[Rectangle]" Top = 1110 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 10 Left = 375 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1524 RoundedCorners = 0 'False Tag = "TT:[PolyTextOut]" Top = 1110 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 9 Left = 60 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:161E RoundedCorners = 0 'False Tag = "TT:[PolyPolygon]" Top = 1110 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 7 Left = 690 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1718 RoundedCorners = 0 'False Tag = "TT:[Pie]" Top = 795 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 6 Left = 375 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1812 RoundedCorners = 0 'False Tag = "TT:[Polygon]" Top = 795 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 5 Left = 60 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:190C RoundedCorners = 0 'False Tag = "TT:[Line]" Top = 795 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 4 Left = 1005 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1A06 RoundedCorners = 0 'False Tag = "TT:[Ellipse]" Top = 480 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 3 Left = 690 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1B00 RoundedCorners = 0 'False Tag = "TT:[Draw Text]" Top = 480 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 0 Left = 60 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1BFA RoundedCorners = 0 'False Tag = "TT:[Selection]" Top = 60 Value = -1 'True Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 2 Left = 375 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1CF4 RoundedCorners = 0 'False Tag = "TT:[Chord]" Top = 480 Width = 330 End Begin SSRibbon grbDrawTool BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 330 HelpContextID = 38 Index = 1 Left = 60 PictureDnChange = 1 'Dither 'PictureUp' Bitmap PictureUp = FGDRAW.FRX:1DEE RoundedCorners = 0 'False Tag = "TT:[Arc" Top = 480 Width = 330 End Begin Label Label1 BackStyle = 0 'Transparent Caption = "Keep Zoom Aspect Ratio" Height = 615 Left = 345 TabIndex = 6 Top = 1800 Width = 975 End Begin Label lblYPos BackStyle = 0 'Transparent Height = 270 Left = 90 TabIndex = 4 Top = 2565 Width = 1215 End Begin Label lblXPos BackStyle = 0 'Transparent Height = 240 Left = 75 TabIndex = 3 Top = 2370 Width = 1245 End End Begin Menu mu_File Caption = "&File" HelpContextID = 41 Begin Menu mu_ClearAll Caption = "&New" HelpContextID = 42 End Begin Menu mu_Print Caption = "&Print" End Begin Menu mu_Sep Caption = "-" End Begin Menu mu_Exit Caption = "E&xit" HelpContextID = 43 End End Begin Menu mu_DrawingTool Caption = "&Drawing Tool" HelpContextID = 44 Begin Menu mu_Tool Caption = "&Arrow" Checked = -1 'True HelpContextID = 45 Index = 0 End Begin Menu mu_Tool Caption = "&Arc" HelpContextID = 45 Index = 1 End Begin Menu mu_Tool Caption = "&Chord" HelpContextID = 45 Index = 2 End Begin Menu mu_Tool Caption = "&Draw Text" HelpContextID = 45 Index = 3 End Begin Menu mu_Tool Caption = "&Ellipse" HelpContextID = 45 Index = 4 End Begin Menu mu_Tool Caption = "&Line" HelpContextID = 45 Index = 5 End Begin Menu mu_Tool Caption = "&Polygon" HelpContextID = 45 Index = 6 End Begin Menu mu_Tool Caption = "&Pie" HelpContextID = 45 Index = 7 End Begin Menu mu_Tool Caption = "&Polyline" HelpContextID = 45 Index = 8 End Begin Menu mu_Tool Caption = "&PolyPolygon" HelpContextID = 45 Index = 9 End Begin Menu mu_Tool Caption = "&PolyTextOut" HelpContextID = 45 Index = 10 End Begin Menu mu_Tool Caption = "&Rectangle" HelpContextID = 45 Index = 11 End Begin Menu mu_Tool Caption = "&Round Rectangle" HelpContextID = 45 Index = 12 End Begin Menu mu_Tool Caption = "&Text out" HelpContextID = 45 Index = 13 End Begin Menu mu_Tool Caption = "&Free Hand Draw" HelpContextID = 45 Index = 14 End Begin Menu mu_Tool Caption = "&Zoom in" HelpContextID = 45 Index = 15 End Begin Menu mu_ZoomOut Caption = "&Zoom out" HelpContextID = 46 End Begin Menu mu_Delete Caption = "&Delete" Index = 16 End End Begin Menu mu_View Caption = "&View" HelpContextID = 47 Begin Menu mu_ButtonBar Caption = "&ButtonBar" Checked = -1 'True HelpContextID = 48 End Begin Menu mu_AttribBar Caption = "&Attrib Bar" Checked = -1 'True HelpContextID = 49 End Begin Menu mu_ViewTips Caption = "View &Tips" Checked = -1 'True Enabled = 0 'False HelpContextID = 50 Visible = 0 'False End Begin Menu mu_ViewPicture Caption = "&View Picture" HelpContextID = 51 Visible = 0 'False End End Begin Menu mu_Help Caption = "&Help" HelpContextID = 52 Begin Menu mu_Contents Caption = "&Contents" HelpContextID = 53 Shortcut = {F1} Visible = 0 'False End Begin Menu mu_HelpHelp Caption = "&How to use Help" HelpContextID = 54 Visible = 0 'False End Begin Menu mu_Sep1 Caption = "-" HelpContextID = 55 Visible = 0 'False End Begin Menu mu_About Caption = "&About" HelpContextID = 56 End End Option Explicit Dim CurrTool As Integer Dim CurrGraphic As Long Const MAX_GRAPHICS = 10000 Const NUM_COLORS = 24 Dim AllColors(NUM_COLORS, 3) As Long Dim ColorSelect(3) As Long Dim ColorSelectIdx(3) As Integer Dim ColorRow As Integer Dim GraphicHandles(MAX_GRAPHICS) As Long Dim GraphicTypes(MAX_GRAPHICS) As Integer Dim MaxHandle As Integer Dim NumPoints As Integer Dim CurrPoint As Integer Dim initx As Double Dim inity As Double Dim CurrBorderWidth As Integer Dim CurrBorderStyle As Integer Dim CurrBorderColor Dim CurrFIllStyle As Integer Dim CurrFillColor Dim CurrFontHeight As Integer Dim CurrFontWidth As Integer Dim CurrFontEscapement As Integer Dim CurrFontOrientation As Integer Dim CurrFontBold As Integer Dim CurrFontItalic As Integer Dim CurrFontUnderline As Integer Dim CurrFontStrikeOut As Integer Dim CurrFontFaceName As String Dim CurrFontColor Dim CurrBackColor Dim CurrBackStyle As Integer Dim CurrVisible As Integer Dim MarkPicture As Long Dim MarkObjectIdx As Integer Dim MarkPolyPolygon As Long Dim MarkStartIdx As Long Dim MarkEndIdx As Long Dim MarkPoints() As PointAPI Dim MarkCount() As Integer Dim MarkPointIdx As Integer Dim EditDrag As Integer Dim CanSetAttribs As Integer Dim CanScroll As Integer Dim PolyPolygonCountIdx As Integer Dim PolyCountStartIdx As Integer Sub AddPrinterPage () Dim dummy As Long Dim X1 As Double Dim Y1 As Double Dim X2 As Double Dim Y2 As Double Dim S1 As Double Dim S2 As Double 'picDrawSpace.BackColor = QBColor(8) Printer.ScaleMode = 3 X1 = Printer.ScaleLeft Y1 = Printer.ScaleTop X2 = X1 + Printer.ScaleWidth Y2 = Y1 + Printer.ScaleHeight dummy = SCReateRectangle(FG1, X1, Y1, X2, Y2) SetFillStyle dummy, FS_SOLID SetFillColor dummy, QBColor(15) SetBorderStyle dummy, BS_SOLID SetBorderColor dummy, QBColor(7) S1 = (X2 - X1) / picDrawSpace.ScaleWidth S2 = (Y2 - Y1) / picDrawSpace.ScaleHeight If S2 > S1 Then S1 = S2 SetPlacement FG1, 0, 0, (X2 - X1) / S1, (Y2 - Y1) / S1 SetScale FG1, X1, Y1, X2, Y2 End Sub Sub CancelMark () If MarkPicture = -1 Then Exit Sub End If If GetVisible(MarkPicture) Then DoPaint MarkPicture SetVisible MarkPicture, False MarkObjectIdx = -1 RemoveObject MarkPicture, picDrawSpace.hDC, 0, True, QBColor(0) MarkPicture = -1 End If End Sub Sub cdmZoomOut_Click () Dim TD1 As Double Dim TD2 As Double Dim ThePicHandle As Long ThePicHandle = FG1 CancelMark TD1 = SGetX(ThePicHandle, 3) TD2 = SGetX(ThePicHandle, 4) SSetX FG1, 3, TD1 - TD2 / 2# SSetX FG1, 4, TD2 * 2# TD1 = SGetY(ThePicHandle, 3) TD2 = SGetY(ThePicHandle, 4) SSetY FG1, 3, TD1 - TD2 / 2# SSetY FG1, 4, TD2 * 2# picDrawSpace.Refresh End Sub Sub cmdDeleteGraphic_Click () Dim i As Integer Dim DeleteHandle As Long If (MarkObjectIdx >= 0) And CanSetAttribs Then ' Remeber the object handle DeleteHandle = GraphicHandles(MarkObjectIdx) ' Move all of the objets down one For i = MarkObjectIdx To MaxHandle - 2 GraphicHandles(i) = GraphicHandles(i + 1) GraphicTypes(i) = GraphicTypes(i + 1) Next i CancelMark MaxHandle = MaxHandle - 1 RemoveObject DeleteHandle, picDrawSpace.hDC, 1, True, picDrawSpace.BackColor End If End Sub Sub cmdPageDown_Click () Dim SHeight As Double Dim NewY As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewY = SGetY(ThePicHandle, 3) SHeight = SGetY(ThePicHandle, 4) SSetY FG1, 3, NewY + SHeight / 3 picDrawSpace.Refresh End Sub Sub cmdPageDown_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdPageDown = True Wend End Sub Sub cmdPageDown_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdPageLeft_Click () Dim SWidth As Double Dim NewX As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewX = SGetX(ThePicHandle, 3) SWidth = SGetX(ThePicHandle, 4) SSetX FG1, 3, NewX - SWidth / 3 picDrawSpace.Refresh End Sub Sub cmdPageLeft_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdPageLeft = True Wend End Sub Sub cmdPageLeft_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdPageRight_Click () Dim SWidth As Double Dim NewX As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewX = SGetX(ThePicHandle, 3) SWidth = SGetX(ThePicHandle, 4) SSetX FG1, 3, NewX + SWidth / 3 picDrawSpace.Refresh End Sub Sub cmdPageRight_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdPageRight = True Wend End Sub Sub cmdPageRight_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdPageUp_Click () Dim SHeight As Double Dim NewY As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewY = SGetY(ThePicHandle, 3) SHeight = SGetY(ThePicHandle, 4) SSetY FG1, 3, NewY - SHeight / 3 picDrawSpace.Refresh End Sub Sub cmdPageUp_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdPageUp = True Wend End Sub Sub cmdPageUp_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdSelectFont_Click () CMDialog1.FontName = CurrFontFaceName CMDialog1.FontBold = CurrFontBold CMDialog1.FontItalic = CurrFontItalic CMDialog1.FontSize = -CurrFontHeight CMDialog1.FontStrikeThru = CurrFontStrikeOut CMDialog1.FontUnderLine = CurrFontUnderline CMDialog1.Flags = CF_BOTH Or CF_EFFECTS Or CF_APPLY 'CMDialog1.Color = TheFontColor CMDialog1.Action = 4 CurrFontFaceName = CMDialog1.FontName CurrFontBold = CMDialog1.FontBold CurrFontItalic = CMDialog1.FontItalic CurrFontHeight = -CMDialog1.FontSize CurrFontStrikeOut = CMDialog1.FontStrikeThru CurrFontUnderline = CMDialog1.FontUnderLine SetMarkAttribs End Sub Sub cmdStepDown_Click () Dim SHeight As Double Dim NewY As Double Dim PHeight As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewY = SGetY(ThePicHandle, 3) SHeight = SGetY(ThePicHandle, 4) PHeight = SGetY(ThePicHandle, 2) SSetY FG1, 3, NewY + SHeight / PHeight picDrawSpace.Refresh End Sub Sub cmdStepDown_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdStepDown = True Wend End Sub Sub cmdStepDown_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdStepLeft_Click () Dim SWidth As Double Dim NewX As Double Dim PWidth As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewX = SGetX(ThePicHandle, 3) SWidth = SGetX(ThePicHandle, 4) PWidth = SGetX(ThePicHandle, 2) SSetX FG1, 3, NewX - SWidth / PWidth picDrawSpace.Refresh End Sub Sub cmdStepLeft_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdStepLeft = True Wend End Sub Sub cmdStepLeft_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdStepRight_Click () Dim SWidth As Double Dim NewX As Double Dim PWidth As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewX = SGetX(ThePicHandle, 3) SWidth = SGetX(ThePicHandle, 4) PWidth = SGetX(ThePicHandle, 2) SSetX FG1, 3, NewX + SWidth / PWidth picDrawSpace.Refresh End Sub Sub cmdStepRight_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdStepRight = True Wend End Sub Sub cmdStepRight_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub cmdStepUp_Click () Dim SHeight As Double Dim NewY As Double Dim PHeight As Double Dim ThePicHandle As Long ThePicHandle = FG1 NewY = SGetY(ThePicHandle, 3) SHeight = SGetY(ThePicHandle, 4) PHeight = SGetY(ThePicHandle, 2) SSetY FG1, 3, NewY - SHeight / PHeight picDrawSpace.Refresh End Sub Sub cmdStepUp_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T CanScroll = True CancelMark T = Timer ' Wait 1 second before starting to scroll While (T + 1#) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer ' Scroll until mouse up event While CanScroll ' wait 1/5 th second between each scroll While (T + .2) > Timer DoEvents If Not CanScroll Then Exit Sub Wend T = Timer cmdStepUp = True Wend End Sub Sub cmdStepUp_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) CanScroll = False End Sub Sub DoHitTesting (Shift As Integer, X As Double, Y As Double) Dim i As Integer CanSetAttribs = False ' Iterate through all of the objects and check if the point is in the bounding rectangle If (Shift And 4) <> 4 Then MarkObjectIdx = -1 End If For i = 0 To MaxHandle - 1 If GraphicContainsPoint(GraphicHandles(i), GraphicTypes(i), X, Y) Then If i > MarkObjectIdx Then MarkObjectIdx = i MarkGraphic GraphicHandles(i), GraphicTypes(i) GetGraphicAttribs GraphicHandles(i) 'DoEvents CanSetAttribs = True Exit Sub End If End If Next i ' We only get here if no object found yet ' If the ALT key is down reset the markidx and try again If ((Shift And 4) = 4) And (MarkObjectIdx <> -1) Then MarkObjectIdx = -1 DoHitTesting Shift, X, Y Exit Sub End If ' We only get here if no object found at all ' so cancel any marks CancelMark End Sub Sub DoMarkPosCheck (X As Single, Y As Single) Dim i As Integer Dim X1 As Double Dim Y1 As Double If MarkPicture = -1 Then ' The mark picture has not been initialised so exit Exit Sub End If If MarkObjectIdx = -1 Then ' There is no object that is currently marked Exit Sub End If For i = MarkStartIdx To MarkEndIdx ' Iterate through all of the point X1 = MarkPoints((i - MarkStartIdx) * 5).X Y1 = MarkPoints((i - MarkStartIdx) * 5).Y If (X >= X1) And (X < (X1 + 10)) Then If (Y >= Y1) And (Y < (Y1 + 10)) Then ' If the cursor is over a point then change the mouse pointer MarkPointIdx = i If (picDrawSpace.MousePointer <> 5) Then picDrawSpace.MousePointer = 5 End If Exit Sub End If End If Next i ' No point was found so set the mouse pointer back MarkPointIdx = -1 If (picDrawSpace.MousePointer = 5) Then picDrawSpace.MousePointer = 0 Exit Sub End If End Sub Sub Form_Activate () ' Set the initial Placement and Scale settings to the form's 'SetScale FG1, 0, 0, picDrawSpace.ScaleWidth, picDrawSpace.ScaleHeight 'SetPlacement FG1, 0, 0, picDrawSpace.ScaleWidth, picDrawSpace.ScaleHeight ' The following code is used for debugging only 'Refresh 'picDrawSpace.Refresh 'picColorBtns_Paint 'DoEvents 'DoEvents 'DoEvents 'DoEvents 'DoEvents 'DoEvents 'DoEvents 'DoEvents 'Unload Me End Sub Sub Form_Load () CurrTool = 0 ' Arrow tool GraphicHandles(0) = 1 GraphicTypes(0) = G_GLOBALPIC MaxHandle = 1 NumPoints = 0 CurrPoint = 0 CurrGraphic = -1 InitAttributes InitColors MarkPicture = -1 MarkObjectIdx = -1 MarkPolyPolygon = -1 CanSetAttribs = False MarkPointIdx = -1 EditDrag = False CanScroll = False SetFontPointHeight FG1, 20 AddPrinterPage End Sub Sub Form_Resize () If WindowState = 1 Then Exit Sub End If pnlAttribBar.Left = 0 pnlAttribBar.Top = ScaleHeight - pnlAttribBar.Height pnlAttribBar.Width = ScaleWidth pnlButtonBar.Left = 0 pnlButtonBar.Top = 0 pnlButtonBar.Height = ScaleHeight - pnlAttribBar.Height * (-pnlAttribBar.Visible) picDrawSpace.Left = pnlButtonBar.Width * (-pnlButtonBar.Visible) picDrawSpace.Top = 0 picDrawSpace.Width = ScaleWidth - pnlButtonBar.Width * (-pnlButtonBar.Visible) picDrawSpace.Height = ScaleHeight - pnlAttribBar.Height * (-pnlAttribBar.Visible) picColorBtns.Width = pnlAttribBar.Width * Screen.TwipsPerPixelX - picColorBtns.Left - (pnlAttribBar.BevelWidth * 2 + pnlAttribBar.BorderWidth) * Screen.TwipsPerPixelX ResizeColorButtons picDrawSpace.Refresh pnlAttribBar.Refresh End Sub Sub Form_Unload (Cancel As Integer) End End Sub Sub GetGraphicAttribs (TheGRaphicHandle As Long) Dim TempColor Dim TempBorderStyle As Integer Dim TempBorderWidth As Integer Dim TempFillStyle As Integer Dim TempBackStyle As Integer TempColor = GetBorderColor(TheGRaphicHandle) SetSelectedColor TempColor, 0 TempColor = GetFillColor(TheGRaphicHandle) SetSelectedColor TempColor, 1 TempColor = GetFontColor(TheGRaphicHandle) SetSelectedColor TempColor, 2 TempColor = GetBackColor(TheGRaphicHandle) SetSelectedColor TempColor, 3 TempBorderStyle = GetBorderStyle(TheGRaphicHandle) SetSelectedBorderStyle TempBorderStyle TempBorderWidth = -GetBorderWidth(TheGRaphicHandle) SetSelectBorderWidth TempBorderWidth TempFillStyle = GetFillStyle(TheGRaphicHandle) SetSelectFillStyle TempFillStyle TempBackStyle = GetBackStyle(TheGRaphicHandle) If (TempBackStyle = 1) Then grbTransparent = True Else grbOpaque = True End If CurrFontHeight = GetFontPointHeight(TheGRaphicHandle) If GetFontWeight(TheGRaphicHandle) > 400 Then CurrFontBold = True Else CurrFontBold = False End If CurrFontItalic = GetFontItalic(TheGRaphicHandle) CurrFontUnderline = GetFontUnderline(TheGRaphicHandle) CurrFontStrikeOut = GetFontStrikeOut(TheGRaphicHandle) CurrFontFaceName = GetFontFaceName(TheGRaphicHandle) End Sub Function GraphicContainsPoint (GraphicHandle As Long, GraphicType As Integer, X As Double, Y As Double) As Integer Dim ContainsPoint As Integer Dim X1 As Double Dim X2 As Double Dim Y1 As Double Dim Y2 As Double Dim dummy As Double Dim i As Integer Dim tx As Double Dim ty As Double Dim NumPoints As Integer Dim ThehDC As Integer Dim TheHandle As Long Dim TheText As String X1 = -1 Y1 = -1 X2 = -1 Y2 = -1 If GraphicHandle < 0 Then GraphicContainsPoint = False Exit Function End If ContainsPoint = False Select Case GraphicType Case G_ARC, G_CHORD, G_ELLIPSE, G_LINE, G_PIE, G_RECTANGLE, G_ROUNDRECT: X1 = SGetX(GraphicHandle, 1) X2 = SGetX(GraphicHandle, 2) Y1 = SGetY(GraphicHandle, 1) Y2 = SGetY(GraphicHandle, 2) Case G_DRAWTEXT X1 = SGetX(GraphicHandle, 1) X2 = SGetX(GraphicHandle, 2) Y1 = SGetY(GraphicHandle, 1) Y2 = SGetY(GraphicHandle, 2) X2 = X1 + X2 Y2 = Y1 + Y2 Case G_TEXTOut X1 = SGetX(GraphicHandle, 1) Y1 = SGetY(GraphicHandle, 1) TheText = GetString(GraphicHandle) TheHandle = FG1 ThehDC = picDrawSpace.hDC SetFontPointHeight FG1, GetFontPointHeight(GraphicHandle) X2 = X1 + Abs(GetScaleTextWidth(TheHandle, ThehDC, TheText)) Y2 = Y1 + Abs(GetScaleTextHeight(TheHandle, ThehDC, TheText)) Case G_POLYTEXTOut: NumPoints = GetNumPoints(GraphicHandle) For i = 1 To NumPoints - 1 X1 = SGetX(GraphicHandle, i) Y1 = SGetY(GraphicHandle, i) TheText = GetPTextAt(GraphicHandle, i) TheHandle = FG1 ThehDC = picDrawSpace.hDC SetFontPointHeight FG1, GetFontPointHeight(GraphicHandle) X2 = X1 + Abs(GetScaleTextWidth(TheHandle, ThehDC, TheText)) Y2 = Y1 + Abs(GetScaleTextHeight(TheHandle, ThehDC, TheText)) If (X >= X1) And (X <= X2) And (Y >= Y1) And (Y <= Y2) Then i = NumPoints End If Next i Case G_POLYGON, G_POLYLINE, G_POLYPOLYGON, G_FREEHAND: NumPoints = GetNumPoints(GraphicHandle) If NumPoints > 1 Then X1 = SGetX(GraphicHandle, 0) X2 = SGetX(GraphicHandle, 1) Y1 = SGetY(GraphicHandle, 0) Y2 = SGetY(GraphicHandle, 1) For i = 2 To NumPoints - 1 tx = SGetX(GraphicHandle, i) ty = SGetY(GraphicHandle, i) If tx < X1 Then X1 = tx If tx > X2 Then X2 = tx If ty < Y1 Then Y1 = ty If ty > Y2 Then Y2 = ty Next i End If End Select If (X1 > X2) Then dummy = X1 X1 = X2 X2 = dummy End If If (Y1 > Y2) Then dummy = Y1 Y1 = Y2 Y2 = dummy End If If (X >= X1) And (X <= X2) And (Y >= Y1) And (Y <= Y2) Then ContainsPoint = True End If GraphicContainsPoint = ContainsPoint End Function Sub grbDrawTool_Click (Index As Integer, Value As Integer) Dim i As Integer CurrTool = Index NumPoints = 0 CurrPoint = 0 CurrGraphic = -1 CancelMark ' Clear all of the tools checks For i = 0 To 15 mu_Tool(i).Checked = False Next i ' Check the new tool mu_Tool(Index).Checked = True If (Index = 0) Or (Index = 15) Then picDrawSpace.MousePointer = 0 Else picDrawSpace.MousePointer = 2 End If End Sub Sub grbOpaque_Click (Value As Integer) If Value Then CurrBackStyle = BKS_OPAQUE SetMarkAttribs End If End Sub Sub grbTransparent_Click (Value As Integer) If Value Then CurrBackStyle = BKS_TRANSPARENT SetMarkAttribs End If End Sub Sub InitAttributes () CurrBorderColor = QBColor(0) CurrBorderStyle = BS_SOLID CurrBorderWidth = 0 CurrFillColor = QBColor(0) CurrFIllStyle = FS_HOLLOW CurrBackColor = QBColor(0) CurrBackStyle = BKS_TRANSPARENT CurrFontColor = QBColor(0) CurrFontFaceName = "System" CurrFontHeight = 0 CurrFontItalic = False CurrFontStrikeOut = False CurrFontUnderline = False CurrFontBold = False End Sub Sub InitColors () Dim i As Integer Dim j As Integer Dim CurrBtn As Long Dim BtnWidth As Integer Dim RGBVal As Integer Dim BtnHeight As Integer BtnWidth = picColorBtns.ScaleWidth / NUM_COLORS BtnHeight = picColorBtns.ScaleHeight / 4 ' Create rectangles for all of the colors For j = 0 To 3 For i = 0 To (NUM_COLORS - 1) CurrBtn = CReateRectangle(FG2, i * BtnWidth, j * BtnHeight, (i + 1) * BtnWidth, (j + 1) * BtnHeight - 2) SetFillStyle CurrBtn, 0 'SetDrawMode CurrBtn, 13 If (i > 15) Then ' Generate a Custom color RGBVal = (NUM_COLORS - i) * 256 / (NUM_COLORS - 14) SetFillColor CurrBtn, RGB(RGBVal, RGBVal, RGBVal) SetBorderColor CurrBtn, RGB(RGBVal, RGBVal, RGBVal) Else ' Generate a VB Color SetFillColor CurrBtn, QBColor(i) SetBorderColor CurrBtn, QBColor(i) End If AllColors(i, j) = CurrBtn Next i Next j ' Create the color selection indicator rectangles For j = 0 To 3 ColorSelect(j) = CReateRectangle(FG2, 0, j * BtnHeight, BtnWidth, (j + 1) * BtnHeight - 2) SetFillStyle ColorSelect(j), 1 SetBorderColor ColorSelect(j), QBColor(0) SetBorderWidth ColorSelect(j), BtnWidth / 4 SetDrawMode ColorSelect(j), 10 ColorSelectIdx(j) = 0 Next j End Sub Sub MarkGraphic (GraphicHandle As Long, GraphicType As Integer) Dim X1 As Double Dim Y1 As Double Dim X2 As Double Dim Y2 As Double Dim dummy As Long Dim NumIdxs As Integer Dim i As Integer If MarkPicture = -1 Then MarkPicture = CreatePicture(FG1) ReDim MarkPoints(2) ReDim MarkCount(0) MarkCount(0) = 2 MarkPolyPolygon = BCreatePolyPolygon(MarkPicture, MarkPoints(), MarkCount()) SetDrawMode MarkPolyPolygon, 10 SetFillStyle MarkPolyPolygon, FS_SOLID SetFillColor MarkPolyPolygon, QBColor(0) SetPreserveAttribs MarkPolyPolygon, 1 SetBorderStyle MarkPolyPolygon, BS_TRANSPARENT SetBorderWidth MarkPolyPolygon, 0 SetBackStyle MarkPolyPolygon, BKS_TRANSPARENT End If ' Undraw any marks in the picture If GetVisible(MarkPicture) Then DoPaint MarkPicture End If SetVisible MarkPicture, True Select Case GraphicType Case G_ARC, G_CHORD, G_PIE MarkStartIdx = 1 MarkEndIdx = 4 Case G_ELLIPSE, G_LINE, G_RECTANGLE MarkStartIdx = 1 MarkEndIdx = 2 Case G_ROUNDRECT: MarkStartIdx = 1 MarkEndIdx = 3 Case G_TEXTOut: MarkStartIdx = 1 MarkEndIdx = 1 Case G_DRAWTEXT: MarkStartIdx = 1 MarkEndIdx = 2 Case G_POLYGON, G_POLYLINE, G_POLYPOLYGON, G_FREEHAND: MarkStartIdx = 0 MarkEndIdx = GetNumPoints(GraphicHandle) - 1 Case G_POLYTEXTOut: MarkStartIdx = 1 MarkEndIdx = GetNumPoints(GraphicHandle) - 1 End Select ' Caclulate the number of points NumIdxs = MarkEndIdx - MarkStartIdx ' There are five physical points per logical point ReDim MarkPoints((NumIdxs + 3) * 5) ReDim MarkCount(NumIdxs + 2) ' Initialise the poly count array For i = 0 To NumIdxs + 2 MarkCount(i) = 5 Next i ' initialise the points of the polypolygon For i = MarkStartIdx + 0 To MarkEndIdx X1 = SGetX(GraphicHandle, i) Y1 = SGetY(GraphicHandle, i) ToPhysicalXY FG1, X1, Y1 If (GraphicType = G_DRAWTEXT) Then If i = 1 Then X2 = X1 Y2 = Y1 Else X1 = X1 + X2 Y1 = Y1 + Y2 End If End If MarkPoints((i - MarkStartIdx) * 5 + 0).X = X1 - 5 MarkPoints((i - MarkStartIdx) * 5 + 0).Y = Y1 - 5 MarkPoints((i - MarkStartIdx) * 5 + 1).X = X1 + 5 MarkPoints((i - MarkStartIdx) * 5 + 1).Y = Y1 - 5 MarkPoints((i - MarkStartIdx) * 5 + 2).X = X1 + 5 MarkPoints((i - MarkStartIdx) * 5 + 2).Y = Y1 + 5 MarkPoints((i - MarkStartIdx) * 5 + 3).X = X1 - 5 MarkPoints((i - MarkStartIdx) * 5 + 3).Y = Y1 + 5 MarkPoints((i - MarkStartIdx) * 5 + 4).X = X1 - 5 MarkPoints((i - MarkStartIdx) * 5 + 4).Y = Y1 - 5 Next i DoScale MarkPicture DoPaint MarkPicture End Sub Sub mu_About_Click () AboutBox.Show 1 End Sub Sub mu_AttribBar_Click () mu_AttribBar.Checked = Not mu_AttribBar.Checked pnlAttribBar.Visible = mu_AttribBar.Checked Form_Resize End Sub Sub mu_ButtonBar_Click () mu_ButtonBar.Checked = Not mu_ButtonBar.Checked pnlButtonBar.Visible = mu_ButtonBar.Checked Form_Resize End Sub Sub mu_ClearAll_Click () CancelMark ClearAll FG1 CurrTool = 0 ' Arrow tool GraphicHandles(0) = 1 GraphicTypes(0) = G_GLOBALPIC MaxHandle = 1 NumPoints = 0 CurrPoint = 0 CurrGraphic = -1 InitAttributes 'InitColors MarkPicture = -1 MarkObjectIdx = -1 MarkPolyPolygon = -1 CanSetAttribs = False MarkPointIdx = -1 EditDrag = False CanScroll = False AddPrinterPage picDrawSpace.Refresh grbDrawTool(0) = True End Sub Sub mu_Delete_Click (Index As Integer) cmdDeleteGraphic = True End Sub Sub mu_Exit_Click () Unload Me End Sub Sub mu_Print_Click () SetPlacement FG1, Printer.ScaleLeft, Printer.ScaleTop, Printer.ScaleWidth + Printer.ScaleLeft, Printer.ScaleHeight + Printer.ScaleTop DoScale FG1 Printer.Print "" DoDraw FG1, Printer.hDC Printer.EndDoc SetPlacement FG1, 0, 0, picDrawSpace.ScaleWidth, picDrawSpace.ScaleHeight DoScale FG1 End Sub Sub mu_Tool_Click (Index As Integer) Dim i As Integer For i = 0 To 15 mu_Tool(i).Checked = False Next i mu_Tool(Index).Checked = True grbDrawTool(Index) = True End Sub Sub mu_ViewTips_Click () mu_ViewTips.Checked = Not mu_ViewTips.Checked 'frmToolTips.Timer1.Enabled = mu_ViewTips.Checked End Sub Sub mu_ZoomOut_Click () cdmZoomOut = True End Sub Sub Panel3D1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer If (Button And 1) <> 1 Then Exit Sub End If For i = 0 To 6 If Y < (Line1(i).Y1 + 53) Then Shape1.Top = Line1(i).Y1 - Shape1.Height / 2 CurrBorderStyle = i SetMarkAttribs Exit Sub End If Next i ' We only get here if no match found yet ' therefore use last option Shape1.Top = Line1(6).Y1 - Shape1.Height / 2 CurrBorderStyle = 6 SetMarkAttribs End Sub Sub Panel3D2_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer If (Button And 1) <> 1 Then Exit Sub End If For i = 0 To 4 If Y < (Line2(i).Y1 + (Line2(i + 1).Y1 - Line2(i).Y1) / 2) Then Shape2.Top = Line2(i).Y1 - Shape2.Height / 2 If i = 0 Then CurrBorderWidth = 0 Else CurrBorderWidth = Line2(i).BorderWidth End If SetMarkAttribs Exit Sub End If Next i ' We only get here if no match found yet ' therefore use last option Shape2.Top = txtBorderWidth.Top + txtBorderWidth.Height / 2 - Shape2.Height / 2 CurrBorderWidth = Val(txtBorderWidth) SetMarkAttribs End Sub Sub Panel3D3_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim NewStyle As Integer If (Button And 1) <> 1 Then Exit Sub End If NewStyle = 0 Select Case Y Case 0 To 300: NewStyle = 0 Shape4.Top = 60 Case 301 To 555: NewStyle = 1 Shape4.Top = 315 Case Else NewStyle = 2 Shape4.Top = 570 End Select Select Case X Case 0 To 300: NewStyle = NewStyle + 0 Shape4.Left = 60 Case 301 To 555: NewStyle = NewStyle + 3 Shape4.Left = 315 Case Else NewStyle = NewStyle + 6 Shape4.Left = 570 End Select If NewStyle > 7 Then NewStyle = 7 Shape4.Top = 315 End If CurrFIllStyle = NewStyle SetMarkAttribs End Sub Sub picColorBtns_DblClick () On Error Resume Next CMDialog1.Color = GetBorderColor(AllColors(ColorSelectIdx(ColorRow), ColorRow)) CMDialog1.Flags = 1 'CC_RGBINIT CMDialog1.Action = 3 If (Err <> 0) Then Err = 0 Exit Sub End If DoPaint ColorSelect(0) DoPaint ColorSelect(1) DoPaint ColorSelect(2) DoPaint ColorSelect(3) SetBorderColor AllColors(ColorSelectIdx(ColorRow), ColorRow), CMDialog1.Color SetFillColor AllColors(ColorSelectIdx(ColorRow), ColorRow), CMDialog1.Color DoPaint AllColors(ColorSelectIdx(ColorRow), ColorRow) DoPaint ColorSelect(0) DoPaint ColorSelect(1) DoPaint ColorSelect(2) DoPaint ColorSelect(3) UpdateCurrentColors SetMarkAttribs End Sub Sub picColorBtns_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim Idx As Integer Dim BtnWidth As Double Dim BtnHeight As Integer BtnWidth = picColorBtns.ScaleWidth / NUM_COLORS BtnHeight = picColorBtns.ScaleHeight / 4 ColorRow = Y / BtnHeight - .5 Idx = (X / BtnWidth - .5) DoPaint ColorSelect(ColorRow) SetX ColorSelect(ColorRow), 1, BtnWidth * Idx SetX ColorSelect(ColorRow), 2, BtnWidth * (Idx + 1) DoPaint ColorSelect(ColorRow) ColorSelectIdx(ColorRow) = Idx UpdateCurrentColors SetMarkAttribs End Sub Sub picColorBtns_Paint () 'picColorBtns.Cls DoDraw FG2, picColorBtns.hDC End Sub Sub picDrawSpace_DblClick () ' If a polypolygon is been drawn then end it If (CurrTool = G_POLYPOLYGON) And (CurrGraphic <> -1) Then DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, initx SSetY CurrGraphic, CurrPoint, inity SetPolyCount CurrGraphic, PolyPolygonCountIdx, CurrPoint - PolyCountStartIdx + 1 SetDrawMode CurrGraphic, 13 DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = 0 NumPoints = 0 CurrGraphic = -1 End If End Sub Sub picDrawSpace_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim tx As Double Dim ty As Double tx = X ty = Y ToScaleXY FG1, tx, ty If (Button And 2) = 2 Then If (CurrTool = 6) Or (CurrTool = 8) Or (CurrTool = 14) Or (CurrTool = G_POLYTEXTOut) Then NumPoints = CurrPoint Else If (CurrTool = G_POLYPOLYGON) And (CurrGraphic <> -1) Then DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, initx SSetY CurrGraphic, CurrPoint, inity initx = tx inity = ty SetPolyCount CurrGraphic, PolyPolygonCountIdx, CurrPoint - PolyCountStartIdx + 1 SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty AddPolyCount CurrGraphic, 2 PolyCountStartIdx = CurrPoint + 1 CurrPoint = CurrPoint + 2 PolyPolygonCountIdx = PolyPolygonCountIdx + 1 DoScale CurrGraphic DoPaint CurrGraphic Exit Sub End If End If End If If NumPoints <> 0 Then Exit Sub End If Select Case CurrTool Case 0: If (MarkPointIdx >= 0) And (MarkObjectIdx <> -1) Then NumPoints = MarkPointIdx CurrPoint = MarkPointIdx CurrGraphic = GraphicHandles(MarkObjectIdx) EditDrag = True SetDrawMode CurrGraphic, 10 SetFillStyle CurrGraphic, FS_HOLLOW SetBackStyle CurrGraphic, BKS_TRANSPARENT SetBorderWidth CurrGraphic, 0 DoScale CurrGraphic DoPaint CurrGraphic If (GraphicTypes(MarkObjectIdx) = G_DRAWTEXT) Then initx = SGetX(CurrGraphic, 1) inity = SGetY(CurrGraphic, 1) End If Exit Sub Else EditDrag = False Exit Sub End If Case G_ARC: NumPoints = 4 CurrPoint = 2 CurrGraphic = SCreateArc(FG1, tx, ty, tx + 1, ty + 1, 1, 1, 1, 1) Case G_CHORD: NumPoints = 4 CurrPoint = 2 CurrGraphic = SCreateChord(FG1, tx, ty, tx + 1, ty + 1, 1, 1, 1, 1) Case G_DRAWTEXT: NumPoints = 2 CurrPoint = 2 CurrGraphic = SCreateDrawText(FG1, "Draw Text", tx, ty, 20, 20, DT_LEFT Or DT_WORDBREAK) initx = tx inity = ty Case G_ELLIPSE: NumPoints = 2 CurrPoint = 2 CurrGraphic = SCreateEllipse(FG1, tx, ty, tx, ty) Case G_LINE: NumPoints = 2 CurrPoint = 2 CurrGraphic = SCreateLine(FG1, tx, ty, tx, ty) Case G_POLYGON: NumPoints = 10000 CurrPoint = 2 CurrGraphic = SCreatePolygon(FG1) SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty Case G_PIE: NumPoints = 4 CurrPoint = 2 CurrGraphic = SCreatePie(FG1, tx, ty, tx + 1, ty + 1, 1, 1, 1, 1) Case G_POLYLINE: NumPoints = 10000 CurrPoint = 2 CurrGraphic = SCreatePolyline(FG1) SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty Case G_POLYPOLYGON: NumPoints = 10000 CurrPoint = 1 PolyCountStartIdx = 0 CurrGraphic = SCreatePolyPolygon(FG1) SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty initx = tx inity = ty AddPolyCount CurrGraphic, 2 PolyPolygonCountIdx = 0 Case G_POLYTEXTOut: NumPoints = 10000 CurrPoint = 1 CurrGraphic = SCreatePolyTextOut(FG1) SAddPText CurrGraphic, tx, ty, "" SAddPText CurrGraphic, tx, ty, "PolyTextOut" Case G_RECTANGLE: NumPoints = 2 CurrPoint = 2 CurrGraphic = SCReateRectangle(FG1, tx, ty, tx, ty) Case G_ROUNDRECT: NumPoints = 3 CurrPoint = 2 CurrGraphic = SCreateRoundRect(FG1, tx, ty, tx, ty, tx, ty) Case G_TEXTOut: NumPoints = 1 CurrPoint = 1 initx = tx inity = ty CurrGraphic = SCreateTextOut(FG1, tx, ty, "Text Out") Case G_FREEHAND: CurrGraphic = SCreatePolyline(FG1) NumPoints = 10000 CurrPoint = 2 SAddPoint CurrGraphic, tx, ty SAddPoint CurrGraphic, tx, ty Case 15: NumPoints = 2 CurrPoint = 2 initx = tx inity = ty CurrGraphic = SCReateRectangle(FG1, tx, ty, tx, ty) Case Else Exit Sub End Select SetDrawMode CurrGraphic, 10 If MaxHandle > MAX_GRAPHICS Then MsgBox "Out of graphic handles" Else GraphicHandles(MaxHandle) = CurrGraphic GraphicTypes(MaxHandle) = CurrTool MaxHandle = MaxHandle + 1 End If If (CurrTool <> 15) And 1 Then SetBorderColor CurrGraphic, CurrBorderColor SetBorderStyle CurrGraphic, CurrBorderStyle SetBorderWidth CurrGraphic, -CurrBorderWidth SetBackColor CurrGraphic, CurrBackColor SetBackStyle CurrGraphic, CurrBackStyle SetFillColor CurrGraphic, CurrFillColor SetFillStyle CurrGraphic, CurrFIllStyle SetFontColor CurrGraphic, CurrFontColor SetFontFaceName CurrGraphic, CurrFontFaceName If CurrFontBold Then SetFontWeight CurrGraphic, 700 Else SetFontWeight CurrGraphic, 300 End If SetFontItalic CurrGraphic, CurrFontItalic SetFontPointHeight CurrGraphic, CurrFontHeight SetFontStrikeOut CurrGraphic, CurrFontStrikeOut SetFontUnderline CurrGraphic, CurrFontUnderline End If DoScale CurrGraphic DoPaint CurrGraphic End Sub Sub picDrawSpace_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim tx As Double Dim ty As Double tx = X ty = Y ToScaleXY FG1, tx, ty If (tx > 10000) Or (tx < -10000) Or (Abs(tx) < .1) Then lblXPos = Format$(tx, "0.00000E+00") Else lblXPos = Format$(tx) End If If (ty > 10000) Or (ty < -10000) Or (Abs(ty) < .1) Then lblYPos = Format$(ty, "0.00000E+00") Else lblYPos = Format$(ty) End If If CurrTool = 0 And (Not EditDrag) Then DoMarkPosCheck X, Y End If If CurrPoint > NumPoints Then Exit Sub End If If CurrGraphic = -1 Then Exit Sub End If Select Case CurrTool Case 0: If (GraphicTypes(MarkObjectIdx) = G_DRAWTEXT) Or (GraphicTypes(MarkObjectIdx) = G_TEXTOut) Or (GraphicTypes(MarkObjectIdx) = G_POLYTEXTOut) Then SetDrawMode CurrGraphic, 13 SetFontColor CurrGraphic, QBColor(15) SetBackColor CurrGraphic, QBColor(15) End If DoScale CurrGraphic DoPaint CurrGraphic If (GraphicTypes(MarkObjectIdx) = G_DRAWTEXT) Then If (CurrPoint = 2) Then SSetX CurrGraphic, CurrPoint, Abs(tx - initx) SSetY CurrGraphic, CurrPoint, Abs(ty - inity) Else SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty End If Else SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty End If SetMarkPos X, Y, MarkPointIdx If (GraphicTypes(MarkObjectIdx) = G_DRAWTEXT) Or (GraphicTypes(MarkObjectIdx) = G_TEXTOut) Or (GraphicTypes(MarkObjectIdx) = G_POLYTEXTOut) Then SetFontColor CurrGraphic, CurrFontColor SetBackColor CurrGraphic, CurrBackColor End If DoScale CurrGraphic DoPaint CurrGraphic Case 3, 13: SetDrawMode CurrGraphic, 13 SetFontColor CurrGraphic, QBColor(15) SetBackColor CurrGraphic, QBColor(15) DoScale CurrGraphic DoPaint CurrGraphic If CurrTool = 3 Then SSetX CurrGraphic, CurrPoint, tx - initx SSetY CurrGraphic, CurrPoint, ty - inity Else SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty End If SetFontColor CurrGraphic, CurrFontColor SetBackColor CurrGraphic, CurrBackColor DoScale CurrGraphic DoPaint CurrGraphic Case 1, 2, 4, 5, 6, 7, 8, 11, 12, 10, G_POLYPOLYGON: DoScale CurrGraphic DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty DoScale CurrGraphic DoPaint CurrGraphic Case 15: DoPaint CurrGraphic If chkKeepAspectRatio.Value Then If Abs(tx - initx) > Abs(ty - inity) Then 'Adjust TX tx = initx + Abs(inity - ty) * Sgn(-initx + tx) Else ' Adjust TY ty = inity + Abs(initx - tx) * Sgn(-inity + ty) End If End If SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty DoScale CurrGraphic DoPaint CurrGraphic Case 14 If CurrPoint < NumPoints Then SetDrawMode CurrGraphic, 13 SAddPoint CurrGraphic, tx, ty DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = CurrPoint + 1 End If End Select End Sub Sub picDrawSpace_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim tx As Double Dim ty As Double Dim TheText As String Dim NewLeft As Double Dim NewTop As Double Dim NewWidth As Double Dim NewHeight As Double Dim dummy As Double tx = X ty = Y ToScaleXY FG1, tx, ty If (CurrTool = 0) And ((Button And 1) = 1) And (Not EditDrag) Then DoHitTesting Shift, tx, ty Exit Sub End If If CurrGraphic = -1 Then Exit Sub End If Select Case CurrTool Case 0: 'DoPaint CurrGraphic If (GraphicTypes(MarkObjectIdx) = G_DRAWTEXT) And (CurrPoint = 2) Then SSetX CurrGraphic, CurrPoint, Abs(tx - initx) SSetY CurrGraphic, CurrPoint, Abs(ty - inity) Else SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty End If SetDrawMode CurrGraphic, 13 SetMarkAttribs 'DoScale CurrGraphic 'DoPaint CurrGraphic CurrPoint = 0 NumPoints = 0 CurrGraphic = -1 EditDrag = False 'picDrawSpace.Refresh Case 3, 13: SetFontColor CurrGraphic, QBColor(15) SetBackColor CurrGraphic, QBColor(15) DoPaint CurrGraphic If CurrTool = 3 Then SSetX CurrGraphic, CurrPoint, tx - initx SSetY CurrGraphic, CurrPoint, ty - inity Else SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty End If SetFontColor CurrGraphic, CurrFontColor DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = CurrPoint + 1 SetFontColor CurrGraphic, CurrFontColor SetBackColor CurrGraphic, CurrBackColor TheText = InputBox$("Enter your text.") SetString CurrGraphic, TheText picDrawSpace.Refresh Case 1, 2, 4, 5, 7, 11, 12: DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = CurrPoint + 1 Case 14: NumPoints = CurrPoint CurrPoint = CurrPoint + 1 Case 6, 8: DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty SAddPoint CurrGraphic, tx, ty DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = CurrPoint + 1 Case G_POLYPOLYGON: DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty If CurrPoint <> NumPoints Then SAddPoint CurrGraphic, tx, ty SetPolyCount CurrGraphic, PolyPolygonCountIdx, CurrPoint - PolyCountStartIdx + 2 End If DoScale CurrGraphic DoPaint CurrGraphic CurrPoint = CurrPoint + 1 Case G_POLYTEXTOut: DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty If CurrPoint <> NumPoints Then SAddPText CurrGraphic, tx, ty, "PolyTextOut" End If TheText = InputBox$("Enter your text.") SetPTextAt CurrGraphic, CurrPoint, TheText picDrawSpace.Refresh CurrPoint = CurrPoint + 1 Case 15: DoPaint CurrGraphic SSetX CurrGraphic, CurrPoint, tx SSetY CurrGraphic, CurrPoint, ty If tx < initx Then dummy = tx tx = initx initx = dummy End If If ty < inity Then dummy = ty ty = inity inity = dummy End If If chkKeepAspectRatio.Value Then If Abs(tx - initx) > Abs(ty - inity) Then 'Adjust TX tx = initx + Abs(inity - ty) * Sgn(-initx + tx) Else ' Adjust TY ty = inity + Abs(initx - tx) * Sgn(-inity + ty) End If End If SetScale FG1, initx, inity, tx - initx, ty - inity If chkKeepAspectRatio.Value Then If picDrawSpace.ScaleWidth > picDrawSpace.ScaleHeight Then SetPlacement FG1, 0, 0, picDrawSpace.ScaleHeight, picDrawSpace.ScaleHeight Else SetPlacement FG1, 0, 0, picDrawSpace.ScaleWidth, picDrawSpace.ScaleWidth End If Else SetPlacement FG1, 0, 0, picDrawSpace.ScaleWidth, picDrawSpace.ScaleHeight End If CurrPoint = 0 NumPoints = 0 RemoveObject CurrGraphic, picDrawSpace.hDC, 0, True, 0 CurrGraphic = -1 picDrawSpace.Refresh End Select If CurrPoint > NumPoints Then If CurrGraphic <> -1 Then SetDrawMode CurrGraphic, 13 DoScale CurrGraphic DoPaint CurrGraphic End If CurrPoint = 0 NumPoints = 0 CurrGraphic = -1 End If End Sub Sub picDrawSpace_Paint () 'picDRawSpace.Cls DoScale FG1 'DoDraw 1, picDRawSpace.hDC DoPaint FG1 End Sub Sub ResizeColorButtons () Dim i As Integer Dim j As Integer Dim ButtonWidth As Double ButtonWidth = (picColorBtns.ScaleWidth / NUM_COLORS - 0#) For i = 0 To NUM_COLORS - 1 For j = 0 To 3 SetX AllColors(i, j), 1, i * ButtonWidth SetX AllColors(i, j), 2, (i + 1) * ButtonWidth Next j Next i For j = 0 To 3 SetX ColorSelect(j), 1, ColorSelectIdx(j) * ButtonWidth SetX ColorSelect(j), 2, (ColorSelectIdx(j) + 1) * ButtonWidth SetBorderWidth ColorSelect(j), ButtonWidth / 4 Next j End Sub Sub SetMarkAttribs () If (MarkObjectIdx >= 0) And CanSetAttribs Then SetBorderColor GraphicHandles(MarkObjectIdx), CurrBorderColor SetBorderStyle GraphicHandles(MarkObjectIdx), CurrBorderStyle SetBorderWidth GraphicHandles(MarkObjectIdx), -CurrBorderWidth SetBackColor GraphicHandles(MarkObjectIdx), CurrBackColor SetBackStyle GraphicHandles(MarkObjectIdx), CurrBackStyle SetFillColor GraphicHandles(MarkObjectIdx), CurrFillColor SetFillStyle GraphicHandles(MarkObjectIdx), CurrFIllStyle SetFontColor GraphicHandles(MarkObjectIdx), CurrFontColor SetFontFaceName GraphicHandles(MarkObjectIdx), CurrFontFaceName If CurrFontBold Then SetFontWeight GraphicHandles(MarkObjectIdx), 700 Else SetFontWeight GraphicHandles(MarkObjectIdx), 300 End If SetFontItalic GraphicHandles(MarkObjectIdx), CurrFontItalic SetFontPointHeight GraphicHandles(MarkObjectIdx), CurrFontHeight SetFontStrikeOut GraphicHandles(MarkObjectIdx), CurrFontStrikeOut SetFontUnderline GraphicHandles(MarkObjectIdx), CurrFontUnderline picDrawSpace.Refresh End If End Sub Sub SetMarkPos (X As Single, Y As Single, ThePointIdx As Integer) DoPaint MarkPicture MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 0).X = X - 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 0).Y = Y - 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 1).X = X + 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 1).Y = Y - 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 2).X = X + 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 2).Y = Y + 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 3).X = X - 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 3).Y = Y + 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 4).X = X - 5 MarkPoints((ThePointIdx - MarkStartIdx) * 5 + 4).Y = Y - 5 DoPaint MarkPicture End Sub Sub SetSelectBorderWidth (BorderWidth As Integer) Dim i As Integer If BorderWidth = 0 Then Shape2.Top = Line2(0).Y1 - Shape2.Height / 2 CurrBorderWidth = BorderWidth Exit Sub End If For i = 1 To 5 If BorderWidth = Line2(i).BorderWidth Then Shape2.Top = Line2(i).Y1 - Shape2.Height / 2 CurrBorderWidth = BorderWidth Exit Sub End If Next i ' We only get here if no match found so use last one Shape2.Top = txtBorderWidth.Top + txtBorderWidth.Height / 2 - Shape2.Height / 2 txtBorderWidth = Str$(BorderWidth) End Sub Sub SetSelectedBorderStyle (NewBorderStyle As Integer) Dim TempY As Single TempY = Line1(NewBorderStyle).Y1 Panel3D1_MouseUp 1, 0, 0, TempY End Sub Sub SetSelectedColor (TheColor, TheRow As Integer) Dim BtnWidth As Double Dim BtnHeight As Double Dim X As Single Dim Y As Single Dim i As Integer BtnWidth = picColorBtns.ScaleWidth / NUM_COLORS BtnHeight = picColorBtns.ScaleHeight / 4 ColorRow = Y / BtnHeight - .5 Y = (TheRow + .5) * BtnHeight X = -1 For i = 0 To NUM_COLORS - 1 If GetBorderColor(AllColors(i, TheRow)) = TheColor Then X = (i + .5) * BtnWidth i = NUM_COLORS End If Next i If X = -1 Then ' No matching color was found so make a new one DoPaint ColorSelect(0) DoPaint ColorSelect(1) DoPaint ColorSelect(2) DoPaint ColorSelect(3) SetBorderColor AllColors(NUM_COLORS - 1, TheRow), TheColor SetFillColor AllColors(NUM_COLORS - 1, TheRow), TheColor DoPaint AllColors(NUM_COLORS - 1, TheRow) DoPaint ColorSelect(0) DoPaint ColorSelect(1) DoPaint ColorSelect(2) DoPaint ColorSelect(3) X = (NUM_COLORS - .5) * BtnWidth End If picColorBtns_MouseUp 1, 0, X, Y End Sub Sub SetSelectFillStyle (FillStyle As Integer) Dim X As Single Dim Y As Single Select Case FillStyle Case 0: X = 150 Y = 150 Case 1: X = 150 Y = 420 Case 2: X = 150 Y = 600 Case 3: X = 420 Y = 150 Case 4: X = 420 Y = 420 Case 5: X = 420 Y = 600 Case 6: X = 600 Y = 150 Case 7: X = 600 Y = 420 End Select Panel3D3_MouseUp 1, 0, X, Y End Sub Sub txtBorderWidth_Change () CurrBorderWidth = Val(txtBorderWidth) End Sub Sub UpdateCurrentColors () CurrBorderColor = GetBorderColor(AllColors(ColorSelectIdx(0), 0)) CurrFillColor = GetBorderColor(AllColors(ColorSelectIdx(1), 1)) CurrFontColor = GetBorderColor(AllColors(ColorSelectIdx(2), 2)) CurrBackColor = GetBorderColor(AllColors(ColorSelectIdx(3), 3)) End Sub