'
Code:
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 VK_SNAPSHOT = &H2C
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'
*************** om te saven ****************
Private Sub save_Click()
On Error Resume Next
MkDir App.Path & "\Graphics\"
CommonDialog1.InitDir = App.Path & "\Graphics"
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
Print #1, text1.text
Close #1
Call Command5_Click ' gaat naar routine om afb te saven
End Sub
' ***************************
Private Sub Command5_Click()
Dim picTmp As PictureBox
MkDir App.Path & "\Graphics\" ' maakt een dir
Dim CaptPic As StdPicture
Dim pt As POINTAPI
Dim pX As Long
Dim pY As Long
Dim pW As Long
Dim pH As Long
Clipboard.Clear
keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
Set CaptPic = Clipboard.GetData()
ClientToScreen Picture1.hwnd, pt
pX = pt.x * Screen.TwipsPerPixelX
pY = pt.y * Screen.TwipsPerPixelY
pW = Picture1.ScaleWidth
pH = Picture1.ScaleHeight
Set picTmp = Me.Controls.Add("VB.PictureBox", "tmp")
picTmp.Width = Picture1.Width
picTmp.Height = Picture1.Height
picTmp.AutoRedraw = True
picTmp.PaintPicture CaptPic, 0, 0, pW, pH, pX, pY, pW, pH
' **********************************************************************
' afb saven met naam van textfile
SavePicture picTmp.Image, CommonDialog1.FileName & ".bmp"
Me.Controls.Remove ("tmp")
Set picTmp = Nothing
End Sub
' ************ om te laden *********
Private Sub load_Click()
Dim testo As String
On Error Resume Next
MkDir App.Path & "\Graphics\" ' qui ho aggiunto
CommonDialog1.InitDir = App.Path & "\Graphics"
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
On Error Resume Next
CommonDialog1.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
Open CommonDialog1.FileName For Input As #1
testo = ""
Do Until EOF(1)
Line Input #1, kFile
testo = testo & kFile & vbCrLf
Loop
text1.Text = testo
Close #1
Picture1.Picture = LoadPicture(CommonDialog1.FileName & ".bmp")
End Sub
afb laden met zelfde naam als textfile
Picture1.Picture = LoadPicture(CommonDialog1.FileName & ".bmp")
' ****************************
Per sfondo label
Private Sub ColoreSfondoLabel_Click()
CommonDialog1.ShowColor
Label1.BackColor = CommonDialog1.Color
End Sub
Private Sub Command1_Click()
On Error Resume Next
MkDir App.Path & "\Grafici\" ' qui ho aggiunto
CommonDialog1.InitDir = App.Path & "\Grafici"
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
Print #1, Text1.Text
End Sub
Private Sub Command2_Click()
Dim testo As String
On Error Resume Next
MkDir App.Path & "\Grafici\" ' qui ho aggiunto
CommonDialog1.InitDir = App.Path & "\Grafici"
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
On Error Resume Next
CommonDialog1.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
Open CommonDialog1.FileName For Input As #1
Do Until EOF(1)
Line Input #1, kFile
testo = testo & kFile & vbCrLf
Loop
Text1.Text = testo
End Sub
Hierbij mijn volledig code
ik heb dus op het form
1 textbox
1 picturebox