PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

transparentes Stringgadget erstellen

https://www.purebasic.fr/german/viewtopic.php?t=22877

Seite 1 von 1

transparentes Stringgadget erstellen

Verfasst: 19.07.2010 17:55
von dysti
Hey,
habe schon wie wild gesucht, aber nichts gefunden.
Möchte auf ein größeres Image mehrere transparente Stringgadgets erstellen,
keine Textgadgets.
Ich hoffe, Ihr habt ein paar Hinweise,

Re: transparentes Stringgadget erstellen

Verfasst: 20.07.2010 12:14
von bobobo
warum ?

eventuell reicht ja übermalen mit WindowOutput() oder gleich auf das Image malen
eventuell ist dazu folgendes hilfreich

Code: Alles auswählen

; Diese Procedure ermöglicht es einen Text über mehere Zeilen zu schreiben und erlaubt sogar die Verwendung von chr(10)
Procedure DrawMultiLineText(x, y, width, height, Text$, Color)
  ; ©2007 by Scarabol
  If width > 0 And height > 0 And height > TextHeight(Text$)
    ; PosX und PosY speichern die StartPosition
    PosX = x
    PosY = y
    ; teilt den Text in Wörter anhand der Leerzeichen
    For i = 1 To CountString(Text$, " ")+1
      ; Wort für Wort zum Text hinzufügen
      SFT$ = StringField(Text$, i, " ")
      ; Prüfen ob das Wort schon über die angegebene Weite hinausragt
      If PosX+TextWidth(SFT$) > x+width
        ; wenn ja in neue Zeile springen
        PosX = x
        PosY+TextHeight(SFT$)
      EndIf
      ; Prüfen ob ein Zeilenumbruch im aktuellen Wort gefunden wurde
      If FindString(SFT$, Chr(10), 0)
        ; Wort bis zum Umbruch schreiben
        DrawText(PosX, PosY, StringField(SFT$, 1, Chr(10)), Color)
        ; in neue Zeile springen
        PosX = x
        PosY+TextHeight(SFT$)
        ; Wort nach dem Umbruch auswählen
        SFT$ = StringField(SFT$, 2, Chr(10))
      EndIf
      ; nach den eventuellen Zeilensprüngen prüfen ob nicht schon die Höhe erreicht ist
      ; wenn ja die Höhe als Ergebnis zurückgeben
      If PosY > y+height : ProcedureReturn PosY : EndIf
      PosX = DrawText(PosX, PosY, SFT$+" ", Color)
    Next
    ProcedureReturn PosY
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Re: transparentes Stringgadget erstellen

Verfasst: 21.07.2010 11:41
von dysti
Danke @bobobo,
auf dich ist immer Verlaß. :allright: Naja, das Thema ist ja auch nicht ganz trivial.
Das mit dem Image habe ich gelassen und ein Bild geladen. Habe folgende Lösung gefunden.
Nur eben mal hier im Forum anständig geklaut und zusammengeklickt.
Hier meine zusammengeklickte Rohfassung zum Lernen, ich denke, andere PB´ler können es evtl. auch gebrauchen:

Code: Alles auswählen

Enumeration ; Windows
  #Window_0
EndEnumeration
Enumeration ; Gadgets
  
  #TYW
  #EX
  #EY
  #EXW
  #EYW
  #T
  #X
  #Y
  #XW
  #YW
  #TX
  #TY
  #TXW
  
EndEnumeration

Global abfrage, mousecaree=0
Global Dim TextGadgetColors.l(5) 

Global TextGadgetBackground,TextGadgetForeground, Text_Background_Gelb,Text_Background_Gelb_off, Text_Background_Titel
UseJPEGImageDecoder()
myImage = LoadImage(0, "pinguin1.jpg") ; hier ein Bild laden
; --> create brush for our window background
windowBrush = CreatePatternBrush_(myImage)

