Springen naar inhoud


- - - - -

Draw Rectangle over COM control

Adobe Pdf Com

  • Log in a.u.b. om te beantwoorden
Er zijn 1 reacties in dit onderwerp

#1 Quadrostanology

Quadrostanology

    Rookie Developer

  • Leden
  • Pip
  • 30 berichten
    Laatst bezocht 01 jun 2012 22:10
  • LocatieOVL

Geplaatst op 07 februari 2012 - 14:54

Heren,

Ik heb een form met Adobe PDFReader control op.
Ik kan al een rectange tekenen op het formulier maar niet over de COM control....... :-P
De control van Adobe heeft geen mousedown,move of up event....

Idee is dat ik stukken kan capturen uit PDF zodat die kunnen gelinkt worden aan orders. (werk)

Dit is mijn huidige code: (voorlopig drag opgevangen van form)

Code:
Imports System.Drawing
Public Class fMain
	Dim g As Graphics
	Dim r As Rectangle
	Dim pstart, pend As Point
	Public Sub New()
		InitializeComponent()
		Me.DoubleBuffered = True
	End Sub
	Private Sub fMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
		vPDF.LoadFile(Application.StartupPath & "\TEST.PDF")
	End Sub
	Private Sub fMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
		r = New Rectangle(e.X, e.Y, 0, 0)
		Me.Invalidate()
	End Sub
	Private Sub fMain_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
		If e.Button = MouseButtons.Left Then
			r = New Rectangle(r.Left, r.Top, e.X - r.Left, e.Y - r.Top)
			Me.Invalidate()
		End If
	End Sub
	Private Sub fMain_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
		If r.Width > 0 And r.Height > 0 Then
			MsgBox(r.Width & " / " & r.Height & vbCrLf & r.Top & " - " & r.Left)
		End If
	End Sub
	Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
		Using mypen As New Pen(Brushes.Red, 1)
			e.Graphics.DrawRectangle(mypen, r)
		End Using
	End Sub
End Class


...helpje? :-P

#2 Quadrostanology

Quadrostanology

    Rookie Developer

  • Leden
  • Pip
  • 30 berichten
    Laatst bezocht 01 jun 2012 22:10
  • LocatieOVL

Geplaatst op 07 februari 2012 - 15:53

Google was sneller, lol.

Gebruik maken van snipping tool:

Code:
Imports System.Drawing
Public Class fMain
	Public Sub New()
		InitializeComponent()
		Me.DoubleBuffered = True
	End Sub
	Private Sub fMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
		vPDF.LoadFile(Application.StartupPath & "TEST.PDF")
	End Sub
	Partial Public Class SnippingTool
		Inherits Form
		Public Shared Function Snip() As Image
			Dim rc = Screen.PrimaryScreen.Bounds
			Using bmp As New Bitmap(rc.Width, rc.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
				Using gr As Graphics = Graphics.FromImage(bmp)
					gr.CopyFromScreen(0, 0, 0, 0, bmp.Size)
				End Using
				Using snipper = New SnippingTool(bmp)
					If snipper.ShowDialog() = DialogResult.OK Then
						Return snipper.Image
					End If
				End Using
				Return Nothing
			End Using
		End Function
		Public Sub New(ByVal screenShot As Image)
			'InitializeComponent()
			Me.BackgroundImage = screenShot
			Me.ShowInTaskbar = False
			Me.FormBorderStyle = FormBorderStyle.None
			Me.WindowState = FormWindowState.Maximized
			Me.DoubleBuffered = True
		End Sub
		Public Property Image() As Image
			Get
				Return m_Image
			End Get
			Set(ByVal value As Image)
				m_Image = Value
			End Set
		End Property
		Private m_Image As Image
		Private rcSelect As New Rectangle()
		Private pntStart As Point
		Protected Overrides Sub onmousedown(ByVal e As MouseEventArgs)
			' Start the snip on mouse down
			If e.Button <> MouseButtons.Left Then
				Return
			End If
			pntStart = e.Location
			rcSelect = New Rectangle(e.Location, New Size(0, 0))
			Me.Invalidate()
		End Sub
		Protected Overrides Sub onmousemove(ByVal e As MouseEventArgs)
			' Modify the selection on mouse move
			If e.Button <> MouseButtons.Left Then
				Return
			End If
			Dim x1 As Integer = Math.Min(e.X, pntStart.X)
			Dim y1 As Integer = Math.Min(e.Y, pntStart.Y)
			Dim x2 As Integer = Math.Max(e.X, pntStart.X)
			Dim y2 As Integer = Math.Max(e.Y, pntStart.Y)
			rcSelect = New Rectangle(x1, y1, x2 - x1, y2 - y1)
			Me.Invalidate()
		End Sub
		Protected Overrides Sub onmouseup(ByVal e As MouseEventArgs)
			' Complete the snip on mouse-up
			If rcSelect.Width <= 0 OrElse rcSelect.Height <= 0 Then
				Return
			End If
			Image = New Bitmap(rcSelect.Width, rcSelect.Height)
			Using gr As Graphics = Graphics.FromImage(Image)
				gr.DrawImage(Me.BackgroundImage, New Rectangle(0, 0, Image.Width, Image.Height), rcSelect, GraphicsUnit.Pixel)
			End Using
			DialogResult = DialogResult.OK
		End Sub
		Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
			' Draw the current selection
			Using br As Brush = New SolidBrush(Color.FromArgb(120, Color.Black))
				Dim x1 As Integer = rcSelect.X
				Dim x2 As Integer = rcSelect.X + rcSelect.Width
				Dim y1 As Integer = rcSelect.Y
				Dim y2 As Integer = rcSelect.Y + rcSelect.Height
				e.Graphics.FillRectangle(br, New Rectangle(0, 0, x1, Me.Height))
				e.Graphics.FillRectangle(br, New Rectangle(x2, 0, Me.Width - x2, Me.Height))
				e.Graphics.FillRectangle(br, New Rectangle(x1, 0, x2 - x1, y1))
				e.Graphics.FillRectangle(br, New Rectangle(x1, y2, x2 - x1, Me.Height - y2))
			End Using
			Using pen As New Pen(Color.Red, 2)
				e.Graphics.DrawRectangle(pen, rcSelect)
			End Using
		End Sub
		Protected Overrides Function ProcessCmdKey(ByRef msg As Message, ByVal keyData As Keys) As Boolean
			' Allow canceling the snip with the Escape key
			If keyData = Keys.Escape Then
				Me.DialogResult = DialogResult.Cancel
			End If
			Return MyBase.ProcessCmdKey(msg, keyData)
		End Function
	End Class
	Private Sub btnClip_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClip.Click
		Dim i As Image = SnippingTool.Snip
		Dim s As New SaveFileDialog
		With s
			.Filter = "*.jpg|jpg"
			.AddExtension = True
			.DefaultExt = "*.jpg"
		End With
		If s.ShowDialog = vbOK Then
			i.Save(s.FileName, Imaging.ImageFormat.Jpeg)
		End If
	End Sub
End Class







Ook met taq Adobe, Pdf, Com voorzien

0 gebruiker(s) lezen dit onderwerp

0 lid(leden), 0 bezoeker(s), 0 anonieme gebruikers

Inloggen


Untitled 1

Met dank aan J├╝rgen voor de jarenlange inzet van visualbasic.be (anno dec 2000)
Met dank aan Mike en Ronneke voor de jarenlange inzet van vbib.be (anno dec 2010)
Met dank aan PascalBianca voor de jarenlange inzet van vbib.be (anno dec 2016)