Button mit Icon und Text

[Donald]

Hi,
gibt es eine Routine mit der man in einem Button ein Icon und einen
Text (String) einblenden kann.
Wahlweise:

Icon links - Text rechts und umgekehrt ?
Icon oben - Text unten und umgekehrt ?

[Christian]

Hi Donald,

du könntest zum Beispiel das ImageButtonGadget verwenden und auf das Bild (Icon) den Text mit draufschreiben. Das bedeutet dann allerdings,dass du für jeden Button ein eigenes Bild machen musst.

Gruß
Christian

[Donald]

Hi Christian,

Das bedeutet dann allerdings,dass du für jeden Button ein eigenes Bild machen musst.

Das ist klar, aber das wollte ich ja vermeiden.
Will halt nicht unmengen an ButtonGrafiken haben.

Einge DLL für GFA die soetwas und noch etliche andere Controls und
derren Einstellungen zur Verfügung stellt habe ich im Einsatz.
Nur leider kann man mit PureBasic keine 16Bit DLL ansprechen und
die ganze DLL umschreiben für PB ... sind ja nur knappe 4800 Zeilen.

[ts-soft]

Vielleicht hilft Dir die SKControll.dll von Sebastian König weiter. Findest Du unter: http://www.sekoenig.de/

Dann brauchste nicht alles per API-machen.

[hardfalcon]

@ts-soft: Wenn er keine API benutzen will, bedeutet das doch, dass er das Programm auch für Linux (oder Amiga, aber das ist eher unwahrscheinlich) machen will. Und da kann er doch auch nix mit eine Windows-DLL anfangen. Da hat er besser, er macht es mit API, und sagt den Leuten, sie sollen WINE benutzen.

cya
Pascal

[M@xx]

Wenn das Bild immer das gleiche sein soll, könntest du den Text darauf mit Startdrawing(ImageOutput()) und DrawText() draufzeichnen. Dann das Bild mit einer anderen ID neu laden und den anderen Text drauf zeichnen usw...

[Donald]

@ ts-soft

Vielleicht hilft Dir die SKControll.dll von Sebastian König weiter

danke für den Link. Die Anleitung ist ja schonmal vielversprechend.
Hast Du damit schonmal was gemacht in PB ?


@ hardfalcon

Wenn er keine API benutzen will

Hast wohl was falsch gelesen. Habe nie was davon gesagt.


@ M@xx
Danke für den Tip. An soetwas hatte ich auch schon gedacht.
Aber wie gesagt benutze erst seit diesem Jahr mit PB und deshalb
muß ich mich erstmal mit den ganzen PB-Befehlen verstraut machen.
Ertappe mich immer wieder dabei die Befehle wie bisher gewohnt
einzugeben. Aber wird schon noch ...

[ts-soft]

Hast Du damit schonmal was gemacht in PB ?

Nur kleinere Tests, habe die DLL früher oft in Profan benutzt. In PB gibt's da andere Möglichkeiten. Solltest Dir vielleicht auch mal CustomButtons von GPI anschauen, findes Du im PureArea.net

[Falko]

Hallo Donald

Schau dir dieses von einander (englisches Forum) bitte an. Er hat auch GFA und was für PB hier vorgestellt.

http://purebasic.myforums.net/viewtopic ... ht=buttons

Vielleicht kannst du das so gebrauchen.
Trotzdem kopiere ich mal den Code von einander auch mal hier her

Code: Alles auswählen

; Button Factory by einander - July 13 2004 - PB 3.91 
; Shape and coloured buttons. 
; Also detect button pressed (not only button released) - handy to do some actions while pressing button 