; --> Use #HOLLOW_BRUSH (#NULL) brush for our StringGadget background
stringBrush = GetStockObject_(#HOLLOW_BRUSH)
 ; --> Set our window background brush (image)

 Text_Background_Gelb = CreateSolidBrush_($0000FFFF)
 Text_Background_Gelb_off = CreateSolidBrush_($00000000)
 Text_Background_Titel = CreateSolidBrush_($00008CFF)
TextGadgetBackground=GetStockObject_(#HOLLOW_BRUSH)
TextGadgetForeground=RGB($00,$00,$00)


Procedure TextGadget_Gelb_on(GadgetNr) 
   TextGadgetColors(GadgetNr) = 1 
   InvalidateRect_(GadgetID(GadgetNr),0,1)  
 EndProcedure 
Procedure TextGadget_Gelb_off(GadgetNr) 
   TextGadgetColors(GadgetNr) = 0
   InvalidateRect_(GadgetID(GadgetNr),0,1)  
EndProcedure 

Procedure WinProc(hWnd,Msg,wParam,lParam)
  If Msg=#WM_CTLCOLORSTATIC 
    
    Select lParam
    Case GadgetID(#T)                      
    SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
    ProcedureReturn Text_Background_Titel
      Case GadgetID(#TX)                    
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
    ProcedureReturn TextGadgetBackground
      Case GadgetID(#TY)                    
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
    ProcedureReturn TextGadgetBackground
    Case GadgetID(#TXW)                    
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
    ProcedureReturn TextGadgetBackground
    Case GadgetID(#TYW) 
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
    ProcedureReturn TextGadgetBackground
        Case GadgetID(#EX) 
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
      ProcedureReturn TextGadgetBackground
        Case GadgetID(#EY) 
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
      ProcedureReturn TextGadgetBackground
        Case GadgetID(#EXW) 
        SetBkMode_(wParam,#TRANSPARENT)
        SetTextColor_(wParam,TextGadgetForeground)
      ProcedureReturn TextGadgetBackground
        Case GadgetID(#EYW) 
        SetBkMode_(wParam,#TRANSPARENT)
    SetTextColor_(wParam,TextGadgetForeground)
      ProcedureReturn TextGadgetBackground
    EndSelect
  Else
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndIf
  
 
  
EndProcedure


Procedure threadsetcolorgadget(nr)

Repeat
  
  pxx=WindowMouseX(#Window_0)
  pyx=WindowMouseX(#Window_0)
  px=WindowMouseY(#Window_0)
  py=WindowMouseY(#Window_0)
  
  If py>=50 And py<=70 And pyx>=150 And pyx<=270
  HideGadget(#X,0)
Else
  SetGadgetText(#EX,GetGadgetText(#X))
  HideGadget(#X,1)
EndIf

  If py>=120 And py<=140 And pyx>=150 And pyx<=270
  HideGadget(#Y,0)
Else
  SetGadgetText(#EY,GetGadgetText(#Y))
  HideGadget(#Y,1)
  EndIf
  
  If py>=190 And py<=210 And pyx>=150 And pyx<=270
  HideGadget(#XW,0)
Else
  SetGadgetText(#EXW,GetGadgetText(#XW))
  HideGadget(#XW,1)
EndIf

  If py>=260 And py<=280 And pyx>=150 And pyx<=270
  HideGadget(#YW,0)
Else
  SetGadgetText(#EYW,GetGadgetText(#YW))
  HideGadget(#YW,1)
EndIf

  Delay(100)
  
Until quit
EndProcedure

  UseJPEGImageDecoder()
myImage = LoadImage(0, "F:\pinguin1.jpg") ;hier ein Bild laden
; --> create brush for our window background
windowBrush = CreatePatternBrush_(myImage)

; --> Use #HOLLOW_BRUSH (#NULL) brush for our StringGadget background
stringBrush = GetStockObject_(#HOLLOW_BRUSH)
 ; --> Set our window background brush (image)
  
  If OpenWindow(#Window_0, 50, 158, 321, 330, "Mouse X | Y", #PB_Window_SystemMenu | #PB_Window_TitleBar )
    
    SetClassLong_(WindowID(#Window_0),#GCL_HBRBACKGROUND,windowBrush)
    ;If CreateGadgetList(WindowID(#Window_0))
      TextGadget(#T, 80, 10, 180, 20, "         Mausabfrage zum Färben    ")
      SetGadgetColor(#T,#PB_Gadget_BackColor,$00008CFF)
      
      StringGadget(#X, 180, 50, 120, 20, "")
      StringGadget(#Y, 180, 120, 120, 20, "")
      StringGadget(#XW, 180, 190, 120, 20, "")
      StringGadget(#YW, 180, 260, 120, 20, "")
      SetGadgetColor(#X,#PB_Gadget_BackColor,$0000FFFF)
      SetGadgetColor(#y,#PB_Gadget_BackColor,$0000FFFF)
      SetGadgetColor(#XW,#PB_Gadget_BackColor,$0000FFFF)
      SetGadgetColor(#YW,#PB_Gadget_BackColor,$0000FFFF)
      HideGadget(#X,1)
      HideGadget(#Y,1)
      HideGadget(#XW,1)
      HideGadget(#YW,1)
        ;EndIf
  EndIf
      SetWindowCallback(@WinProc()) 
      TextGadget(#TX, 30, 50, 120, 20, "Feld 1")
      TextGadget(#TY, 30, 120, 120, 20, "Feld 2")
      TextGadget(#TXW, 30, 190, 120, 20, "Feld 3")
      TextGadget(#TYW, 30, 260, 120, 20, "Feld 4")
      TextGadget(#EX, 180, 50, 120, 20, "",#PB_Text_Border)
      TextGadget(#EY, 180, 120, 120, 20, "",#PB_Text_Border)
      TextGadget(#EXW, 180, 190, 120, 20, "",#PB_Text_Border)
      TextGadget(#EYW, 180, 260, 120, 20, "",#PB_Text_Border)
      CreateThread(@threadsetcolorgadget(),154)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

DeleteObject_(TextGadgetBackground)
Vielleicht haben Andere einfachere Ideen?

Re: transparentes Stringgadget erstellen

Verfasst: 21.07.2010 14:25
von bobobo
hmm .. irgendwie geht dein code nicht so recht ..sieht zuminest komsich aus

meins etwas weitergesponnen könnte so gehen
die texte reagieren auf den linken mausdoppelcklick
eine TextÄnderungsfunktion wäre noch zu basteln.
Da die Texte in Listen liegen , wird das nicht allzu komplex.
ich habe keinen pinguin gefunden also musste ich selber einen bauen

der vorteil wäre die momentane platformunabhängigkeit

Code: Alles auswählen

Enumeration
  #window
  #imagegadget
  #ImageOri
  #Image
EndEnumeration


CreateImage(#imageori,500,500)
StartDrawing(ImageOutput(#imageori))
  Box(0,0,500,500,#White):  FrontColor(#Black)
  Ellipse(250,300,100,150):  Ellipse(250,100,50,75)
  FrontColor(RGB(255,128,0)):  LineXY(220,100,280,100)
  LineXY(280,100,250,120):  LineXY(250,120,220,100)
  FillArea(250,105,RGB(255,128,0)):  Ellipse(230,75,10,20,#White)
  Ellipse(230,85,5,10,#Black):  Ellipse(270,75,10,20,#White)
  Ellipse(270,85,5,10,#Black):  LineXY(220,75,250,65,#Black)
  LineXY(280,75,250,65,#Black):  Ellipse(250,320,80,120,RGB(222,222,222))
  FrontColor(RGB(255,128,0))
  LineXY(202,434,150,440):  LineXY(150,440,183,446)
  LineXY(183,446,173,473):  LineXY(173,473,201,455)
  LineXY(201,455,215,479):  LineXY(215,479,203,434):
  FrontColor(RGB(255,128,0))
  FillArea(194,446,RGB(255,128,0))
  LineXY(282,444,262,478):  LineXY(262,478,277,464)
  LineXY(277,464,290,475):  LineXY(290,475,296,459)
  LineXY(296,459,317,459):  LineXY(317,459,282,444)
  FillArea(286,457,RGB(255,128,0))
StopDrawing()

OpenWindow(#window,0,0,500,500,"Fenster",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ImageGadget(#imagegadget,0,0,500,500,ImageID(#imageori))
Structure tt
  x.l
  y.l
  w.l
  h.l
  i.s
  fc.l
  bc.l
  s.l
EndStructure

NewList texte.tt()

For i= 0 To 500 Step 33
  AddElement(texte())
  texte()\x=20
  texte()\y=i
  texte()\i="Inhalt_"+Str(i/33)
  texte()\w=100
  texte()\h=20
  texte()\fc=RGB(255,0,0)
  texte()\s=0
Next i

ForEach texte()
  Debug texte()\i+" "+Str(texte()\x)+" "+ Str(texte()\y)+" "+ Str(texte()\w)+" "+Str(texte()\h)
Next

CopyImage(#imageori,#image)
StartDrawing(ImageOutput(#image))
  DrawImage(ImageID(#imageori),0,0)
  ForEach texte()
    If texte()\s
      DrawingMode(#PB_2DDrawing_Default)
      FrontColor(#Blue)
      BackColor(#Yellow)
    Else
      DrawingMode(#PB_2DDrawing_Transparent)
      FrontColor(#Red)
    EndIf
    DrawText(texte()\x,texte()\y,texte()\i)
  Next
StopDrawing()
SetGadgetState(#imagegadget,ImageID(#image))

Repeat
  event=WaitWindowEvent()
  eventgadget=EventGadget()
  eventtype=EventType()
  Select event
  Case #PB_Event_CloseWindow
    quit +1
  Case #PB_Event_Gadget
    Select eventgadget
    Case #imagegadget
      Debug "eehh!! Du hast das image gehauen"
      Debug Str(WindowMouseX(#window))+" "+Str(WindowMouseY(#window))
      Select eventtype
      Case #PB_EventType_LeftDoubleClick ;nur bei links doppelklick was machen
        ForEach texte()
          mx=WindowMouseX(#window)
          my=WindowMouseY(#window)
          If mx>=texte()\x And mx <=texte()\x+texte()\w And my>=texte()\y And my <=texte()\y+texte()\h
            texte()\s=1
          Else
            texte()\s=0
          EndIf
        Next
        CopyImage(#imageori,#image)
        StartDrawing(ImageOutput(#image))
          DrawImage(ImageID(#imageori),0,0)
          ForEach texte()
            If texte()\s
              DrawingMode(#PB_2DDrawing_Default)
              FrontColor(#Blue)
              BackColor(#Yellow)
            Else
              DrawingMode(#PB_2DDrawing_Transparent)
              FrontColor(#Red)
            EndIf
            DrawText(texte()\x,texte()\y,texte()\i)
          Next
        StopDrawing()
        SetGadgetState(#imagegadget,ImageID(#image))
        
      EndSelect
    Default
      
    EndSelect
  Default
  EndSelect
Until quit=1
End

Re: transparentes Stringgadget erstellen

Verfasst: 22.07.2010 20:09
von dysti
@bobobo, echt super. Jetzt haben wir beide Möglichkeiten.
Mit der Farbeinfärbung muß ich mal sehen.
Der Hintergrund müßte gesichert werden und dann färben.
Wenn die Maus ein bestimmtes Rechteck wieder verläßt, müßte dann der
Hintergrund wieder hergestellt werden.
Mit der Texteingabe muß ich mir auch noch was überlegen.

Den Pinguin finde ich süß.

Danke.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de