Italia
Foro

Bitmap sul dialogo

 

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 ?
 
15.04.2010  
 




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?
 
Website:  [...] 
Facebook:  [...] 
15.04.2010  
 




ByteAttack
Hier mal eine Grafik per Dich!


73 kB
Hochgeladen:15.04.2010
Downloadcounter115
Download
 
Website:  [...] 
Facebook:  [...] 
15.04.2010  
 




ByteAttack
SO! Hier mal ein einfach Beispiel:
KompilierenMarkierenSeparieren
Declare 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

594 kB
Hochgeladen:15.04.2010
Downloadcounter89
Download
 
Website:  [...] 
Facebook:  [...] 
15.04.2010  
 




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 :
KompilierenMarkierenSeparieren
Declare 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

554 kB
Hochgeladen:15.04.2010
Downloadcounter100
Download
 
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:
KompilierenMarkierenSeparieren
Set("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 !!!

4 kB
Hochgeladen:21.04.2010
Downloadcounter47
Download
19 kB
Hochgeladen:21.04.2010
Downloadcounter95
Download
 
Website:  [...] 
Facebook:  [...] 
21.04.2010  
 




Thomas
Freier
Es dürften aber genügend geeignete Free Digifonts im WEB vorhanden sein. Z.B.: [...] 
 
Gruß Thomas
Windows XP SP2, XProfan X2
21.04.2010  
 




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.
 
Website:  [...] 
Facebook:  [...] 
21.04.2010  
 



@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. ^^
 
21.04.2010  
 




ByteAttack
Ja - Er will ja keine Grafiken mit sich rumschleppen ...
 
Website:  [...] 
Facebook:  [...] 
21.04.2010  
 



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. ^^
 
21.04.2010  
 




Answer


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

11.161 Views

Untitledvor 0 min.
E.T.25.06.2023
Christof Neuß11.07.2018
ByteAttack05.08.2015
Magda06.09.2014
Di più...

Themeninformationen



Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie