A1VBCode Forums

Need help with Create DC problem


http://www.a1vbcode.com/vbforums/Topic28392.aspx

By javakenn - 11/16/2009

I'm wondering if someone can help me with my code specifically related to the Create DC. I am not a programmer and really don't have the vocab and what I have been ready on Google is just not helping. This program runs fine in Windows 98 and until 2 months ago was run only on Win 98, however, we need this program to now run on XP & 7.



Based on what I have read and figured out the error message I receive is due to the a failure in Create DC. So what I'm trying to figure out is what is different between 98 and XP? Could it be related to the print driver rather than the code itself, etc?



Anyway here is a good chunk of the code as it stands now, any help would be really, really appreciated!! Thanks in advance









'Begin to make date plot file

If chk_office.Value = 0 Then

'printr = OpenPrinter(Printer.DeviceName, lhPrinter, 0)

'l_ret = DocumentProperties(Me.hwnd, lhPrinter, Printer.DeviceName, lpInitData, pDevModeInput, 2)

'l_ret = ClosePrinter(lhPrinter)

If opt_18.Value = True Then

lpInitData.dmPaperSize = 257

Else

lpInitData.dmPaperSize = 258

End If

'This is the original command 9/7/09

'lhDC = CreateDC("", Combo1.Text, "FILE:", lpInitData)

'GoTo skip2

lhDC = CreateDC("WINSPOOL", Combo1.Text, "FILE:", lpInitData)



'just trying something 11-09-2009

'prntr_ret = OpenPrinter(Combo1.Text, pntrHand, 0)

'MsgBox Str(prntr_ret)

'lhDC = GetDC(prntr_ret)



'11-09-2009

'createDC is not returning a DC for any printer

'tried using openprinter but still returns 0

'program works when using an existing textout.plt

'if a textout.plt does not exist on the c drive, a zero kB file is generated and the for loop below

'does not iterate because LOF(1) is less than 1





MsgBox Str(lhDC), vbOKOnly, "lhDC"



ret_val = GetLastError()



'MsgBox Str(ret_val), vbOKOnly, "GetLastError"



nHeight = -MulDiv(16, GetDeviceCaps(lhDC, 90), 72)



hFont = CreateFont(nHeight, 0, 0, 0, 700, 0, 0, 0, 0, 0, 0, 0, FF_ROMAN, "Times New Roman")



MyDocInfo.lpszDocName = List1.List(0)

MyDocInfo.lpszOutput = "c:\textout.plt"



read_fil = StartDoc(lhDC, MyDocInfo)

read_fil = StartPage(lhDC)



read_fil = SetTextColor(lhDC, RGB(255, 0, 0))



read_fil = SelectObject(lhDC, hFont)



dt = Format(Date, "m-d-yyyy")



If opt_18.Value = True Then

lReturn = CLng(Printer.ScaleWidth)

l_ret = CLng(Printer.ScaleHeight)

'MsgBox Str(GetDeviceCaps(lhDC, HORZRES)) + " " + Str(GetDeviceCaps(lhDC, VERTRES)) + " " + Str(Printer.ScaleWidth)

read_fil = TextOut(lhDC, lReturn - 400, l_ret - 594, dt, Len(dt))

Else

lReturn = CLng(Printer.ScaleWidth)

l_ret = CLng(Printer.ScaleHeight)

'MsgBox Str(GetDeviceCaps(lhDC, HORZRES)) + " " + Str(GetDeviceCaps(lhDC, VERTRES)) + " " + Str(lReturn) + " " + Str(l_ret)

read_fil = TextOut(lhDC, lReturn - 525, l_ret - 594, dt, Len(dt))

End If



read_fil = EndPage(lhDC)

read_fil = EndDoc(lhDC)



read_fil = DeleteObject(hFont)



read_fil = DeleteDC(lhDC)



skip2:



'Put needed data into array by finding certain sequences



lbl_progress.Caption = "Getting date and making into plt..."

lbl_progress.Visible = True

lbl_progress.Refresh



'file_source = "c:\textout.plt"



Open "c:\textout.plt" For Binary As #1



ok_to_proceed = False



For x = 1 To LOF(1)

Get #1, x, buffer

If ok_to_proceed = False Then

If buffer = 27 Then

x = x + 1

Get #1, x, buffer

If buffer = 37 Then

x = x + 1

Get #1, x, buffer

If buffer = 49 Then

x = x + 1

Get #1, x, buffer

If buffer = 65 Then