Procedure Init():  
  Global _BkgWin,_BkgRGB,_MK,_MX,_MY,_Selected 
  Global _PressMe,_Quit,_Change,_MonoRGB,_GID 
  
  Structure BtnAttrib 
    DC.l                 ;BTN hDC 
    ID.w                 ;Button id 
    Pos.POINT      
    Size.SIZE 
    RimWidth.w 
    RimRGB.l 
    OutRGB.l 
    InRGB.l 
    Corner.w 
    Txt.s    
    Fontname.s 
    FontWidth.w 
    FontHeight.w 
    FontRGB.l 
    ShadowWidth.w 
    ShadowRGB.l 
    Flags.l 
  EndStructure 
  NewList BTN.BtnAttrib() 

EndProcedure 

Procedure Get(DC,X, Y, Width, Height) ; get Image from DC and stores it on memory; returns handle for the stored Image 
  Hnd = CreateCompatibleDC_(DC)     ; memory handle to store Image 
  SelectObject_(Hnd, CreateImage(0, Width, Height)) 
  BitBlt_(Hnd, 0, 0, Width, Height, DC, X, Y, #SrcCopy)  ; transfer from DC to handle 
  ProcedureReturn Hnd  
EndProcedure 

Procedure InvertRGB(RGB)  ; return another color that combines fine with first one 
  ProcedureReturn RGB((Red(RGB)+128)%255,(Green(RGB)+128)%255,(Blue(RGB)+128)%255) 
EndProcedure 

Procedure Limit(A,b,C) 
  If A < b : ProcedureReturn b :EndIf 
  If A > C : ProcedureReturn C :EndIf 
  ProcedureReturn A 
EndProcedure 
; 
Procedure RoundRect(DC,X,Y,X1,Y1,Rim,RGB,Corner)    ;draw rectangle with rounded corners 
  Pen=CreatePen_( #PS_INSIDEFRAME,Rim,RGB)            
  Brush = CreateSolidBrush_(RGB) 
  SelectObject_(DC,Pen) 
  SelectObject_(DC,Brush) 
  RoundRect_(DC,X,Y,X1,Y1,Corner,Corner)    
  DeleteObject_(Pen) 
  DeleteObject_(Brush) 
EndProcedure 

Procedure CreateBTN(DC,X,Y,Width,Height,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$,FontName$,FontWidth,FontHeight,FontRGB,ShadowWidth,ShadowRGB,Flags)  
  If Flags>>4&1 
    SelectElement(BTN(),0)  ; is a TipBTN, non selectable, stored as Zero element in list BTN() 
  Else    
    _GID+1 
    AddElement(BTN())  
    BTN()\ID=_GID 
  EndIf 
  BTN()\DC=DC 
  BTN()\Pos\X=X 
  BTN()\Pos\Y=Y 
  BTN()\Size\Cx=Width 
  BTN()\Size\Cy=Height 
  
  BTN()\RimWidth=RimWidth 
  BTN()\RimRGB=RimRGB 
  BTN()\OutRGB=OutRGB 
  BTN()\InRGB=InRGB 
  BTN()\Corner=Corner 
  
  BTN()\Txt=Txt$    
  BTN()\Fontname=FontName$ 
  BTN()\FontWidth=FontWidth 
  BTN()\FontHeight=FontHeight 
  BTN()\FontRGB=FontRGB 
  
  BTN()\ShadowWidth=ShadowWidth 
  BTN()\ ShadowRGB=ShadowRGB 
  BTN()\Flags=Flags 
  If BTN()\ID=_GID : ProcedureReturn _GID:EndIf        ; number of the new BTN on the list 
  ProcedureReturn 0 
EndProcedure 

Procedure DrawBTN()  ; with Invert=0, original button; Invert=1,2,3, different inverted colors 
  DC=BTN()\DC 
  X=BTN()\Pos\X 
  Y=BTN()\Pos\Y 
  Width=BTN()\Size\Cx 
  Height=BTN()\Size\Cy 
  
  RimWidth=BTN()\RimWidth 
  RimRGB=BTN()\RimRGB 
  OutRGB=BTN()\OutRGB 
  InRGB=BTN()\InRGB 
  Corner=BTN()\Corner 
  Txt$=BTN()\Txt    
  FontName$=BTN()\Fontname 
  FontWidth=BTN()\FontWidth 
  FontHeight=BTN()\FontHeight 
  FontRGB=BTN()\FontRGB 
  Flags=BTN()\Flags 
  
  ShadowWidth=BTN()\ShadowWidth 
  ShadowRGB=BTN()\ ShadowRGB 
  
  If Flags>>5 &1  ;grayed 
    OutRGB=RGB(200,200,200):InRGB=RGB(230,230,230):RimRGB=RGB(180,180,180):FontRGB=RGB(180,180,180) 
    BTN()\Flags|1<<10 
  ElseIf Flags>>6&1:OutRGB=#White:InRGB=#BLACK:FontRGB=#yellow   ; highlighted 
  EndIf 
  
  XX=X+ShadowWidth+RimWidth : YY=Y+ShadowWidth+RimWidth 
  X1=X+Width : Y1=Y+Height 
  Red= Red(ShadowRGB)-22:Green=Green(ShadowRGB)-22:Blue=Blue(ShadowRGB)-22  ; start ShadowWidth with RGB background, and fading to black 
  For i=  1 To ShadowWidth  ; ShadowWidth gradient from background RGB to black 
    If Red<0:Red=0:EndIf   ; no less than black !  :-) 
    If Green<0:Green=0:EndIf    
    If Blue<0:Blue=0:EndIf 
    RoundRect(DC,XX,YY,X1,Y1,4,RGB(Red,Green,Blue),Corner)        
    XX-1:YY-1:X1-1:Y1-1 
    Red-22 :Green-22: Blue-22   ; fading to black  
  Next 
  
  Gradient.f=Log(Height)*50    ; gradient rate 
  Pen=CreatePen_(#PS_INSIDEFRAME,RimWidth*2,RimRGB)  ; line thickness =4, to avoid corner gaps (try 1 to see gaps) 
  SelectObject_(DC, Pen); 
  XX=X:YY=Y    
  RoundRect_(DC,XX,YY,X1,Y1,Corner,Corner)  ; BTN rim 
  DeleteObject_(Pen); 
  
  XX+RimWidth:YY+RimWidth:X1-RimWidth:Y1-RimWidth 
  If Gradient<1:Gradient=1:EndIf    ; fading RGB inside BTN from OutRGB to InRGB 
  Gradient/10 
  Red=Red(OutRGB):Green=Green(OutRGB):Blue=Blue(OutRGB) 
  R2=Red(InRGB):G2=Green(InRGB):B2=Blue(InRGB) 
  StpR.f=(R2-Red)/Gradient 
  StpG.f=(G2-Green)/Gradient 
  StpB.f=(B2-Blue)/Gradient 
  
  Repeat                   ; draw gradient inside BTN 
    Pen=CreatePen_(#PS_INSIDEFRAME,4,RGB(Red,Green,Blue)) 
    SelectObject_(DC, Pen) 
    Red=Limit( Red+StpR,0,255): 
    Green=Limit(Green+StpG,0,255) 
    Blue=Limit(Blue+StpB,0,255) 
    RoundRect_(DC,XX,YY,X1,Y1,Corner-GradientShape,Corner+GradientShape) 
    GradientShape+6                    ; gradient shape more elliptical 
    XX+1:YY+1:X1-1:Y1-1 
    DeleteObject_(Pen);  
  Until XX>=X1 Or YY>=Y1: 
  
  Fon = CreateFont_(FontHeight,FontWidth,0,0,100,0,0,0,0,0,0,0,0,FontName$) 
  SetTextcolor_(DC,FontRGB) 
  OldFont = SelectObject_(DC,Fon) 
  SetBkMode_(DC,#Transparent) 
  R.RECT\Left=X:R\Top=Y:R\Right=X+Width:R\Bottom=Y+Height+ShadowWidth 
  GetTextExtentPoint32_(DC, Txt$, Len(Txt$), Sz.SIZE)   ; text sizes to center text 
  
  If Flags &1=1 And Flags>>1&1=0 
    ExtTextOut_(DC, X+RimWidth+3, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  ElseIf Flags >>1 &1=1 And Flags&1=0 
    ExtTextOut_(DC, X+(Width-Sz\Cx-ShadowWidth)-RimWidth-3, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  Else 
    ExtTextOut_(DC, X+(Width-Sz\Cx-ShadowWidth)/2, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  EndIf 
  SelectObject_(DC,OldFont) 
  DeleteObject_(Fon) 
EndProcedure 

    
Procedure SelectBTN()    ; return  _Selected BTN , starting at 1:  0=not  selected 
  ForEach BTN()  
    X=BTN()\Pos\X:Y=BTN()\Pos\Y 
    X1=X+BTN()\Size\Cx:Y1=Y+BTN()\Size\Cy 
    Corner=BTN()\Corner 
    Hnd=CreateRoundRectRgn_( X,Y, X1,Y1,Corner, Corner) 
    If  PtInRegion_(Hnd,WindowMouseX(),WindowMouseY()) 
      DeleteObject_(Hnd) : ProcedureReturn Sel 
    EndIf 
    DeleteObject_(Hnd) : Sel+1 
  Next 
  ProcedureReturn 0 
EndProcedure 
    
Procedure TestBTN(DC) 
  h2 = FindWindow_(#Null, "PureBasic - Debug Output")  ; thanks dmoc for this trick! 
  If h2: CloseWindow_(h2): EndIf                         ; close debugger window if open 
    
  _GID=0 
  ; Flags |1 <<5    ; BIT 5 set; button grayed and not selectable 
  
  Debug "flags="+Bin(Flags) 
  ClearList(BTN()) 
  AddElement(BTN())  ; this is the Zero element, used only for temporary buttons. The  Registered buttons start at element 1 
  
  _BkgRGB=Random($FFFFFF)    
  RoundRect(DC,0,0,WindowWidth(),WindowHeight()-20,0,_BkgRGB,0)   ; draw window background 
  Pen=CreatePen_(#Ps_Solid,2,InvertRGB(RGB(Blue(_BkgRGB),Red(_BkgRGB),Green(_BkgRGB))))  
  SelectObject_(DC,Pen) 
  For X = 0 To WindowWidth() Step 7   ;background diag lines 
    MoveToEx_(DC,X,0,0) : LineTo_(DC,X*2,WindowHeight()-22) 
  Next 
  DeleteObject_(Pen) 
  Width=110  ; first  BTN size 
  Height=44 
  Corner=36  ; Corner angle    
  Txt$="BTN Nº " 
  RimWidth=2 
  RimRGB=#BLUE 
  InRGB=#White 
  FontName$="Arial" 
  FontWidth=8:FontHeight=12 
  FontRGB=#BLACK 
  ShadowWidth=8 
  For i= 1 To 10    ;Test BTNs changing width 
    OutRGB=RGB(Random(210),Random(190),255) 
    BTN=CreateBTN(DC,10,(i-1)*48+20,Width+i*4,Height,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$+Str(i),FontName$,FontWidth,FontHeight+i/2,FontRGB,ShadowWidth,_BkgRGB,Flags) 
    DrawBTN() 
  Next 
  
  ;- Round buttons 
  Width=70:Height=70 
  Corner=360 
  Txt$="" 
  FontRGB=#BLUE 
  ShadowWidth=12 
  FontWidth=9:FontHeight=14 
  For i= 1 To 5   ;Test round BTNs , corner=360 , Width=Height 
    RimWidth=Random(6) 
    OutRGB=Random($FFFFFF) 
    RimRGB=Random($FFFFFF) 
    FontHeight+i/2.5 
    BTN=CreateBTN(DC,160,(i-1)*82+50,Width+(i-2)*4,Height+(i-2)*4,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$+Str(i+10),FontName$,FontWidth,FontHeight,FontRGB,ShadowWidth,_BkgRGB,Flags) 
    DrawBTN() 
  Next 
  ;- More buttons with different corners 
  ShadowWidth=6 
  Width=200:Height=40 
  FontWidth=6: FontHeight=14 
  FontName$="times new roman" 
  Txt$="BTN Nº ":T$=Txt$ 
  FontRGB=0 
  RimWidth=1 
  RimRGB=InvertRGB(_BkgRGB) 
  FontWidth=12 
  For i= 1 To 10     ;Test changing width & height ; random RGBs 
    Corner=Random(100) 
    OutRGB=Random($FFFFFF) 
    InRGB=InvertRGB(OutRGB) 
    
    If Random(5)=0: Flags|1<<5  ; Bit 5 set : grayed and not selectable button 
      T$="Non selectable " 
    Else 
      If Random(4)=0 : R=Random(1) 
        Flags|1<<R 
        If R=0:T$="Left text " :Else:T$="Right text ":EndIf 
      EndIf  
    EndIf 
    BTN=CreateBTN(DC,260,(i-1)*Height+i*11,Width-i*4,Height+i,RimWidth,RimRGB,OutRGB,InRGB,Corner,T$+Str(i+15),FontName$,FontWidth-i/2,FontHeight,FontRGB,ShadowWidth,_BkgRGB,Flags) 
    DrawBTN() 
    T$=Txt$ : Flags=0 
  Next 
  Flags=0   ; show last 3 buttons in normal style 
  
  ;The ID for each BTN is returned from procedure BTN ; (on the previous calls we don't need the ID)  
  _PressMe=CreateBTN(DC,500,10,150,40,RimWidth,RimRGB,OutRGB,#red,16,"Press Me!","Arial",10,16,#White,ShadowWidth,_BkgRGB,Flags) 
  DrawBTN()  
  _Quit=CreateBTN(DC,500,70,150,50,RimWidth,RimRGB,OutRGB,InRGB,Random(100),"Quit","Arial",10,20,FontRGB,ShadowWidth,_BkgRGB,Flags) 
  DrawBTN() 
  _Change=CreateBTN(DC,470,140,210,40,RimWidth,Random($FFFFF),Random($FFFFF),Random($FFFFF),10,"Change buttons","Arial",10,20,FontRGB,ShadowWidth,_BkgRGB,Flags)    
  DrawBTN() 
  _BkgWin=Get(DC, 0,0,WindowWidth(),WindowHeight()-20)  ; full window image used for redraw 
  If h2: ShowWindow_(h2,#SW_RESTORE ): EndIf   ; open again debugger 
  EndProcedure 
    
Procedure Callback(Win, Msg, wParam, lParam) ; control mouse & key messages 
  Result = #PB_ProcessPureBasicEvents 
  Select Msg 
    Case #WM_LButtonDOWN 
      If _MK = 2 : _MK = 3 : Else : _MK = 1 : EndIf 
    Case #WM_LBUTTONUP 
      If _MK = 3 : _MK = 2 : Else : _MK = 0 : EndIf 
    Case #WM_RBUTTONDOWN 
      If _MK = 1 : _MK = 3 : Else : _MK = 2 : EndIf 
    Case #WM_RBUTTONUP 
      If _MK = 3 : _MK = 1 : Else : _MK = 0 : EndIf 
    Case #WM_KEYDOWN 
      If EventwParam() = 27 : End : EndIf 
    Case #PB_EventCloseWindow : End 
  EndSelect 
  If Msg= #PB_Event_Repaint Or Msg=    #WM_ERASEBKGND 
    BitBlt_(GetDC_(WindowID()), 0,0,WindowWidth(),WindowHeight()-20,_BkgWin, 0, 0, #SrcCopy)    
  EndIf 
  _MX=WindowMouseX() 
  _MY=WindowMouseY() 
  ProcedureReturn Result 
EndProcedure 

;-________________________ 
Init() 
style= #ws_overlapped |#ws_minimizebox  | #ws_clipsiblings | #ws_caption| #PB_Window_ScreenCentered 
hWnd=  OpenWindow(0, 30, 40, 700, 550, style, "Button Factory") 
hDC=GetDC_(hWnd)    
SetWindowPos_(hWnd,#HWND_TOP,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOREDRAW) 
CreateStatusBar(0, hWnd)  ; for testing: show BTN states 
SetWindowCallback(@Callback()) 
TestBTN(hDC) 
Repeat          
  WaitWindowEvent() 
  _Selected=SelectBTN() 
  If _MK=1 
    ;    _Selected=SelectBTN() 
    If _Selected 
      SelectElement(BTN(),_Selected) 
      StatusBarText(0,0,"Down "+Str(_Selected)) 
      If BTN()\Flags>>10&1 =0 ; if selectable    
        Highlighted=_Selected  
        BTN()\Flags|1<<6    ; highlight flag 
        DrawBTN() 
        While _MK =1                                      ; wait until BTN is released 
          If _Selected=_PressMe                    ; BTN "Press me" , action while BTN is pressed 
            While _MK=1                               ; loop to show  sample BTNs  
              OutRGB=Random($FFFFFF) 
              RimRGB=Random($FFFFFF) 
              RimWidth=Random(16) 
              ShadowWidth=Random(20) 
              If BKG      ;restore previous background 
                BitBlt_(hDC,480,300,200,200,BKG, 0,0, #SrcCopy)    
              EndIf 
              BKG=Get(hDC,480,300,200,200)    ; keep background  to erase button 
              Flags|1<<4  ;sets BIT 4 (BTN_Tip), stored as Zero element in BTN() 
              CreateBTN(hDC,480,300,200,200,RimWidth,RimRGB,OutRGB,InvertRGB(OutRGB),Random(360),"Another BTN","Arial",12,Random(60)+20,OutRGB,ShadowWidth,_BkgRGB,Flags) 
              DrawBTN() 
              Delay (500)            
              WindowEvent() 
            Wend              
            If BKG :  BitBlt_(hDC,480,300,200,200,BKG, 0,0, #SrcCopy)    
              BTN()\Flags&~(1<<4)   ; clears  BIT 4 BTN_Tip 
              BKG=0 
            EndIf 
          EndIf 
          WindowEvent() 
        Wend 
      EndIf 
    Else 
      StatusBarText(0,0,"Down Ignored") 
    EndIf 
  Else 
    If _Selected:StatusBarText(0,0,"Mouse over "+Str(_Selected)) : 
    Else:StatusBarText(0,0,"") 
    EndIf 
  EndIf 
  If _MK=0   ; no button pressed 
    If Highlighted; restore original button  
      SelectElement(BTN(),Highlighted) 
      BTN()\Flags&~(1<<6)   ; clears  BIT 6 : BTN_Tip 
      DrawBTN() 
      Highlighted=0 
      If  SelectBTN()=_Selected 
        If _Selected=_Quit :  End 
        ElseIf _Selected=_Change : TestBTN(hDC) 
        EndIf 
        StatusBarText(0,0,"Up "+Str(_Selected)) 
        _Selected=0 
      Else 
        StatusBarText(0,0,"Restored "+Str(_Selected)) 
      EndIf 
    EndIf 
  EndIf 
ForEver

Gruß Falko

[Donald]

@ Falko

danke, ist zwar nicht das was ich suche. Aber wird im meine Sammlung
aufgenommen, man weiss ja nicht wann man es mal brauchen kann.
Für GFA habe ich auch eine Sammlung an Sources - Proceduren - Funktionen - .... die über 17MB groß ist.

Hier mal zwei Bildchen. Die zeigen vielleicht besser was ich genau suche.