impression dans les deux modes avec petite astuce pour ne pas
se faire effacer sa Fenêtre par les boites de dialogue system
v PB 4.51
Code : Tout sélectionner
;#####################################################################
;### graphisme du Zodiaque avec police astro ####
;### police astrot a copier dans le dossier "c:\windows\fonts" ####
;### ICI --> http://home.att.net/~ag2kh/download.htm ####
;### par kernadec pb4 OS windows 02/06/2008 ####
;### surtout n'oubliez pas d'appeler la police ####
;#####################################################################
;petite astuce economique si l'on veut tester les sorties imprimante #
;se procurer "Cute PDF Writer" et imprimer dans un fichier PDF #
;#####################################################################
Global pos.d,x,y,xx,yy,axex,axey,rayon,tfont,mpos,rmaison,font1,Image1
Declare DefaultFontID()
Declare astre(pos)
Declare planete()
Declare tracemaison(mpos)
Declare maison(mpos)
Declare dessin()
Declare impression()
Declare.s GetDefaultPrinter()
Declare PrintImage(Image, PrinterDC)
Declare MakeWinScreenshot(ImageNr,hWnd,Width,Height)
Global printer_DC.l ;
Global wlargeur=600
Global whauteur=600
Global no_imprime=0
axex = 300
axey = 280
rayon = 130
rmaison=rayon/1.5
tfont=26
LoadFont(2,"astro",120,#PB_Font_Bold) ;pour le fun
LoadFont(1,"astro",tfont,#PB_Font_Bold)
LoadFont(0,"ARIAL",20,#PB_Font_Bold)
If OpenWindow(0, 400, 130, wlargeur, whauteur, "IMPRESSION du ZODIAQUE par Kernadec", #WS_SYSMENU)
StartDrawing(WindowOutput(0))
ButtonGadget(0, 20,530,120,30, "Impression")
ButtonGadget(1,160,530,120,30,"Annuler")
dessin()
StopDrawing()
hShotWindow = FindWindow_(0,"IMPRESSION du ZODIAQUE par Kernadec")
If hShotWindow
hWinBmp = MakeWinScreenshot(0,hShotWindow, wlargeur, whauteur)
ImageGadget(2,0,0, wlargeur, whauteur, hWinBmp)
EndIf
EndIf
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Gadget
Select EventGadget()
Case 0
impression()
Case 1
CloseWindow(0)
End
EndSelect
EndSelect
Until EventID = #PB_Event_CloseWindow
CloseWindow(0)
End
;###################################################################
Procedure DefaultFontID()
ProcedureReturn GetStockObject_(#SYSTEM_FONT)
EndProcedure
Procedure maison(mpos)
If mpos=180
x = (axex-tfont/2) + (rayon + rayon/2.5 + rmaison) * Sin(mpos/ 180 * #PI)
y = (axey-tfont/2) + (rayon + rayon/2.5 + rmaison) * Cos(mpos / 180 * #PI)
xx = (axex-tfont/2.25) + (rayon + rayon/2.5 + rmaison) * Sin(mpos/ 180 * #PI)
yy = (axey-tfont/2.25) + (rayon + rayon/2.5 + rmaison) * Cos(mpos / 180 * #PI)
DrawText(xx,yy,Chr(98),RGB(0, 0, 0))
DrawText(x,y,Chr(98),RGB(Random(255), Random(255), Random(255)))
EndIf
If mpos=270
x = (axex-tfont/2) + (rayon + rayon/2.5 + rmaison) * Sin(mpos/ 180 * #PI)
y = (axey-tfont/2) + (rayon + rayon/2.5 + rmaison) * Cos(mpos / 180 * #PI)
xx = (axex-tfont/2.25) + (rayon + rayon/2.5 + rmaison) * Sin(mpos / 180 * #PI)
yy = (axey-tfont/2.25) + (rayon + rayon/2.5 + rmaison) * Cos(mpos/ 180 * #PI)
DrawText(xx,yy,Chr(97),RGB(0, 0, 0))
DrawText(x,y,Chr(97),RGB(Random(255), Random(255), Random(255)))
EndIf
EndProcedure
Procedure tracemaison(mpos)
x = axex + (rayon + rayon/2.5) * Sin(mpos / 180 * #PI)
y = axey + (rayon + rayon/2.5) * Cos(mpos / 180 * #PI)
xx = axex + (rayon + rayon/2.5 + rmaison) * Sin(mpos/ 180 * #PI)
yy = axey + (rayon + rayon/2.5 + rmaison) * Cos(mpos / 180 * #PI)
LineXY(x, y , xx, yy,RGB(0, 0, 0))
EndProcedure
Procedure astre(pos)
x = (axex-tfont/2) + (rayon + rayon/1.7) * Sin(pos / 180 * #PI)
y = (axey-tfont/2) + (rayon + rayon/1.7) * Cos(pos / 180 * #PI)
xx = (axex-tfont/2.25) + (rayon + rayon/1.7) * Sin(pos / 180 * #PI)
yy = (axey-tfont/2.25) + (rayon + rayon/1.7) * Cos(pos / 180 * #PI)
EndProcedure
Procedure dessin()
FillArea(0 ,0 ,RGB(255,255,255),RGB(255,255,255))
DrawingMode(1)
FrontColor(RGB(255, 255, 255))
DrawingFont(FontID(0))
;############################# bop bip lol #########################
If no_imprime=0
DrawText(axex-4,axey+60,"Bip Bip",RGB(255, 255, 255))
DrawText(axex -3,axey+61,"Bip Bip",RGB(255, 255,0))
DrawingFont(FontID(2))
DrawText(axex-106,axey-70 ,Chr(101),RGB(255, 255, 255))
DrawText(axex -103,axey-68,Chr(101),RGB(0, 255,0))
DrawingFont(FontID(1))
DrawText(axex-33,axey-20,Chr(81),RGB(255, 255, 255))
DrawText(axex -31,axey-19,Chr(81),RGB(255, 255,0))
DrawText(axex+4,axey-28,Chr(81),RGB(255, 255, 255))
DrawText(axex +2,axey-27,Chr(81),RGB(255, 255,0))
EndIf
;####################################################################
DrawingFont(FontID(1))
For o = 0 To 359 Step 30
x = axex + rayon * Sin(o / 180 * #PI)
y = axey + rayon * Cos(o / 180 * #PI)
xx = axex + (rayon + rayon/2.5) * Sin(o / 180 * #PI)
yy = axey + (rayon + rayon/2.5) * Cos(o / 180 * #PI)
LineXY(x, y , xx, yy,RGB(0, 0, 0))
For i = 1 To 29
If i = 5 Or i = 15 Or i = 25
x = axex + rayon * Sin((i + o) / 180 * #PI)
y = axey + rayon * Cos((i + o) / 180 * #PI)
xx = axex + (rayon + rayon/12.5) * Sin((i + o) / 180 * #PI)
yy = axey + (rayon + rayon/12.5) * Cos((i + o) / 180 * #PI)
LineXY(x, y , xx, yy, RGB(0, 0, 0))
ElseIf i = 10 Or i = 20
x = axex + rayon * Sin((i + o) / 180 * #PI)
y = axey + rayon * Cos((i + o) / 180 * #PI)
xx = axex + (rayon + rayon/8) * Sin((i + o) / 180 * #PI)
yy = axey + (rayon + rayon/8) * Cos((i + o) / 180 * #PI)
LineXY(x, y , xx, yy,RGB(0, 0, 0))
Else
x = axex + rayon * Sin((i + o) / 180 * #PI)
y = axey + rayon * Cos((i + o) / 180 * #PI)
xx = axex + (rayon + rayon/20) * Sin((i + o) / 180 * #PI)
yy = axey + (rayon + rayon/20) * Cos((i + o) / 180 * #PI)
LineXY(x, y , xx, yy, RGB(0, 0,0));
EndIf
Next i
x = (axex-tfont/2) + (rayon + rayon/4.35) * Sin((o+15) / 180 * #PI)
y = (axey-tfont/2) + (rayon + rayon/4.35) * Cos((o+15) / 180 * #PI)
xx = (axex-tfont/2.25) + (rayon + rayon/4.35) * Sin((o+15) / 180 * #PI)
yy = (axey-tfont/2.25) + (rayon + rayon/4.35) * Cos((o+15) / 180 * #PI)
DrawText(xx,yy,Chr(c+65),RGB(0, 0, 0))
DrawText(x,y,Chr(c+65),RGB(Random(255), Random(255), Random(255)))
c=c+1
planete()
maison(o)
tracemaison(o)
Next o
DrawingFont(DefaultFontID())
DrawingMode(4)
Ellipse(axex ,axey, rayon + rayon/2.5, rayon + rayon/2.5, RGB(0, 0, 0))
Ellipse(axex, axey, rayon, rayon, RGB(0, 0, 0))
EndProcedure
Procedure planete()
;################################################################
;# definition des maitises retro et directe de chaque signe #
;################################################################
; ############### Soleil Maitre Diurne
astre(130)
DrawText(xx,yy,Chr(81),RGB(0, 0, 0))
DrawText(x,y,Chr(81),RGB(255, 255,0))
; ############### Soleil Maitre Nocturne
astre(110)
DrawText(xx,yy,Chr(81),RGB(0, 0, 0))
DrawText(x,y,Chr(81),RGB(255, 255,0))
; ############### lune Maitre Diurne
astre(100)
DrawText(xx,yy,Chr(82),RGB(0, 0, 0))
DrawText(x,y,Chr(82),RGB(200, 200,200))
; ############### lune Maitre Nocturne
astre(140)
DrawText(xx,yy,Chr(82),RGB(0, 0, 0))
DrawText(x,y,Chr(82),RGB(Random(255), Random(255), Random(255)))
; ############### mercure Maitre Diurne
astre(70)
DrawText(xx,yy,Chr(83),RGB(0, 0, 0))
DrawText(x,y,Chr(83),RGB(Random(255), Random(255), Random(255)))
; ############### mercure Maitre Nocturne
astre(80)
DrawText(xx,yy,Chr(83),RGB(0, 0, 0))
DrawText(x,y,Chr(83),RGB(Random(255), Random(255), Random(255)))
; ############### venus Maitre Diurne
astre(40)
DrawText(xx,yy,Chr(84),RGB(0, 0, 0))
DrawText(x,y,Chr(84),RGB(Random(255), Random(255), Random(255)))
; ############### venus Maitre Nocturne
astre(50)
DrawText(xx,yy,Chr(84),RGB(0, 0, 0))
DrawText(x,y,Chr(84),RGB(Random(255), Random(255), Random(255)))
; ############### mars Maitre Diurne
astre(10)
DrawText(xx,yy,Chr(85),RGB(0, 0, 0))
DrawText(x,y,Chr(85),RGB(Random(255), Random(255), Random(255)))
; ############### pluton Maitre Nocturne
astre(20)
DrawText(xx,yy,Chr(90),RGB(0, 0, 0))
DrawText(x,y,Chr(90),RGB(Random(255), Random(255), Random(255)))
; ############### jupiter Maitre Diurne
astre(250)
DrawText(xx,yy,Chr(86),RGB(0, 0, 0))
DrawText(x,y,Chr(86),RGB(Random(255), Random(255), Random(255)))
; ############### neptune Maitre Nocturne
astre(260)
DrawText(xx,yy,Chr(89),RGB(0, 0, 0))
DrawText(x,y,Chr(89),RGB(Random(255), Random(255), Random(255)))
; ############### saturne Maitre Diurne
astre(280)
DrawText(xx,yy,Chr(87),RGB(0, 0, 0))
DrawText(x,y,Chr(87),RGB(Random(255), Random(255), Random(255)))
; ############### uranus Maitre Nocturne
astre(290)
DrawText(xx,yy,Chr(88),RGB(0, 0, 0))
DrawText(x,y,Chr(88),RGB(Random(255), Random(255), Random(255)))
; ############### uranus Maitre Diurne
astre(310)
DrawText(xx,yy,Chr(88),RGB(0, 0, 0))
DrawText(x,y,Chr(88),RGB(Random(255), Random(255), Random(255)))
; ############### saturne Maitre Nocturne
astre(320)
DrawText(xx,yy,Chr(87),RGB(0, 0, 0))
DrawText(x,y,Chr(87),RGB(Random(255), Random(255), Random(255)))
; ############### neptune Maitre Diurne
astre(340)
DrawText(xx,yy,Chr(89),RGB(0, 0, 0))
DrawText(x,y,Chr(89),RGB(Random(255), Random(255), Random(255)))
; ############### jupiter Maitre Nocturne
astre(350)
DrawText(xx,yy,Chr(86),RGB(0, 0, 0))
DrawText(x,y,Chr(86),RGB(Random(255), Random(255), Random(255)))
; ############### pluton Maitre Diurne
astre(220)
DrawText(xx,yy,Chr(90),RGB(0, 0, 0))
DrawText(x,y,Chr(90),RGB(Random(255), Random(255), Random(255)))
; ############### mars Maitre Nocturne
astre(230)
DrawText(xx,yy,Chr(85),RGB(0, 0, 0))
DrawText(x,y,Chr(85),RGB(Random(255), Random(255), Random(255)))
; ############### mercure Maitre Diurne
astre(160)
DrawText(xx,yy,Chr(83),RGB(0, 0, 0))
DrawText(x,y,Chr(83),RGB(Random(255), Random(255), Random(255)))
; ############### mercure Maitre Nocturne
astre(170)
DrawText(xx,yy,Chr(83),RGB(0, 0, 0))
DrawText(x,y,Chr(83),RGB(Random(255), Random(255), Random(255)))
; ############### venus Maitre Diurne
astre(190)
DrawText(xx,yy,Chr(84),RGB(0, 0, 0))
DrawText(x,y,Chr(84),RGB(Random(255), Random(255), Random(255)))
; ############### venus Maitre Nocturne
astre(200)
DrawText(xx,yy,Chr(84),RGB(0, 0, 0))
DrawText(x,y,Chr(84),RGB(Random(255), Random(255), Random(255)))
EndProcedure
;#######################################################################
;###### remerciement a zombie pour ce code d'impression paru sur #####
;###### le forum purebasic les 3 procedures d'impression suivantes #####
;#######################################################################
Procedure.s GetDefaultPrinter()
Name.s = Space ( #MAX_PATH )
GetProfileString_ ( "Windows" , "Device" , "" , @Name, 255)
ProcedureReturn Name
EndProcedure
Procedure PrintImage(Image, PrinterDC)
ImageID = ImageID (Image)
hdc = CreateCompatibleDC_ (0)
If hdc
bmi.BITMAPINFO
bm.BITMAP
GetObject_ ( ImageID (Image), SizeOf (BITMAP), @bm.BITMAP)
bmi\bmiHeader\biSize = SizeOf (BITMAPINFOHEADER)
bmi\bmiHeader\biWidth = bm\bmWidth
bmi\bmiHeader\biHeight = bm\bmHeight
bmi\bmiHeader\biPlanes = 1
bmi\bmiHeader\biBitCount = 32
bmi\bmiHeader\biCompression = #BI_RGB
w = GetDeviceCaps_ (PrinterDC, #HORZRES )
h = GetDeviceCaps_ (PrinterDC, #VERTRES )
HList = AllocateMemory (bm\bmWidth * bm\bmHeight * 4)
GetDIBits_ (hdc, ImageID (Image), 0, bm\bmHeight, HList, bmi, #DIB_RGB_COLORS )
StretchDIBits_ (PrinterDC, 0, 0, w, h, 0, 0, bm\bmWidth-1, bm\bmHeight-1, HList, bmi, #DIB_RGB_COLORS , #SRCCOPY )
FreeMemory (HList)
ReleaseDC_ (0, hdc)
EndIf
EndProcedure
Procedure impression()
Printer.s = GetDefaultPrinter()
PrintersName.s = StringField (Printer,1, "," )
If OpenPrinter_ (PrintersName, @PrinterHandle.l, 0) ; Retourne 0 si non OK
;######### code si l'on veut definir par avance un mode H V ###################
;BufferSize.l = DocumentProperties_ (0, PrinterHandle, PrintersName, 0, 0, 0)
;*DevBufferIn = AllocateMemory (BufferSize)
;*DevBufferOut = AllocateMemory (BufferSize)
; DocumentProperties_ (0, PrinterHandle, PrintersName, *DevBufferIn, *DevBufferOut, #DM_OUT_BUFFER | #DM_IN_BUFFER )
;*PrinterParameters.DEVMODE = *DevBufferIn
; ClosePrinter_ (PrinterHandle)
;*PrinterParameters\dmOrientation = 2 ; Paysage
;lpszPrinter.s = StringField (Printer,2, "," )
;PrinterDC.l = CreateDC_ (@lpszPrinter, PrintersName, 0, *PrinterParameters)
;##################### sinon le selecteur d'impression pour cela ################
; ajout d'un bout de code 6 lignes suivantes remerciement aussi a
; TerryHough - 14 Nov, 2005
; Based on code from Alberto in forums.purebasic.com/english
;################################################################################
PrnCap.PRINTDLG : PrnCap\lStructSize = SizeOf(PRINTDLG)
If PrintDlg_(@PrnCap)
*Mod.DEVMODE
*Mod = GlobalLock_(PrnCap\hDevMode)
GlobalFree_(hDevMode)
EndIf
;################################################################################
;### a la place *PrinterParameters prendre l adresse *mod ci-dessous ###########
;################################################################################
PrinterDC.l = CreateDC_ (@lpszPrinter, PrintersName, 0, *mod)
; FreeMemory(*DevBufferIn)
; FreeMemory(*DevBufferOut)
If PrinterDC <> 0 ; On peut imprimer
w = GetDeviceCaps_ (PrinterDC, #HORZRES )
h = GetDeviceCaps_ (PrinterDC, #VERTRES )
Size = 2000 ; Taille max de l'image vu que PureBasic ne supporte pas les grandes images
DocInf.DOCINFO
DocInf\cbSize = SizeOf (DOCINFO)
DocInf\lpszOutput = #Null
If w/h > h/w
WImg = Size
HImg = h*Size/w
DocInf\lpszDocName = @ "Impression en paysage"
Else
HImg = Size
WImg = w*Size/h
DocInf\lpszDocName = @ "Impression en portait"
EndIf
;#################################################################
;#################### position du dessin #####################
;#################################################################
no_imprime=1
axex = WImg-(WImg/2)
axey = HImg-(HImg/2)
If w/h > h/w
rayon = HImg/5
rmaison=rayon/1.5
tfont=HImg/25
Else
rayon = WImg/5
rmaison=rayon/1.5
tfont=WImg/25
EndIf
LoadFont(1,"astro",tfont,#PB_Font_Bold)
;########################## tracer ################################
Image = CreateImage ( #PB_Any , WImg, HImg)
If StartDoc_ (PrinterDC,@DocInf) > 0
If StartPage_ (PrinterDC) > 0 ; on dessine ce que l'on a envie
StartDrawing ( ImageOutput (Image))
dessin()
StopDrawing ()
PrintImage(Image, PrinterDC)
EndPage_ (PrinterDC)
EndIf
EndDoc_ (PrinterDC)
ReleaseDC_ (0, DC)
FreeImage(image)
StopPrinting()
EndIf
EndIf
EndIf
EndProcedure
Procedure MakeWinScreenshot(ImageNr,hWnd,Width,Height)
;###### appel place en amont pour l' utilisation de ######################
;###### la routine de sauvegarde du contenu de la fenetre ######################
; hShotWindow = FindWindow_(0,"ZODIAQUE IMPRESSION") ; enter the right name here!
; If hShotWindow
; hWinBmp = MakeWinScreenshot(0,hShotWindow, wlargeur, whauteur)
; ImageGadget(2,0,0, wlargeur, whauteur, hWinBmp)
; EndIf
;#####realisee par l'auteur cd dessous a qui j'adresse aussi mes remerciements ###
; Auteur: Danilo (updated for PB 4.00 by Andre)
; Date: 22. April 2003
hImage = CreateImage(ImageNr,Width,Height)
hDC = StartDrawing(ImageOutput(ImageNr))
BitBlt_(hDC,0,0,Width,Height,GetDC_(hWnd),0,0,#SRCCOPY)
StopDrawing()
ProcedureReturn hImage
EndProcedure