y = 1

ok_to_proceed = True

Else

For y = 1 To 3

date_text(y) = 0

Next y

End If

Else

date_text(1) = 0

date_text(2) = 0

End If

Else

date_text(1) = 0

End If

End If

Else

If buffer = 80 Then

x = x + 1

Get #1, x, buffer

If buffer = 71 Then

date_text(y) = 27

y = y + 1

date_text(y) = 37

y = y + 1

date_text(y) = 49

y = y + 1

date_text(y) = 65

Exit For

Else

date_text(y) = 80

y = y + 1

date_text(y) = buffer

End If

Else

date_text(y) = buffer

End If

y = y + 1

End If

Next x



Close #1



'Kill "c:\textout.plt"



.......
By javakenn - 11/18/2009

Are these files that special that it need a HP DesignJet 1050C printer?



Well, I'm assuming that they do. Maybe an explanation of the program would help.



We are an architectural firm and the program was designed so that the process of adding things like security patches, print dates, specific banners, etc. could be merged with the actual drawings in an automated fashion and sent to one of our HP DesignJet devices. So, for example, I have a CAD file of a floor plan that I save as a .plt file. I then select that plot file in this application and what it does is, depending on the options I select, is it will take other .plt files that contain a banner (Copyright notice), another .plt file that has another banner (For construction only) and a 3rd file that contains the system date or print date that needs to appear properly positioned in the title block.



The program essentially takes all of these different .plt files and "layers" them, strips down the HPGL code and builds one final .plt file that goes to the HP print queue for printing.



Right now everything works, except for creating the system date .plt file. When the program reaches that point it generates a popup dialogue box that says lhdc=0. Click OK.

After clicking OK, the program continues running and generates the new .plt file but sans date.



The program was designed in VB6 about 8 years ago and runs flawlessly in 98, but generates this error in XP.



I formatted the code better and I have gotten the code to the point mentioned above, but at this point I'm stumped. (The programmer is long gone by the way, hence why I'm stuck trying to fix it.)



Can anyone think of another way of inserting the system date? Do any of you contract work. I would be happy to send the .exe file, if someoen thinks they can fix it for us, just tell me how much.



Here's the code:



PrivateSubCommand4_Click()



Dimcount1AsInteger

Dimfive_timesAsBoolean,er_orAsBoolean

Dimspl(1000)AsString

DimMyDocInfoAsDOCINFO

Dimread_filAsLong,bytes_readAsLong

Dimfil_szAsLong

DimretAsInteger

DimprintrAsLong,lhPrinterAsLong,lpWrittenAsLong,hFontAsLong

DimlDocAsLong,lReturnAsLong

DimlhDCAsLong,font_dataAsLong,objectAsLong,nHeightAsLong

DimlpInitDataAsDEVMODE,pDevModeInputAsDEVMODE

DimxAsDouble

Dimret_valAsLong,prntr_retAsLong,pntrHandAsLong



OnErrorGoToerr_hand



proc_source="Sendbutton"



Ifconstruction_copy=TrueThen

IfLen(lbl_cust_name)=0Then

MsgBox"Pleaseloadcustomerinformationbeforeproceeding.",vbOKOnly,"Permitsets"

ExitSub

EndIf

EndIf

Ifsite_copy=TrueThen

IfLen(lbl_cust_name)=0Then

MsgBox"Pleaseloadcustomerinformationbeforeproceeding.",vbOKOnly,"Permitsets"

ExitSub

EndIf

EndIf



er_or=False



IfList1.ListCount=0Then

y=MsgBox("Nothingtosend!",vbExclamation)

ExitSub

EndIf



IfCombo1.ListIndex<>-1Thenprt_to_use=prt(Combo1.ListIndex)



ForEachpntrInPrinters

Ifpntr.DeviceName=prt_to_useThen

SetPrinter=pntr

Printer.ScaleMode=3

Ifpntr.DeviceName="\\SALES\HP1050"Orpntr.DeviceName="\\PRINTROOM\HP1050PLUS"Orpntr.DeviceName="DesignJet"Then

Ifopt_18.Value=TrueThen

Printer.PaperSize=257

Else

Printer.PaperSize=258

EndIf

EndIf

ExitFor

EndIf

Next



IfInStr(prt_to_use,"LPT1")<>0Then

prt_to_use="LPT1.DOS"

EndIf



Form1.MousePointer=11



'Begin to make date plot file

Ifchk_office.Value=0Then

