mise à jours du 25 avril 2022 pour PB 5.73 LTS 64bits
petit exemple de texte circulaire gradué avec choix d' impression avec ou sans
dessin de papier millimétré
les curseurs de réglages sont prévus pour adapter la sortie papier ou calque à la bonne dimmension
car les imprimantes ont des resolutions de sortie avec des différences suivant les marques modeles etc...
J' utilise ce programme pour étudié les dessins mystiques et tableaux de maitres
avec une impression sur calques afin de le superposer celui-ci sur les reproductions
avec un cercle gradué de 20cm de diamètre R=10cm pour obtenir des calculs trigonométriques
en lien avec le mode degrès de ma calculette ce qui donnera une lecture directe en R10 , exemple
la corde d'un coté de l'èquilatéral inscrit qui est égale à la racine de 3 avec R10 = (17.32 cm)
la corde du carré inscrit qui seras egal la racine racine de 2 avec R10 = (14.14 cm)
toutes mesures trigonometriques en degrès : corde, sinus, cosinus, tangente, flèche, etc.
seront lisible sur la calculette et sur le double decimètre avec un Rayon 10 cm.
Cordialement
Code : Tout sélectionner
;#######################################################################################
;### Rapporteur par kernadec pb4 OS windows 01/07/2008 mis à jour en 2022/05 ####
;### pour les amateurs de tracer précis avec le compas sur papier ou calques ####
;#######################################################################################
Global cw.l,ch.l,rayon.l,rayonpixel.d,tfont.l,curseur.l,curseur1.l,x.d,y.d,x1.d,y1.d
Global wlargeur.l, whauteur.l,ImageNr,hdc,DC,r.RECT,rc,grille.d,grillepixel.d,u.d
Global Width.l,Color.l,wr.l,wb.l,cldm.l,clcm.l,clmm.l,wr,wb,wn,DepartNumTx
Declare init()
Declare ypage(x.f)
Declare xpage(x.f)
Declare papier(wr,wb,wn)
Declare dessin()
Declare fenetredessin()
Declare impression()
Declare MakeWinScreenshot(ImageNr,hwnd,Width,Height)
wlargeur=600
whauteur=600
rayonpixel=100 ;rayon du cercle en pixel 300 = rayon de 21cm /2 environ
grillepixel=270
DepartNumTx = 0
Procedure Ligne(x,y,x1,y1,Width,Color)
GetWindowRect_(WindowID(0),r.RECT)
pen=CreatePen_(#PS_SOLID,Width,Color) ; style : #Ps_dash, #Ps_dot,etc
penOld=SelectObject_(DC,pen)
MoveToEx_(DC,x,y,0):LineTo_(DC,x1,y1)
DeleteObject_(pen)
DeleteObject_(penOld)
EndProcedure
Procedure Cercle(x,y,x1,y1,Width,Color)
GetWindowRect_(WindowID(0),r.RECT)
pen=CreatePen_(#PS_DASH,Width,Color) ;style : #Ps_dash, #Ps_dot, etc
penOld=SelectObject_(DC,pen)
Ellipse_(DC,x,y,x1,y1)
DeleteObject_(pen)
DeleteObject_(penOld)
EndProcedure
Procedure DrawRText(DC.l,x,y,Text.s,fFont.s,fangle.l,fHeight)
;#####################################################################
; Procedure DrawRText Author: Andreas
; Date: 14. June 2003
;#####################################################################
Font = CreateFont_(fHeight,0,fangle*10,0,0,0,0,0,0,0,0,0,0,fFont)
GetWindowRect_(WindowID(0),r.RECT)
OldFont = SelectObject_(DC,Font)
SetTextAlign_(DC,#TA_BASELINE)
SetBkMode_(DC,#TRANSPARENT)
SetTextColor_(DC,RGB(0,0,255))
ExtTextOut_(DC, x,y,0 ,r,Text,Len(Text),0 )
SelectObject_(DC,OldFont)
DeleteObject_(Font)
EndProcedure
init() ; depart et boucle recursive
End
Procedure init()
If OpenWindow(1, 710, 50, 260,180, "Utiliser les Flèches pour Règler la Taille du Tracer",#PB_2DDrawing_Default)
cw=300
ch=300
grille=grillepixel
rayon=rayonpixel
tfont=rayonpixel/35
CreateImage(10, 78, 23)
StartDrawing(ImageOutput(10))
Box(0, 0, 80, 25 ,RGB(0,255,0))
DrawText(10, 3, "Imprimer" ,RGB(100,100,100),RGB(0,255,0))
StopDrawing()
CreateImage(11, 78, 23)
StartDrawing(ImageOutput(11))
Box(0, 0, 80, 25 ,RGB(255,0,0))
DrawText(17, 3, "Quitter" ,RGB(255,255,255),RGB(255,0,0))
StopDrawing()
StartDrawing(WindowOutput(1))
ButtonImageGadget(0,35, 140, 80, 25,ImageID(10))
ButtonImageGadget(3,150, 140, 80, 25,ImageID(11))
TrackBarGadget(1, 10, 25, 240, 20, 0,300, #PB_TrackBar_Ticks)
SetGadgetState(1, 286)
SetActiveGadget(1)
GadgetToolTip(1, "->Flèche<--Résolution d'Impression")
TrackBarGadget(6, 10, 80, 240, 20, 0,300, #PB_TrackBar_Ticks)
SetGadgetState(6, 286)
GadgetToolTip(6, "->Flèche<--Résolution d'Impression")
CheckBoxGadget(8, 50, 110, 80, 20, "Rapporteur")
SetGadgetState(8, 1)
GadgetToolTip(8, "Affiche Cercle Gradué")
CheckBoxGadget(9, 140, 110, 80, 20, "Quadrillage")
SetGadgetState(9, 0)
GadgetToolTip(9, "Affiche Papier millimétré")
curseur=GetGadgetState(1)
rayonpixel=curseur
rayon=rayonpixel
DrawText(15, 5,"Diamètre du Rapporteur : "+StrD((rayonpixel*0.035)*2,2)+"cm",RGB(0,0,0),RGB(224,223,227))
curseur1=GetGadgetState(6)
grillepixel=curseur1:
grille=grillepixel
DrawText(16, 60,"Dimension du Cadrillage : "+StrD((grillepixel*0.035001)*2,2)+"cm",RGB(0,0,0),RGB(224,223,227))
StopDrawing()
OpenWindow(0, 100, 50, wlargeur,whauteur, "Rapporteur - Kernadec 7/2008", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
DC=StartDrawing(WindowOutput(0))
If DC
DrawingMode(1)
If GetGadgetState(8)=1
dessin()
EndIf
If GetGadgetState(9)=1
papier(2,2,1)
EndIf
StopDrawing()
hShotWindow = FindWindow_(0,"Rapporteur - Kernadec 7/2008")
If hShotWindow
hWinBmp = MakeWinScreenshot(0,hShotWindow, wlargeur, whauteur)
ImageGadget(20,0,0, wlargeur, whauteur, hWinBmp)
EndIf
EndIf
StickyWindow(0, 1)
SetActiveWindow(1)
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Gadget
Select EventGadget()
Case 0
impression()
init()
Case 1
StartDrawing(WindowOutput(1))
curseur=GetGadgetState(1)
rayonpixel=curseur
rayon=rayonpixel
DrawText(15, 5,"Diamètre du Rapporteur :"+StrD((rayonpixel*0.035)*2,2)+"cm",RGB(0,0,0),RGB(224,223,227))
StopDrawing()
Case 3
CloseWindow(0)
CloseWindow(1)
End
Case 6
StartDrawing(WindowOutput(1))
curseur1=GetGadgetState(6)
grillepixel=curseur1:
grille=grillepixel
DrawText(15, 60,"Dimension du Cadrillage :"+StrD((grillepixel*0.035)*2,2)+"cm",RGB(0,0,0),RGB(224,223,227))
StopDrawing()
Case #PB_Event_CloseWindow
CloseWindow(0)
CloseWindow(1)
End
EndSelect
tfont=rayonpixel/35
DC=StartDrawing(WindowOutput(0))
If DC
Box(0,0,600,600,RGB(255,255,255))
If GetGadgetState(8)=1
dessin()
EndIf
If GetGadgetState(9)=1
papier(2,2,1)
EndIf
StopDrawing()
hShotWindow = FindWindow_(0,"Rapporteur - Kernadec 7/2008")
If hShotWindow
hWinBmp = MakeWinScreenshot(0,hShotWindow, wlargeur, whauteur)
ImageGadget(20,0,0, wlargeur, whauteur, hWinBmp)
EndIf
EndIf
EndSelect
Until EventID = #PB_Event_CloseWindow
EndIf
EndProcedure
Procedure impression()
If PrintRequester()
If StartPrinting("Rapporteur")
hDCl = StartDrawing(PrinterOutput())
w = GetDeviceCaps_ (hDCl, #HORZRES )
h = GetDeviceCaps_ (hDCl, #VERTRES )
If w/h > h/w ;definir otientation
rc=2 ;rapport page avec la racine de 2
Else
rc=1
EndIf
StopDrawing()
cw=xpage(300*0.035) ; =21cm /2
ch=ypage(425*0.035) ; =29.7cm /2
rayon=xpage((rayonpixel*0.035)/Sqr(rc)) ;rayon en cm
grille=xpage((grillepixel*0.035)/Sqr(rc))
tfont=rayon/37 ;taille police proportionelle a l'echelle de la page a imprimer
DC = StartDrawing(PrinterOutput())
If DC
DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_XOr)
DrawingMode(4|1)
If GetGadgetState(8)=1
dessin()
EndIf
If GetGadgetState(9)=1
papier(4,3,2)
EndIf
StopDrawing()
EndIf
EndIf
StopPrinting()
EndIf
EndProcedure
Procedure papier(wr,wb,wn)
x=cw:y=ch
x1=cw*2:y1=ch*2
u=0
cldm=RGB(175,125,5) ; RGB(255,0,0)
clcm=RGB(175,125,5) ; RGB(0,0,255)
clmm=RGB(175,125,5) ; jaune
Ligne(x,y1, x,0-y1,wr,cldm) ;axe v
Ligne(x1,y, 0-x1,y,wr,cldm) ;axe h
For i=1 To cw
u=u+(grille/100)
If i=0 Or i-Int(i/50)*50=0 Or i-Int(i/100)*100=0 Or i-Int(i/150)*150=0 Or i-Int(i/200)*200=0
Ligne(x+u,y, x+u,y1,wr,cldm)
Ligne(x,y+u, x1,y+u,wr,cldm)
Ligne(x-u,y, x-u,y1,wr,cldm)
Ligne(x,y+u, 0-x1,y+u,wr,cldm)
Ligne(x+u,y, x+u,0-y1,wr,cldm)
Ligne(x,y-u, x1,y-u,wr,cldm)
Ligne(x-u,y, x-u,0-y1,wr,cldm)
Ligne(x,y-u, 0-x1,y-u,wr,cldm)
ElseIf i-Int(i/10)*10=0
Ligne(x+u,y, x+u,y1,wb,clcm)
Ligne(x,y+u, x1,y+u,wb,clcm)
Ligne(x-u,y, x-u,y1,wb,clcm)
Ligne(x,y+u, 0-x1,y+u,wb,clcm)
Ligne(x+u,y, x+u,0-y1,wb,clcm)
Ligne(x,y-u, x1,y-u,wb,clcm)
Ligne(x-u,y, x-u,0-y1,wb,clcm)
Ligne(x,y-u, 0-x1,y-u,wb,clcm)
ElseIf i-Int(i/5)*5=0
Ligne(x+u,y, x+u,y1,wn,clcm)
Ligne(x,y+u, x1,y+u,wn,clcm)
Ligne(x-u,y, x-u,y1,wn,clcm)
Ligne(x,y+u, 0-x1,y+u,wn,clcm)
Ligne(x+u,y, x+u,0-y1,wn,clcm)
Ligne(x,y-u, x1,y-u,wn,clcm)
Ligne(x-u,y, x-u,0-y1,wn,clcm)
Ligne(x,y-u, 0-x1,y-u,wn,clcm)
Else
Ligne(x+u,y, x+u,y1,0,clmm)
Ligne(x,y+u, x1,y+u,0,clmm)
Ligne(x-u,y, x-u,y1,0,clmm)
Ligne(x,y+u, 0-x1,y+u,0,clmm)
Ligne(x+u,y, x+u,0-y1,0,clmm)
Ligne(x,y-u, x1,y-u,0,clmm)
Ligne(x-u,y, x-u,0-y1,0,clmm)
Ligne(x,y-u, 0-x1,y-u,0,clmm)
EndIf
Next
EndProcedure
Procedure dessin()
tfont=rayon/37 ;taille police proportionelle a l'echelle de la page a imprimer
FillArea(0,0,RGB(255,255,255), RGB(255,255,255))
DrawingMode(1)
FrontColor(RGB(255, 255, 255))
For n = 0 To 355 Step 5
If n>95 And n<180 ; n+90(Depart du 0) et 1.1 calage graduation avec et les nombres
x = cw + (rayon-tfont*3.5) * Sin(((n+DepartNumTx-1.5)+1.1) / 180 * #PI)
y = ch + (rayon-tfont*3.5) * Cos(((n+DepartNumTx-1.5)+1.1) / 180 * #PI)
DrawRText(DC,x,y,Str(n),"Arial",n+270,tfont) ;
ElseIf n<100
x = cw + (rayon-tfont*3) * Sin(((n+DepartNumTx-1)+0.55) / 180 * #PI)
y = ch + (rayon-tfont*3) * Cos(((n+DepartNumTx-1)+0.55) / 180 * #PI)
DrawRText(DC,x,y,Str(n),"Arial",n+270,tfont) ;
Else
x = cw + (rayon-tfont*2) * Sin(((n+DepartNumTx)+0.55) / 180 * #PI)
y = ch + (rayon-tfont*2) * Cos(((n+DepartNumTx)+0.55) / 180 * #PI)
DrawRText(DC,x,y,Str(n),"Arial",n+90,tfont) ;
EndIf
Next n
For o = 0 To 359 Step 30
x = cw+ rayon * Sin(o / 180 * #PI)
y = ch+ rayon * Cos(o / 180 * #PI)
xx = cw+ (rayon-rayon/17) * Sin(o / 180 * #PI)
yy = ch+ (rayon-rayon/17) * Cos(o / 180 * #PI)
LineXY(xx, yy , x, y,RGB(0, 0, 0))
x = cw+ (rayon-rayon/11) * Sin(o / 180 * #PI)
y = ch+ (rayon-rayon/11) * Cos(o / 180 * #PI)
xx = cw+ (rayon-rayon/3.414213562) * Sin(o / 180 * #PI)
yy = ch+ (rayon-rayon/3.414213562) * Cos(o / 180 * #PI)
LineXY(xx, yy , x, y,RGB(0, 0, 0))
For i = 1 To 29
If i = 5 Or i = 15 Or i = 25
x = cw+ rayon * Sin((i + o) / 180 * #PI)
y =ch+ rayon * Cos((i + o) / 180 * #PI)
xx = cw + (rayon-rayon/22) * Sin((i + o) / 180 * #PI)
yy = ch + (rayon-rayon/22) * Cos((i + o) / 180 * #PI)
LineXY(x, y , xx, yy, RGB(0, 0, 0))
ElseIf i = 10 Or i = 20
x = cw + rayon * Sin((i + o) / 180 * #PI)
y = ch+ rayon * Cos((i + o) / 180 * #PI)
xx = cw+ (rayon - rayon/16) * Sin((i + o) / 180 * #PI)
yy = ch+ (rayon - rayon/16) * Cos((i + o) / 180 * #PI)
LineXY(xx, yy , x, y,RGB(0, 0, 0))
Else
x = cw+rayon * Sin((i + o) / 180 * #PI)
y = ch+rayon * Cos((i + o) / 180 * #PI)
xx = cw+(rayon - rayon/33) * Sin((i + o) / 180 * #PI)
yy = ch+(rayon - rayon/33) * Cos((i + o) / 180 * #PI)
LineXY(xx, yy , x, y,RGB(0, 0, 0))
EndIf
Next i
Next o
LineXY(cw-rayon/20, ch , cw+rayon/20, ch,RGB(0, 0, 0))
LineXY(cw, ch-rayon/20 , cw, ch+rayon/20,RGB(0, 0, 0))
DrawingMode(4)
Ellipse(cw,ch, rayon, rayon, RGB(0,0,0))
Ellipse(cw,ch, rayon/Sqr(2), rayon/Sqr(2), RGB(0,0,0))
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,"Rapporteur") ; 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
Procedure xpage(x.f)
x = x * (PrinterPageWidth()/21) ; 21cm A4
ProcedureReturn x
EndProcedure
Procedure ypage(x.f)
x = x * (PrinterPageHeight()/29.7) ; 29,7cm A4
ProcedureReturn x
EndProcedure