Foro | | | | H.Brill | Ciao, hatte nichts gefunden. Ich bräuchte so eine 7Segment-Anzeige auf meinem Dialog. Dazu müßte ich eine leere Bitmap erstellen, darauf zeichnen und dann im Dialog Mostra.
Bin aber leider nicht so Grafik- bewandert.
Hab da einen PureBasic Quellcode gefunden, den ich gerne in XProfan umsetzen möchte. |
| | | 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 ▲ |
| |
| | | Meinst Du Create("Bitmap ? |
| | | | |
| | ByteAttack | Moin,
wieso nmmst Du nicht einfach eine Grafik mit allen 11 Zuständen nebeneinander (Aus,0,1,2,3,4,5,6,7,8,9) ladest in den Speicher und kopierst dann den Bereich einfach auf ein Dialogelement? |
| | | | |
| | ByteAttack | Hier mal eine Grafik per Dich!
|
| | | | |
| | ByteAttack | SO! Hier mal ein einfach Beispiel: KompilierenMarkierenSeparierenDeclare 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 ja interessant, aber da muß ich ja auch verschiedene Bitmaps mitschleppen, wenn ich andere Farben haben will. Der Punkt als Dezimaltrenner fehlt übrigens.
Hab da an sowas wie im Anhang gedacht.
Könntet ihr mal circa meinen Code schauen. Hab mal versucht, den PB-Code zu übertragen, aber irgendwo hakt es. Ist auch noch so manches besser zu machen, wenn ich an Speicherbitmaps denke. Bin halt kein so Grafiker.
PB-Code : KompilierenMarkierenSeparieren; 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
meine Profan Include : KompilierenMarkierenSeparierenDeclare SevensegmentLed#, Led#, SegmentA#, SegmentB#, SegmentC#, SegmentD#, SegmentE#, SegmentF#, SegmentG#, SegmentP#
Declare bmp1&, zaehler%
Declare barray#[10]
Struct ssegmentLed = x%, y%, width%, height%, image&, gadget&, value&, point&, color1&, color2&, backgroundcolor&
Dim SevensegmentLed#, ssegmentLed
Dim barray#[], ssegmentLed
Dim Led#, 504
Dim SegmentA#,8
Dim SegmentB#,8
Dim SegmentC#,8
Dim SegmentD#,8
Dim SegmentE#,8
Dim SegmentF#,8
Dim SegmentG#,8
Dim 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
Parameters x%, y%, width%, height%, color1&, color2&, Backgroundcolor&
Declare 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& = @Create("hNewPic", width%, height%, Backgroundcolor&)
.Gadget& = Create("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
Endwith
barray#[zaehler%] = SevensegmentLed#
StartPaint -1
pwidth% = width% / 11
pheight% = height% / 13
bmp1& = Create("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
UseBrush 1, SevensegmentLed#.Backgroundcolor&
Rectangle SevensegmentLed#.x%, SevensegmentLed#.y% - SevensegmentLed#.width%, SevensegmentLed#.height%
While 1
mx% = @Long(Led#, k%)
my% = @Long(Led#, k% + 4)
Case (mx% = 0 And my% = 0) : Break
While 1
a% = @Long(Led#, k% + 4)
b% 0 @Long(Led#, k% + 8)
Case (a% = 0 And b% = 0) : Break
UsePen 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& = Create("BITMAP",hD% ,SevensegmentLed#.image&, width%, height%)
Return SevensegmentLed#.Gadget&
EndProc
Proc SevenSegmentLedSet
Parameters id%, value&
Declare pwidth%, pheight%, a%, b%, n%, temp$
If id% < 9
barray#[id%].value& = value&
pwidth% = barray#[id%].width% / 11
pheight% = barray#[id%].height% / 13
bmp1& = SevensegmentLed#.image&
StartPaint 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
If 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
Parameters id%, light&
barray#[id%].point& = light&
EndProc
Testprogramm : KompilierenMarkierenSeparieren $I SevenSegment.inc
Declare bild1&, bild2&, hD%
InitSegments
Proc Dialog
Declare hB%, info%, Edit1%, Label1%, OK%, Name$
hD% = @Create("Dialog",%DeskTop,"Dialogfenster",100,100,600,400)
hB% = @Create("Button",hD%,"&ENDE",10,10,60,25)
info% = @Create("Button", hD%, "&Info", 100, 10, 60, 25)
Label1% = @Create("Text", hD%, "Name : ", 10 ,50, 60, 20)
Edit1% = @Create("Edit", hD%, "Text", 70, 50, 240, 20)
bild1& = @Create("hNewPic", 80, 120, RGB(255,255,255))
bild2& = @Create("hNewPic", 80, 120, RGB(255,255,255))
bmp1& = Create("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)
Clear OK% OK% auf 0 setzen
WhileNot Ok% solange OK% gleich 0 ist
WaitInput
If @Clicked(hB%)
Ok% = 1
ElseIf %Key = 2
Hier wird das X (rechts oben Schließen) ausgewertet
OK% = 1
ElseIf @Clicked(info%)
Info Button gedrückt, es wird eine einfache MessageBox ausgegeben.
Name$ = @GetText$(Edit1%)
Hier wird aus dem Editfeld der Name gelesen und in der Messagebox ausgegeben.
@MessageBox("Ich bin der Autor : " + Name$, "Info", 0)
<... andere Abfragen und Aktionen ...>
EndIf
EndWhile
Dialogfenster (incl. Button, usw.) entfernen
@DestroyWindow(hD%)
EndProc
Hier wird die Dialogbox (Procedur) aufgerufen
Dialog
DisposeSegments
DeleteObject bild1&
DeleteObject bild2&
End
|
| | | 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! Hier hätte ich noch einen Vorschlag wie es einfach geht.
Anfragen ob unter $WinPath+\Fonts die Schriftart DIGIT.TTF vorhanden ist. Wenn nicht einfach dort hin kopieren...
Und schon spielen Farben, Dimensione, Punkte, Doppelpunkte, Bindestriche etc. keine Rolle mehr...
Beispiel: KompilierenMarkierenSeparierenSet("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
Jetzt müsste ich nur wissen, ob man auch Schriftarten nutzen kann, die nicht in Windows installiert sind ! Das wäre mal interessant zu wissen !!! |
| | | | |
| | Thomas Freier | Es dürften aber genügend geeignete Free Digifonts im WEB vorhanden sein. Z.B.: [...] |
| | | | |
| | ByteAttack | Thomas Freier, Beitrag=56834, Zeitpunkt=21.04.2010
Es dürften aber genügend geeignete Free Digifonts im WEB vorhanden sein. Z.B.: [...]
Je nee - Is klar... Frage mich nur, ob man auch TTF nutzen kann, die nicht installiert sind. Quasi circa irgendeinen Zugriff auf die TTF-File direkt. |
| | | | |
| | | @Marc: Nein, nur nach "windows"fonts... kopierte. ^^
Für meinen Geschmack macht ihr das viel zu kompliziert.
Einfach Bitmapfonttexturmäßig (16*16 Felder in z.B. 512x512-Pixel-Bild) und nur nach einfacher XY-Formel rauskopieren - ist auch superfix oder ich habe das Ziel der Übung missverstanden. ^^ |
| | | | |
| | ByteAttack | Ja - Er will ja keine Grafiken mit sich rumschleppen ... |
| | | | |
| | | Entweder malt er die Digits in ein hPic oder er läd diese in ein hPic - er kann auch ein hPic erzeugen und einfach Bilddaten aus dem Speicher darin ablegen mit SetBitmapBits(hPic,pixelAnzahl,pixelSpeicher) wie z.B. in der Pixels.Inc. Mit GetBitmapBits käme man auch einfach an die Pixeldaten heran, potuto man als .tex speichern und mit Datengenerator einbinden um per SetBitmapBits wiederum anzuweisen. ^^ |
| | | | |
|
AnswerTopic-Options | 11.162 Views |
ThemeninformationenDieses Thema hat 5 subscriber: |