Forum | | | | H.Brill | Salut, hatte rien trouvé. je bräuchte so une 7Segment-Anzeige sur meinem Dialog. en supplément devrait je une le vide Bitmap erstellen, puis zeichnen et ensuite im Dialog Montrer.
suis mais malheureusement pas so Grafik- bewandert.
Hab là une PureBasic Quellcode trouvé, den je volontiers dans XProfan umsetzen voudrais. |
| | | Benutze XPROFAN X3 + FREEPROFAN Wir sind die XProfaner. Sie werden von uns assimiliert. Widerstand ist zwecklos! Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.
Was die Borg können, können wir schon lange. | 15.04.2010 ▲ |
| |
| | | | | | | |
| | ByteAttack | Moin,
wieso nmmst Du pas simple une Grafik avec allen 11 États nebeneinander (Aus,0,1,2,3,4,5,6,7,8,9) ladest dans den grenier et kopierst ensuite den Bereich simple sur un Dialogelement? |
| | | | |
| | ByteAttack | ici la fois une Grafik pour toi!
|
| | | | |
| | ByteAttack | SO! ici la fois un simple Beispiel: KompilierenMarqueSéparationDeclare Dlg&
Proc Draw7Seg
Parameters number$
Declare 1$,2$,3$,1%,2%,3%
1$=Left$(number$,1)
2$=Mid$(number$,2,1)
3$=Right$(number$,1)
1%=Val(1$)+1
2%=Val(2$)+1
3%=Val(3$)+1
StartPaint Dlg&
MCopyBmp 118*1%,0-118,156 > 10,10;0
MCopyBmp 118*2%,0-118,156 > 130,10;0
MCopyBmp 118*3%,0-118,156 > 250,10;0
EndPaint
EndProc
WindowStyle 24
WindowTitle "Hauptfenster %hwnd"
Window 10,10-200,100
cls 0
MLoadBmp $ProgDir+"7SEG.BMP"
Dlg&=Create("Dialog",%hwnd,"Dialogfenster",((%maxX/2)-192),((%maxY/2)-103),384,206)
StartPaint Dlg&
cls 0
MCopyBmp 0,0-118,156 > 10,10;0
MCopyBmp 0,0-118,156 > 130,10;0
MCopyBmp 0,0-118,156 > 250,10;0
EndPaint
Draw7Seg "012"
Waitmouse
|
| | | | |
| | H.Brill | Ist oui intéressant, mais là doit je oui aussi verschiedene Bitmaps mitschleppen, si je autre Farben avons veux. qui Punkt comme Dezimaltrenner fehlt incidemment.
Hab là à quelque chose comme comment im Anhang gedacht.
Könntet son la fois sur meinen Code regarder. Hab la fois versucht, den PB-Code trop übertragen, mais irgendwo hakt es. Ist aussi encore so manches besser trop faire, si je à Speicherbitmaps denke. suis arrêt ne...aucune so Grafiker.
PB-Code : KompilierenMarqueSéparation; PureBasic 4.40
; Idea from Localmotion34
; De préférence utilisez un gadget ayant un rapport de 11 * 13 ex 110 / 130
EnableExplicit
Structure SevenSegmentLed
x.l
y.l
width.l
height.l
Image.l
Gadget.l
value.l
point.l
color1.l
color2.l
BackgroundColor.l
EndStructure
;{ Datasection
DataSection
Led:
; Segment a
Data.l 1,1,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment g
Data.l 1,6,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment d
Data.l 1,11,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment f
Data.l 1,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment b
Data.l 9,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment e
Data.l 1,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment c
Data.l 9,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Point
Data.l 10,11,1,1,-1,1,-1,-1,1,-1,0,0
; Fin dessin Leds
Data.l 0,0
SegmentA:
Data.l 5,1
SegmentB:
Data.l 9,3
SegmentC:
Data.l 9,8
SegmentD:
Data.l 5,11
SegmentE:
Data.l 1,9
SegmentF:
Data.l 1,4
SegmentG:
Data.l 5,6
SegmentP:
Data.l 10,12
EndDataSection
;}
ProcedureDLL SevenSegmentLed(BildId.l, x,y,width,height,color1,color2,BackgroundColor)
; Initialise the LinkedList the first call
Static Init
If Init=0
Global NewList SevenSegmentLedLList.SevenSegmentLed()
EndIf
Init=1
; Fill the Structure
AddElement(SevenSegmentLedLList())
SevenSegmentLedLList()x=x
SevenSegmentLedLList()y=y
SevenSegmentLedLList()width=width
SevenSegmentLedLList()height=height
SevenSegmentLedLList()color1=color1
SevenSegmentLedLList()color2=color2
SevenSegmentLedLList()BackgroundColor=BackgroundColor
SevenSegmentLedLList()Image=CatchImage(#PB_Any,BildId)
Protected PWidth.f=SevenSegmentLedLList()width/11
Protected PHeight.f=SevenSegmentLedLList()height/13
;/ Dessine les Leds
;UseImage(SevenSegmentLedLList()Image)
StartDrawing(ImageOutput(SevenSegmentLedLList()Image))
Box(0,0,SevenSegmentLedLList()width,SevenSegmentLedLList()height,SevenSegmentLedLList()BackgroundColor)
Restore Led
Repeat
Read.l x
Read.l y
If x=0 And y=0 : Break : EndIf
Protected a.l, b.l
Repeat
Read.l a
Read.l b
If a=0 And b=0 : Break : EndIf
;Line(x*PWidth,y*PHeight,a*PWidth,b*PHeight,color1)
LineXY(x*PWidth,y*PHeight,x*PWidth + a*PWidth,y*PHeight + b*PHeight,color1)
x=x+a : y=y+b
ForEver
ForEver
StopDrawing()
; create the gadget & show the image
SevenSegmentLedLList()Gadget=ImageGadget(#PB_Any,SevenSegmentLedLList()x,SevenSegmentLedLList()y,width,height,ImageID(SevenSegmentLedLList()Image),#PB_Image_Border)
; Return the gadget id
ProcedureReturn ListIndex(SevenSegmentLedLList())
EndProcedure
ProcedureDLL SevenSegmentLedSet(id,value)
SelectElement(SevenSegmentLedLList(),id)
SevenSegmentLedLList()value=value
Protected PWidth.f=SevenSegmentLedLList()width/11
Protected PHeight.f=SevenSegmentLedLList()height/13
;/ Allume les Segments
;UseImage(SevenSegmentLedLList()Image)
StartDrawing(ImageOutput(SevenSegmentLedLList()Image))
; Eteind les segments
Restore SegmentA
Protected n
Protected a.l, b.l
Protected temp.s
For n=1 To 8
Read.l a
Read.l b
FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()color1,SevenSegmentLedLList()BackgroundColor)
Next
Select value
Case 0
temp.s="abcdef"
Case 1
temp="bc"
Case 2
temp="abged"
Case 3
temp="abgcd"
Case 4
temp="fbgc"
Case 5
temp="afgcd"
Case 6
temp="afedgc"
Case 7
temp="abc"
Case 8
temp="abcdefg"
Case 9
temp="abcdfg"
EndSelect
; Gestion du point
If SevenSegmentLedLList()point=1
temp+"p"
EndIf
For n=1 To Len(temp)
Select Mid(temp,n,1)
Case "a"
Restore SegmentA
Case "b"
Restore SegmentB
Case "c"
Restore SegmentC
Case "d"
Restore SegmentD
Case "e"
Restore SegmentE
Case "f"
Restore SegmentF
Case "g"
Restore SegmentG
Case "p"
Restore SegmentP
EndSelect
Read.l a
Read.l b
FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()color1,SevenSegmentLedLList()color2)
Next
StopDrawing()
SetGadgetState(SevenSegmentLedLList()Gadget,ImageID(SevenSegmentLedLList()Image))
EndProcedure
ProcedureDLL SevenSegmentLedGet(id)
SelectElement(SevenSegmentLedLList(),id)
ProcedureReturn SevenSegmentLedLList()value
EndProcedure
Procedure SevenSegmentLedEvent(id)
SelectElement(SevenSegmentLedLList(),id)
ProcedureReturn SevenSegmentLedLList()Gadget
EndProcedure
ProcedureDLL SevenSegmentLedPoint(id,light)
SelectElement(SevenSegmentLedLList(),id)
SevenSegmentLedLList()light
EndProcedure
mon Profan Include : KompilierenMarqueSéparationDéclarer SevensegmentLed#, Led#, SegmentA#, SegmentB#, SegmentC#, SegmentD#, SegmentE#, SegmentF#, SegmentG#, SegmentP#
Déclarer bmp1&, zaehler%
Déclarer barray#[10]
Struct ssegmentLed = x%, y%, width%, height%, image&, gadget&, value&, point&, color1&, color2&, backgroundcolor&
Faible SevensegmentLed#, ssegmentLed
Faible barray#[], ssegmentLed
Faible Led#, 504
Faible SegmentA#,8
Faible SegmentB#,8
Faible SegmentC#,8
Faible SegmentD#,8
Faible SegmentE#,8
Faible SegmentF#,8
Faible SegmentG#,8
Faible SegmentP#,8
Proc InitSegments
Segment a
Long Led#,0 = 1,1,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
Segment g
Long Led#,64 = 1,6,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
Segemnt d
Long Led#,128 = 1,11,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
Segemnt f
Long Led#,192 = 1,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
Segment b
Long Led#,256 = 9,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
Segemnt e
Long Led#,320 = 1,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
Segemnt c
Long Led#,384 = 9,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
Point
Long Led#,448 = 10,11,1,1,-1,1,-1,-1,1,-1,0,0
Ende Design Led
Long Led#,496 = 0,0
Long SegmentA#,0 = 5,1
Long SegmentB#,0 = 9,3
Long SegmentC#,0 = 9,8
Long SegmentD#,0 = 5,11
Long SegmentE#,0 = 1,9
Long SegmentF#,0 = 1,4
Long SegmentG#,0 = 5,6
Long SegmentP#,0 = 10,12
zaehler% = 0
ENDPROC
Proc DisposeSegments
DeleteObject SevensegmentLed#.image&
DeleteObject bmp1&
Dispose SevensegmentLed#, Led#, SegmentA#, SegmentB#, SegmentC#, SegmentD#, SegmentE#, SegmentF#, SegmentG#, SegmentP#
Dispose barray#[]
ENDPROC
Proc SevenSegmentLed
Paramètres x%, y%, width%, height%, color1&, color2&, Backgroundcolor&
Déclarer pwidth%, pheight%, mx%, my%, k%, a%, b%
k% = 0
With SevensegmentLed#
.x% = x%
.y% = y%
.width% = width%
.height% = height%
.color1& = color1&
.color2& = color2&
.Backgroundcolor& = Backgroundcolor&
.image& = @Créer("hNewPic", width%, height%, Backgroundcolor&)
.Gadget& = Créer("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
Endwith
barray#[zaehler%] = SevensegmentLed#
Début de peinture -1
pwidth% = width% / 11
pheight% = height% / 13
bmp1& = Créer("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
UseBrush 1, SevensegmentLed#.Backgroundcolor&
Rectangle SevensegmentLed#.x%, SevensegmentLed#.y% - SevensegmentLed#.width%, SevensegmentLed#.height%
Tandis que 1
mx% = @Long(Led#, k%)
my% = @Long(Led#, k% + 4)
Cas (mx% = 0 And my% = 0) : Pause
Tandis que 1
a% = @Long(Led#, k% + 4)
b% 0 @Long(Led#, k% + 8)
Cas (a% = 0 And b% = 0) : Pause
USEP 0, 5, SevensegmentLed#.color1&
Line mx% * pwidth%, my% * pheight% - mx% * pwidth% + a% * pwidth%, my% * pheight% + b% * pheight%
mx% = mx% a%
my% = my% + b%
Endwhile
k% = k% + 4
Endwhile
EndPaint
Inc zaehler%
bmp1& = Créer("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
Retour SevensegmentLed#.Gadget&
ENDPROC
Proc SevenSegmentLedSet
Paramètres id%, value&
Déclarer pwidth%, pheight%, a%, b%, n%, temp$
Si id% < 9
barray#[id%].value& = value&
pwidth% = barray#[id%].width% / 11
pheight% = barray#[id%].height% / 13
bmp1& = SevensegmentLed#.image&
Début de peinture image&
WhileLoop 1, 8
a% = @Long(SegmentA#, 0)
b% = @Long(SegmentA#, 4)
Fill a% *pwidth%, b% * pheight%, barray#[id%].color1&
Endwhile
Select value&
CaseOf 0
temp$ = "abcdef"
CaseOf 1
temp$ = "bc"
CaseOf 2
temp$ = "abged"
CaseOf 3
temp$ = "abgcd"
CaseOf 4
temp$ = "fbgc"
CaseOf 5
temp$ = "afgcd"
CaseOf 6
temp$ = "afedgc"
CaseOf 7
temp$ = "abc"
CaseOf 8
temp$ = "abcdefg"
CaseOf 9
temp$ = "abcdfg"
EndSelect
Si barray#[id%].point& = 1
temp$ = temp$ + "p"
Endif
WhileLoop 1, Len(temp$)
Select Mid $(temp$, &LOOP, 1)
CaseOf "a"
a% = @Long(SegmentA#, 0)
b% = @Long(SegmentA#, 4)
CaseOf "b"
a% = @Long(SegmentB#, 0)
b% = @Long(SegmentB#, 4)
CaseOf "c"
a% = @Long(SegmentC#, 0)
b% = @Long(SegmentC#, 4)
CaseOf "d"
a% = @Long(SegmentD#, 0)
b% = @Long(SegmentD#, 4)
CaseOf "e"
a% = @Long(SegmentE#, 0)
b% = @Long(SegmentE#, 4)
CaseOf "f"
a% = @Long(SegmentF#, 0)
b% = @Long(SegmentF#, 4)
CaseOf "g"
a% = @Long(SegmentG#, 0)
b% = @Long(SegmentG#, 4)
CaseOf "p"
a% = @Long(SegmentP#, 0)
b% = @Long(SegmentP#, 4)
EndSelect
Fill a% * pwidth%, b% * pheight%, barray#[id%].color2&
Endwhile
EndPaint
Endif
ENDPROC
Proc SevenSegmentLedPoint
Paramètres id%, light&
barray#[id%].point& = light&
ENDPROC
Testprogramm : KompilierenMarqueSéparation $I SevenSegment.inc
Déclarer bild1&, bild2&, hD%
InitSegments
Proc Dialog
Déclarer hB%, info%, Éditer1%, Label1%, OK%, nom$
hD% = @Créer("Dialog",%DeskTop,"Dialogfenster",100,100,600,400)
hB% = @Créer("Button",hD%,"&ENDE",10,10,60,25)
info% = @Créer("Button", hD%, "&Info", 100, 10, 60, 25)
Label1% = @Créer("Text", hD%, "Name : ", 10 ,50, 60, 20)
Éditer1% = @Créer("Edit", hD%, "Text", 70, 50, 240, 20)
bild1& = @Créer("hNewPic", 80, 120, RGB(255,255,255))
bild2& = @Créer("hNewPic", 80, 120, RGB(255,255,255))
bmp1& = Créer("BITMAP",hD% ,bild1&,80,120)
DrawSizedPic bild1&, 220, 220 - 80, 120; 0
bild1& = SevenSegmentLed(200,220,40,80,8404992,16776960,10485760)
bild2& = SevenSegmentLed(250,220,40,80,4227072,65280,4210688)
SevenSegmentLedSet(1, 5)
Claire OK% OK% sur 0 mettons
WhileNot Ok% solange OK% juste 0 ist
WaitInput
Si @Clicked(hB%)
Ok% = 1
ElseIf %Key = 2
ici wird cela X (à droite dessus Schließen) ausgewertet
OK% = 1
ElseIf @Clicked(info%)
Info Button gedrückt, es wird une simple MessageBox ausgegeben.
nom$ = @GetText $(Éditer1%)
ici wird aus dem Modifier le champ de qui nom gelesen et dans qui Messagebox ausgegeben.
@MessageBox("Ich suis qui Autor : " + nom$, "Info", 0)
<... autre Abfragen et Aktionen ...>
EndIf
Endwhile
Dialogfenster (incl. Button, usw.) entfernen
@DestroyWindow(hD%)
ENDPROC
ici wird qui Dialogbox (Procedur) aufgerufen
Dialog
DisposeSegments
DeleteObject bild1&
DeleteObject bild2&
Fin
|
| | | Benutze XPROFAN X3 + FREEPROFAN Wir sind die XProfaner. Sie werden von uns assimiliert. Widerstand ist zwecklos! Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.
Was die Borg können, können wir schon lange. | 15.04.2010 ▲ |
| |
| | ByteAttack | OK! ici hätte je encore une Vorschlag comme simple allez.
Anfragen si sous $WinPath+\Fonts qui Schriftart DIGIT.TTF vorhanden ist. si pas simple là hin kopieren...
et déjà spielen Farben, Taille, Punkte, Doppelpunkte, Bindestriche etc. aucun rôle plus...
Beispiel: KompilierenMarqueSéparationSet("TrueColor",1)
WindowStyle 24
WindowTitle "Digit"
Window ((%maxX/2)-320),((%maxY/2)-140)-640,280
CLS 0
UseFont "Digit",100,0,0,0,0
TextColor RGB(0,255,0),-1
DrawText 10,10,"0123456789"
TextColor RGB(255,0,0),-1
DrawText 10,120,"01:23 - 4.5."
Wai
maintenant devrait je seulement savons, si on aussi Schriftarten nutzen peux, qui pas dans Windows installiert sommes ! cela wäre la fois intéressant trop savons !!! |
| | | | |
| | Thomas Freier | Es dürften mais genügend geeignete Free Digifonts im WEB vorhanden son. Z.B.: [...] |
| | | | |
| | ByteAttack | Thomas Freier, Beitrag=56834, Zeitpunkt=21.04.2010
Es dürften mais genügend geeignete Free Digifonts im WEB vorhanden son. Z.B.: [...]
Je nee - Is bien sûr... Frage mich seulement, si on aussi TTF nutzen peux, qui pas installiert sommes. Pratiquement sur irgendeinen Zugriff sur qui TTF-Dossier direct. |
| | | | |
| | | @Marc: non, seulement pour "windows"fonts... kopierte. ^ ^
Pour meinen Geschmack pouvoir son cela viel trop compliqué.
simple Bitmapfonttexturmäßig (16*16 Felder dans z.B. 512x512-Pixel-Bild) et seulement pour einfacher XY-Formel rauskopieren - ist aussi superfix ou bien j'ai cela but qui Übung missverstanden. ^ ^ |
| | | | |
| | ByteAttack | oui - il veut oui aucun Grafiken avec sich rumschleppen ... |
| | | | |
| | | Entweder malt il qui Digits dans un hPic ou bien il läd cet dans un hPic - il peut aussi un hPic erzeugen et simple Bilddaten aus dem grenier y enlever avec SetBitmapBits(hPic,pixelAnzahl,pixelSpeicher) comment z.B. dans qui Pixels.Inc. avec GetBitmapBits käme on aussi simple à qui Pixeldaten heran, pourrait on comme .tex Sauver et Datengenerator einbinden um per SetBitmapBits wiederum anzuweisen. ^ ^ |
| | | | |
|
répondreOptions du sujet | 11.231 Views |
Themeninformationencet Thema hat 5 participant: |