Sub MainWnd_IDM_PRINT_MenuClick()
dim pd as PRINTDLG
dim docinfo as DOCINFO
dim hDC as DWord
ZeroMemory(VarPtr(pd),Len(pd))
with pd
.lStructSize=66
.hwndOwner=hMainWnd
.Flags=PD_RETURNDC
End With
if PrintDlg(pd) then
hDC=pd.hDC
ZeroMemory(VarPtr(docinfo),Len(docinfo))
docinfo.cbSize=Len(docinfo)
docinfo.lpszDocName="text"
StartDoc(hDC,docinfo)
StartPage(hDC)
EndDoc(hDC)
DeleteDC(hDC)
End If
End Sub
sub PrintData(hDC as DWord)
dim i as DWord
dim buf[225] as Byte
dim rect as RECT
' konisi 様のコードをそのまま引用===================================================================
Dim Text As String
Text=ZeroString(GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1)))
GetWindowText(GetDlgItem(hMainWnd,EditBox1),Text,GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1))+1)
'=============================================================================================
for i=1 to 20
wsprintf(VarPtr(buf),Text,i)
DrawText(hDC,buf,-1,rect,DT_CALCRECT)
rect.left=100
rect.right=rect.left+rect.right
rect.top=i*100
rect.bottom=rect.top+rect.bottom
DrawText(hDC,buf,-1,rect,DL_LEFT)
Next i
End Sub
Sub MainWnd_IDM_PRINT_MenuClick()
dim pd as PRINTDLG
dim docinfo as DOCINFO
dim hDC as DWord
ZeroMemory(VarPtr(pd),Len(pd))
with pd
.lStructSize=66
.hwndOwner=hMainWnd
.Flags=PD_RETURNDC
End With
if PrintDlg(pd) then
hDC=pd.hDC
ZeroMemory(VarPtr(docinfo),Len(docinfo))
docinfo.cbSize=Len(docinfo)
docinfo.lpszDocName="text"
StartDoc(hDC,docinfo)
StartPage(hDC)
PrintData(hDC)
EndDoc(hDC)
DeleteDC(hDC)
End If
End Sub
Sub PrintData(hDC as DWord)
dim i as DWord
dim buf[225] as Byte
dim rect as RECT
Dim Text As String
Text=ZeroString(GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1)))
GetWindowText(GetDlgItem(hMainWnd,EditBox1),Text,GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1))+1)
for i=1 to 20
wsprintf(buf,Text,i)
DrawText(hDC,buf,-1,rect,DT_CALCRECT)
rect.left=100
rect.right=rect.left+rect.right
rect.top=i*100
rect.bottom=rect.top+rect.bottom
DrawText(hDC,buf,-1,rect,DT_LEFT)
Next i
End Sub
Sub PrintData(hDC as DWord)
dim buf[225] as Byte
dim rect as RECT
Dim Text As String
dim i as DWord
Text=ZeroString(GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1))+1)
GetWindowText(GetDlgItem(hMainWnd,EditBox1),Text,GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1))+1)
for i=1 to 20
wsprintf(buf,Text,i)
DrawText(hDC,buf,-1,rect,DT_CALCRECT)
rect.left=100
rect.right=rect.left+rect.right
rect.top=i*100
rect.bottom=rect.top+rect.bottom
DrawText(hDC,buf,-1,rect,DT_LEFT)
Next i
End Sub
Sub PrintData(hDC As DWord)
Dim hEdit As HWND
Dim length As DWord
Dim buffer As BytePtr
Dim buf[255] As Byte
Dim rc As RECT
hEdit=GetDlgItem(hMainWnd,EditBox1)
length=GetWindowTextLength(hEdit)
buffer=malloc(length+1)
GetWindowText(hEdit,buffer,length+1)
wsprintf(VarPtr(buf),buffer)
DrawText(hDC,buf-1,rc,DT_CALCRECT)
rc.left=100
rc.right=rc.left+rc.right
rc.top=100
rc.bottom=rc.top+rc.bottom
DrawText(hDC,buf,-1,rc,DT_LEFT)
End Sub
Sub MainWnd_CommandButton1_Click()
Dim pd As PRINTDLG
Dim docinfo As DOCINFO
Dim hDC As DWord
Dim FileName As Byte
SendMessage(hStatus,SB_GETTEXT,0,FileName)
ZeroMemory(VarPtr(pd),Len(pd))
With pd
.lStructSize=66
.hwndOwner=hMainWnd
.Flags=PD_RETURNDC
End With
If PrintDlg(pd) Then
hDC=pd.DC
ZeroMemory(VarPtr(docinfo),Len(docinfo))
docinfo.cbSize=Len(docinfo)
docinfo.lpszDocName=FileName
StartDoc(hDC,docinfo)
StartPage(hDC)
PrintData(hDC)
EndPage(hDC)
EndDoc(hDC)
DeleteDC(hDC)
End If
End Sub
Sub MainWnd_IDM_PRINT_MenuClick()
dim pd as PRINTDLG
dim docinfo as DOCINFO
dim hDC as HDC
dim FileName as Byte
SendMessage(hStatus,SB_GETTEXT,0,FileName)
ZeroMemory(VarPtr(pd),Len(pd))
with pd
.lStructSize=66
.hwndOwner=hMainWnd
.Flags=PD_RETURNDC
End With
if PrintDlg(pd) then
hDC=pd.hDC
ZeroMemory(VarPtr(docinfo),Len(docinfo))
docinfo.cbSize=Len(docinfo)
docinfo.lpszDocName=FileName
StartDoc(hDC,docinfo)
StartPage(hDC)
PrintData(hDC)
EndPage(hDC)
EndDoc(hDC)
DeleteDC(hDC)
End If
End Sub
sub PrintData(hDC as HDC)
dim hEdit as HWND
Dim length As DWord
Dim buffer As BytePtr
dim buf[255] as Byte
dim rc as RECT
hEdit=GetDlgItem(hMainWnd, EditBox1)
length=GetWindowTextLength(hEdit)
buffer=malloc(length+1)
GetWindowText(hEdit, buffer, length+1)
wsprintf(VarPtr(buf),buffer)
DrawText(hDC,buf,-1,rc,DT_CALCRECT)
rc.left=100
rc.right=rc.left+rc.right
rc.top=100
rc.bottom=rc.top+rc.bottom
DrawText(hDC,buf,-1,rc,DT_LEFT)
End Sub
Declare Function SetAbortProc lib "gdi32" (hdc As HDC,lpAbortProc As DWord) As Long
Declare Function AbortDoc lib "gdi32" (hDC As HDC) As Long
Declare Function OpenPrinter lib "winspool" alias "OpenPrinterA" (pPrinterName As *Char,phPrinter As VoidPtr,ByRef pDefault As PRINTER_DEFAULTS) As Long
Declare Function ClosePrinter lib "winspool" (hPrinter As HANDLE) As Long
Declare Function PrinterProperties lib "winspool" (hWnd As HWND,hPrinter As HANDLE) As Long
Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long
pDesiredAccess As Long
End Type
' 印刷関数
Function MyPrint() As Long
Dim hdc As HDC
Dim docinfo As DOCINFO
ZeroMemory(VarPtr(docinfo),Len(docinfo))
docinfo.cbSize = sizeof(DOCINFO)
docinfo.lpszDocName = "testprint"
hdc = GetPrintInfo()
hCancelDlgWnd = CreateDialog(hMainWnd, "PRNSTOP")
ShowWindow(hCancelDlgWnd, SW_SHOW)
EnableWindow(hMainWnd, FALSE)
SetAbortProc(hdc, AddressOf(MyAbortProc))
Dim length As DWord
Dim buffer As BytePtr
'テキスト データを格納するためのバッファ領域を確保
length=GetWindowTextLength(hEdit)
buffer=malloc(length+1)
'テキスト バッファを取得
GetWindowText(hEdit, buffer, length+1)
StartDoc(hdc, docinfo)
StartPage(hdc)
TextOut(hdc, 20, 20, buffer, length)
If bCancel Then
AbortDoc(hdc)
else
DestroyWindow(hCancelDlgWnd)
End If
EndPage(hdc)
EndDoc(hdc)
EnableWindow(hMainWnd, TRUE)
SetFocus(hMainWnd)
DeleteDC(hdc)
MyPrint=0
'バッファを解放する
free(buffer)
End Function
' プリンタ情報を取得する
Function GetPrintInfo() As HDC
Dim dwNeeded As DWORD, dwReturned As DWORD
If EnumPrinters(PRINTER_ENUM_DEFAULT, NULL, 5, VarPtr(prninfo), Len(prninfo), dwNeeded, dwReturned) Then
GetPrintInfo=CreateDC(NULL, prninfo[0].pPrinterName, NULL,ByVal 0)
Else
GetPrintInfo=0
End If
End Function
Function MyAbortProc(hDC As HDC,int As Long)
Dim msg As MSG
While PeekMessage(msg, NULL, 0, 0, PM_REMOVE)
If IsDialogMessage(hCancelDlgWnd, msg) Then
TranslateMessage(msg)
DispatchMessage(msg)
End If
Wend
MyAbortProc=bCancel
End Function
' 印刷中止
Function MyPrnCancelProc(hWnd As HWND,msg As DWord,wp As WPARAM,lp As LPARAM) As LRESULT
Select Case msg
Case WM_INITDIALOG
SetFocus(hWnd)
MyPrnCancelProc=TRUE
Case WM_COMMAND
If LOWORD(wp) = IDCANCEL Then
bCancel = TRUE
DestroyWindow(hCancelDlgWnd)
MyPrnCancelProc=TRUE
End If
End Select
MyPrnCancelProc=FALSE
End Function
Function PrinterSet() As Long
Dim hPrint As HANDLE
GetPrintInfo()
OpenPrinter(prninfo[0].pPrinterName, hPrint,ByVal 0)
PrinterProperties(hParent, hPrint)
ClosePrinter(hPrint)
PrinterSet=0
End Function
Dim hEdit As HWND
Dim hParent As HWND, hCancelDlgWnd As HWND
Dim hInst As HINSTANCE
Dim bCancel = FALSE As Long
Dim prninfo[3] As PRINTER_INFO_5
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
hEdit=GetDlgItem(hMainWnd,EditBox1)
End Sub
' 印刷
Sub MainWnd_CommandButton1_Click()
PrinterSet()
GetPrintInfo()
MyPrint()
End Sub
StartDoc(hdc, docinfo)
StartPage(hdc)
Dim rc As RECT
DrawText(hdc,buffer,length,rc,DT_CALCRECT)
rc.left=20
rc.top=20
rc.right=rc.left+rc.right
rc.bottom=rc.top+rc.bottom
DrawText(hdc,buffer,length,rc,DT_LEFT)