Forum | | | | | 
H.Brill | Hi,
having nothing found. I bräuchte
so a 7Segment-display on my
dialog. moreover should I a vain
Bitmap create, hereon draw
and then in the dialog Show.
be but unfortunately not so graphic-
bewandert.
Have as a PureBasic Source found,
whom I gladly in XProfan umsetzen would like. |
| | | | 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. | 04/15/10 ▲ |
| | |
| |  | | Dou you mean Create("Bitmap ? |
| | | | | | |
| | 
ByteAttack | Moin,
wieso nmmst You do not simply a graphic with all 11 Zuständen next to each other (from,0,1,2,3,4,5,6,7,8,9) ladest into memory and copy then whom area simply on one Dialogelement? |
| | | | | | |
| |
ByteAttack | here time a graphic for you!
 |
| | | | | | |
| |
ByteAttack | SO! here time one simply example:
CompileMarkSeparationDeclare 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 | is Yes interestingly, but since must I
indeed different Bitmaps mitschleppen,
if I others colours having wants.
The point as Dezimaltrenner missing incidentally.
Have there on something like How in the attachment virtual.
could your time over my code look.
Have time attempts, whom PB-Code transfer,
but somewhere hakt it. is too yet so manches
rather To make, if I on Speicherbitmaps
think. be hold no so Grafiker.
PB-code :
CompileMarkSeparation; 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
my Profan Include :
CompileMarkSeparationDeclare 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
end solid 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
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& = 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 :
CompileMarkSeparation $I SevenSegment.inc
Declare presentment1&, presentment2&, 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)
presentment1& = @Create("hNewPic", 80, 120, RGB(255,255,255))
presentment2& = @Create("hNewPic", 80, 120, RGB(255,255,255))
bmp1& = Create("BITMAP",hD% ,presentment1&,80,120)
DrawSizedPic presentment1&, 220, 220 - 80, 120; 0
presentment1& = SevenSegmentLed(200,220,40,80,8404992,16776960,10485760)
presentment2& = SevenSegmentLed(250,220,40,80,4227072,65280,4210688)
SevenSegmentLedSet(1, 5)
Clear OK% OK% on 0 settle
WhileNot OK% as long as OK% same 0 is
WaitInput
If @Clicked(hB%)
OK% = 1
ElseIf %Key = 2
here becomes the X (right supra Closing) ausgewertet
OK% = 1
ElseIf @Clicked(info%)
Info Button pressed, it becomes a simple MessageBox issued.
name$ = @GetText$(Edit1%)
here becomes from the Editfeld the name red and in the Messagebox issued.
@MessageBox("Ich be the author : " + name$, "Info", 0)
<... others inquire and activities ...>
EndIf
EndWhile
Dialog-Window (incl Button, etc.) Remove
@DestroyWindow(hD%)
ENDPROC
here becomes The Dialogbox (Procedur) called
dialog
DisposeSegments
DeleteObject presentment1&
DeleteObject presentment2&
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. | 04/15/10 ▲ |
| | |
| |
ByteAttack | OK! here had I yet a suggestion as simply goes.
inquire whether under $WinPath+\Fonts The type DIGIT.TTF present is. unless simply there there copy...
and already play colours, Size, spots, Doppelpunkte, Bindestriche etc. no role More...
example:
CompileMarkSeparationSet("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
now should I only know, whether one too Fonts benefit can, The not windows installs are ! the would time interestingly to know !!! |
| | | | | | |
| | 
Thomas
Freier | it dürften but sufficient suitable Free Digifonts in the WEB present his. Z.B.: [...]  |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 04/21/10 ▲ |
| | |
| |
ByteAttack | Thomas suitor, Beitrag=56834, Zeitpunkt=21.04.2010
it dürften but sufficient suitable Free Digifonts in the WEB present his. Z.B.: [...]
apiece no - Is clear... question me only, whether one too TTF benefit can, The not installs are. Virtually over irgendeinen Access to The TTF-File directly. |
| | | | | | |
| | | @Marc: No, only to "windows"fonts... copied. ^^
for my savour power your the plenty To tricky.
simply Bitmapfonttexturmäßig (16*16 boxes in z.B. 512x512-Pixel-Image) and only to plainer XY-Formel rauskopieren - is too superfix or I have the target the Übung misread. ^^ |
| | | | | | |
| |
ByteAttack | Yes - it wants Yes no Graphics with itself rumschleppen ...  |
| | | | | | |
| | | | either malt it The Digits into hPic or it läd these into hPic - it can also one hPic produce and simply Bilddaten from memory therein take off with SetBitmapBits(hPic,pixelAnzahl,pixelSpeicher) How z.B. in the Pixels.Inc. with GetBitmapBits käme one too simply on The Pixeldaten heran, could one as .tex Save and Datengenerator integrate circa by SetBitmapBits against anzuweisen. ^^ |
| | | | | | |
|
AnswerTopic-Options | 11.181 Views |
Themeninformationenthis Topic has 5 subscriber: |
(529)
Deutsch
English
Français
Español
Italia