'printr = OpenPrinter(Printer.DeviceName, lhPrinter, 0)

'l_ret = DocumentProperties(Me.hwnd, lhPrinter, Printer.DeviceName, lpInitData, pDevModeInput, 2)

'l_ret = ClosePrinter(lhPrinter)

Ifopt_18.Value=TrueThen

lpInitData.dmPaperSize=257

Else

lpInitData.dmPaperSize=258

EndIf

'This is the original command 9/7/09

'lhDC = CreateDC("", Combo1.Text, "FILE:", lpInitData)

'GoTo skip2

'lhDC = CreateDC("WINSPOOL", Combo1.Text, "FILE:", lpInitData)

lhDC=CreateDC("WINSPOOL",DesignJet,"",lpInitData)



'just trying something 11-09-2009

'prntr_ret = OpenPrinter(Combo1.Text, pntrHand, 0)

'MsgBox Str(prntr_ret)

'lhDC = GetDC(prntr_ret)



'11-09-2009

'createDC is not returning a DC for any printer

'tried using openprinter but still returns 0

'program works when using an existing textout.plt

'if a textout.plt does not exist on the c drive, a zero kB file is generated and the for loop below

'does not iterate because LOF(1) is less than 1





MsgBoxStr(lhDC),vbOKOnly,"lhDC"



ret_val=GetLastError()



'MsgBox Str(ret_val), vbOKOnly, "GetLastError"



nHeight=-MulDiv(16,GetDeviceCaps(lhDC,90),72)



hFont=CreateFont(nHeight,0,0,0,700,0,0,0,0,0,0,0,FF_ROMAN,"TimesNewRoman")



MyDocInfo.lpszDocName=List1.List(0)

MyDocInfo.lpszOutput="c:\textout.plt"



read_fil=StartDoc(lhDC,MyDocInfo)

read_fil=StartPage(lhDC)



read_fil=SetTextColor(lhDC,RGB(255,0,0))



read_fil=SelectObject(lhDC,hFont)



dt=Format(Date,"m-d-yyyy")



Ifopt_18.Value=TrueThen

lReturn=CLng(Printer.ScaleWidth)

l_ret=CLng(Printer.ScaleHeight)

'MsgBox Str(GetDeviceCaps(lhDC, HORZRES)) + " " + Str(GetDeviceCaps(lhDC, VERTRES)) + " " + Str(Printer.ScaleWidth)

read_fil=TextOut(lhDC,lReturn-400,l_ret-594,dt,Len(dt))

Else

lReturn=CLng(Printer.ScaleWidth)

l_ret=CLng(Printer.ScaleHeight)

'MsgBox Str(GetDeviceCaps(lhDC, HORZRES)) + " " + Str(GetDeviceCaps(lhDC, VERTRES)) + " " + Str(lReturn) + " " + Str(l_ret)

read_fil=TextOut(lhDC,lReturn-525,l_ret-594,dt,Len(dt))

EndIf



read_fil=EndPage(lhDC)

read_fil=EndDoc(lhDC)



read_fil=DeleteObject(hFont)



read_fil=DeleteDC(lhDC)



skip2:



'Put needed data into array by finding certain sequences



lbl_progress.Caption="Gettingdateandmakingintoplt..."

lbl_progress.Visible=True

lbl_progress.Refresh



'file_source = "c:\textout.plt"



Open"c:\textout.plt"ForBinaryAs#1



ok_to_proceed=False



Forx=1ToLOF(1)

Get#1,x,buffer

Ifok_to_proceed=FalseThen

Ifbuffer=27Then

x=x+1

Get#1,x,buffer

Ifbuffer=37Then

x=x+1

Get#1,x,buffer

Ifbuffer=49Then

x=x+1

Get#1,x,buffer

Ifbuffer=65Then

y=1

ok_to_proceed=True

Else

Fory=1To3

date_text(y)=0

Nexty

EndIf

Else

date_text(1)=0

date_text(2)=0

EndIf

Else

date_text(1)=0

EndIf

EndIf

Else

Ifbuffer=80Then

x=x+1

Get#1,x,buffer

Ifbuffer=71Then

date_text(y)=27

y=y+1

date_text(y)=37

y=y+1

date_text(y)=49

y=y+1

date_text(y)=65

ExitFor

Else

date_text(y)=80

y=y+1

date_text(y)=buffer

EndIf

Else

date_text(y)=buffer

EndIf

y=y+1

EndIf

Nextx



Close#1



'Kill "c:\textout.plt"