2000 look in apps

Just starting out? Need help? Post your questions and find answers here.
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Post by PB »

> Same place as num3, the win32api :P

Oh, I thought you had downloaded an example source. Sorry! I will play
around with the Flat style later, and see what I can do... but no promises.
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

hehe yeah its easy to take a mistake of me :P
Well play with it and see what you get!
Right now i have an "UnFlattern" procedure wich i hope to make working..
Christian
Enthusiast
Enthusiast
Posts: 154
Joined: Mon Dec 08, 2003 7:50 pm
Location: Germany

Post by Christian »

Hi!

I did some research in the forum and google and managed to draw buttons on my own. They have a single-line-border and you can color them like you want to. Only the speed you can click on them differs from normal buttons in functionality. Have to search for the reason ... if somebody has a solution would be great if he/she would post it.

Here's the code:

Code: Select all

; Author: Christian
; Date: 22. December 2004 

; --> This is needed for PB's drawing functions to work
 Structure PBDrawingStruct 
  Type.l 
  WindowHandle.l 
  DC.l 
  ReleaseProcedure.l 
 EndStructure 
 mydraw.PBDrawingStruct
 mydraw\Type = 1
 Global mydraw

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;                      Procedures
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

; --> Windowcallback 
Procedure myWindowCallback(hwnd, msg, wparam, lparam) 
  result = #PB_ProcessPureBasicEvents 
  Select msg
   Case #WM_DRAWITEM 
     ; -- Get handle and DeviceContext
     *lpdis.DRAWITEMSTRUCT = lparam
     mydraw\WindowHandle = *lpdis\hwndItem
     hDC = GetDC_(mydraw\WindowHandle)

     ; -- Get GadgetRect
     XPos = *lpdis\rcItem\left
     YPos = *lpdis\rcItem\top 
     Width = *lpdis\rcItem\right-*lpdis\rcItem\left 
     Height = *lpdis\rcItem\bottom-*lpdis\rcItem\top

     ; -- Get font information and GadgetText
     GadgetFont = SendMessage_(mydraw\WindowHandle, #WM_GETFONT, 0, 0)
     GetObject_(GadgetFont, SizeOf(LOGFONT), @lf.LOGFONT) 
     FontHeight.l = Abs(lf\lfHeight)

     GadgetText.s = Space(1000)
     GetWindowText_(mydraw\WindowHandle, @GadgetText, 1000)
    
     ; -- Start with OwnerDrawing
     Select *lpdis\CtlType 
      Case #ODT_BUTTON
        ; -- Draw selected/pushed button
        If *lpdis\itemState & #ODS_SELECTED
           If StartDrawing(mydraw)
               ; -- Border
               LineXY(XPos, YPos, Width, 0, GetSysColor_(3))
               LineXY(XPos, YPos, 0, Height - 1, GetSysColor_(3))
               LineXY(XPos + Width, YPos, XPos + Width, YPos + Height - 1, GetSysColor_(5))
               LineXY(XPos, YPos + Height - 1, XPos + Width, YPos + Height - 1, GetSysColor_(5))

               ; -- BackgroundColor
               Box(XPos + 1, YPos + 1, Width - 1, Height - 2, GetSysColor_(4))

               ; -- Text
               DrawingMode(1) : FrontColor(0, 0, 0)
               DrawingFont(GadgetFont)

               Locate((Width - XPos - TextLength(GadgetText))/2 + 1, (Height - YPos - FontHeight)/2 + 1)
               DrawText(GadgetText)
           StopDrawing()
           EndIf
        Else
           ; -- Draw normal button
           If StartDrawing(mydraw)
               ; -- Border
               LineXY(XPos, YPos, Width, 0, GetSysColor_(5))
               LineXY(XPos, YPos, 0, Height - 1, GetSysColor_(5))
               LineXY(XPos + Width, YPos, XPos + Width, YPos + Height - 1, GetSysColor_(3))
               LineXY(XPos, YPos + Height - 1, XPos + Width, YPos + Height - 1, GetSysColor_(3))

               ; -- BackgroundColor
               Box(XPos + 1, YPos + 1, Width - 1, Height - 2, GetSysColor_(4))

               ; -- Text
               DrawingMode(1) : FrontColor(0, 0, 0)
               DrawingFont(GadgetFont)
 
               Locate((Width - XPos - TextLength(GadgetText))/2, (Height - YPos - FontHeight)/2)
               DrawText(GadgetText)
           StopDrawing()
           EndIf
        EndIf
        If *lpdis\itemState & #ODS_FOCUS
            ; -- Draw the FocusRect
            *lpdis\rcItem\left + 3
            *lpdis\rcItem\top + 3
            *lpdis\rcItem\right - 3
            *lpdis\rcItem\bottom - 3
            DrawFocusRect_(hDC, *lpdis\rcItem)
        EndIf

     EndSelect
     result = #TRUE
  EndSelect
  ProcedureReturn result 
EndProcedure 

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;                      Program
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

If OpenWindow(0, 0, 0, 480, 260,#PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Christians OwnerDrawn Buttons") And CreateGadgetList(WindowID(0)) 
  SetWindowCallback(@myWindowCallback()) 

  ButtonGadget(0, 50, 50, 200, 50, "Owner Drawn Button 1", #BS_OWNERDRAW)
  ButtonGadget(1, 50, 105, 200, 50, "Owner Drawn Button 2", #BS_OWNERDRAW)

  Repeat 
    event = WaitWindowEvent() 
    Select event 
      Case #PB_EventGadget 
        Select EventGadgetID() 
          Case 0 
           MessageRequester("Info", "Button 1 pressed!", 0)

          Case 1
           MessageRequester("Info", "Button 2 pressed!", 0)
        EndSelect 
    EndSelect 
  Until event = #PB_Event_CloseWindow 
EndIf 
End
regards,
Christian
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

Pretty nice!
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Here's my attempt on flat ownerdraw ButtonGadgets, with hover highlighting. :)

Code: Select all

; *************************************************
; Title:          Sparkies Ownerdraw Hover Buttons
; Author:         Spakie
; Start Date:     December 20, 2004 8:50 AM
; Version 0.01B:  December 22, 2004 9:00 AM
; License:        Free to use, optimize, and modify at will :)
; *************************************************
#ODA_DRAWENTIRE = 1
#ODA_FOCUS = 4
#ODA_SELECT = 2
#TME_CANCEL = $80000000
#TME_HOVER = 1
#TME_LEAVE = 2
#TME_NONCLIENT = $10
#TME_QUERY = $40000000
#DFCS_HOT = $1000
#DFCS_TRANSPARENT = 4800
#ODS_INACTIVE = $80
#ODS_HOTLIGHT = $40
#ODS_NOFOCUSRECT = $200
#WM_MOUSEHOVER = $2A1
#WM_MOUSELEAVE = $2A3
#MyWindow = 0 
Enumeration
#MyButton1 = 100
#MyButton2
#MyButton3
EndEnumeration
#DoHover = 1
#DoLeave = 2
; --> For tracking mouse
Structure myTRACKMOUSEEVENT
  cbSize.l
  dwFlags.l
  hwndTrack.l
  dwHoverTime.l
EndStructure
mte.myTRACKMOUSEEVENT
mte\cbSize = SizeOf(myTRACKMOUSEEVENT)

; --> Create button background brushes
buttonBrushLeave = CreateSolidBrush_(RGB(237, 233, 177))
buttonBrushClick = CreateSolidBrush_(RGB(207, 203, 147))
buttonBrushHover = CreateSolidBrush_(RGB(255, 100, 100))

; --> Declare Globals
Global doWhat, oldCallback, buttonBrushLeave, buttonBrushClick, buttonBrushHover, mte

; --> Main WindowCallback
Procedure myWindowCallback(hwnd, msg, wparam, lparam)
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_DRAWITEM
      *dis.DRAWITEMSTRUCT = lparam
      If *dis\CtlType = #ODT_BUTTON
        buttonNum = *dis\CtlID
        ; --> Default button attributes
        SetBkMode_(*dis\hDC, #TRANSPARENT)
        doWhatBrush = buttonBrushLeave
        doFlags = #DFCS_FLAT | #DFCS_BUTTONPUSH | #DFCS_MONO | #DFCS_ADJUSTRECT
        Select *dis\itemState
          Case 0
            ; --> DoHover or DoLeave
            If *dis\itemAction = 1 And doWhat = #DoHover
              ; --> DoHover
              doWhatBrush = buttonBrushHover
              doFlags = #DFCS_BUTTONPUSH | #DFCS_MONO | #DFCS_ADJUSTRECT
            ElseIf *dis\itemAction = 1 And doWhat = #DoLeave
              ; --> DoLeave
              doWhatBrush = buttonBrushLeave
              doFlags = #DFCS_FLAT | #DFCS_BUTTONPUSH | #DFCS_MONO | #DFCS_ADJUSTRECT
            EndIf
          Case #ODS_FOCUS
            ; --> ClickDown
            doWhatBrush = buttonBrushClick
            doFlags = #DFCS_BUTTONPUSH | #DFCS_PUSHED | #DFCS_ADJUSTRECT
          Case #ODS_FOCUS | #ODS_SELECTED
            ; --> ClickUp
            doWhatBrush = buttonBrushClick
            doFlags = #DFCS_BUTTONPUSH | #DFCS_PUSHED | #DFCS_ADJUSTRECT
        EndSelect
      EndIf
      DrawFrameControl_(*dis\hDC, *dis\rcItem, #DFC_BUTTON, doFlags)
      FillRect_(*dis\hDC, *dis\rcItem, doWhatBrush)
      DrawText_(*dis\hDC, GetGadgetText(buttonNum), Len(GetGadgetText(buttonNum)), *dis\rcItem, #DT_CENTER | #DT_SINGLELINE | #DT_VCENTER)
  EndSelect
  ProcedureReturn result
EndProcedure

; --> ButtonCallback
Procedure myButtonCallback(hwnd, msg, wparam, lparam)
  Shared mouseLeave, hover, hot
  result = CallWindowProc_(oldCallback, hwnd, msg, wparam, lparam)
  buttonID = GetDlgCtrlID_(hwnd)
  Select msg
    Case #WM_MOUSEMOVE
      If wparam <> #MK_LBUTTON And mouseLeave = 0
        mouseLeave = 1
        doWhat = #DoHover
        ; --> Force #WM_DRAWITEM
        InvalidateRect_(GadgetID(buttonID), 0, 0)
        ; Track mouse leaving button
        mte\dwFlags = #TME_LEAVE
        mte\hwndTrack = GadgetID(buttonID)
        TrackMouseEvent_(mte)
      EndIf
    Case #WM_MOUSELEAVE
      mouseLeave = 0
      doWhat = #DoLeave
      ; --> Force #WM_DRAWITEM
      InvalidateRect_(GadgetID(buttonID), 0, 0)
    Case #WM_LBUTTONDOWN
      ; --> Set flag to reset previous down botton
      doWhat = #DoLeave
  EndSelect
  ProcedureReturn result
EndProcedure
If OpenWindow(#MyWindow, 100, 100, 250, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Custom Hover Buttons") And CreateGadgetList(WindowID()) 
  SetWindowCallback(@myWindowCallback())
  CreateStatusBar(0, WindowID(#MyWindow))
  StringGadget(0, 75, 10, 100, 20, "Ownerdraw Buttons", #PB_String_BorderLess | #PB_String_ReadOnly)
  ButtonGadget(#MyButton1, 75, 50, 100, 20, "Testing")
  ButtonGadget(#MyButton2, 75, 80, 100, 20, "Customized")
  ButtonGadget(#MyButton3, 75, 110, 100, 20, "Buttons")
  ; --> Remove #BS_PUSHBUTTON and add #BS_OWNERDRAW to buttons
  For b = #MyButton1 To #MyButton3
    bStyle = GetWindowLong_(GadgetID(b), #GWL_STYLE)
    SetWindowLong_(GadgetID(b), #GWL_STYLE, bStyle &~#BS_PUSHBUTTON | #BS_OWNERDRAW) 
    oldCallback = SetWindowLong_(GadgetID(b), #GWL_WNDPROC, @myButtonCallback()) 
  Next b
  Repeat 
    event = WaitWindowEvent() 
    Select event
      Case #PB_EventGadget
        Select EventGadgetID()
          Case 0
            StatusBarText(0, 0, "No Button seelcted")
          Case #MyButton1
            StatusBarText(0, 0, "Selected button ID# " + Str(#MyButton1) + " text is: Testing")
          Case #MyButton2
            StatusBarText(0, 0, "Selected button ID# " + Str(#MyButton2) + " text is: Customized")
          Case #MyButton3
            StatusBarText(0, 0, "Selected button ID# " + Str(#MyButton3) + " text is: Buttons")
        EndSelect
    EndSelect
  Until event = #PB_Event_CloseWindow
EndIf 
DeleteObject_(buttonBrushLeave)
DeleteObject_(buttonBrushClick)
DeleteObject_(buttonBrushHover)
End 
Last edited by Sparkie on Wed Dec 22, 2004 3:40 pm, edited 1 time in total.
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

Looks pretty nice!
How to make the buttons Not stay down?
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Starting at line 73, change the button staying down:

Code: Select all

Case #ODS_FOCUS
            ; --> ClickDown
            doWhatBrush = buttonBrushClick
            doFlags = #DFCS_BUTTONPUSH | #DFCS_PUSHED | #DFCS_ADJUSTRECT
to button going back up:

Code: Select all

Case #ODS_FOCUS
            ; --> ClickDown
            doWhatBrush = buttonBrushLeave
            doFlags = #DFCS_BUTTONPUSH  | #DFCS_MONO | #DFCS_ADJUSTRECT
            drawFocus = 1
Then add this after the DrawText_() to draw yur focus rect

Code: Select all

If drawFocus = 1
        DrawFocusRect_(*dis\hDC, *dis\rcItem)
      EndIf
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
berklee
User
User
Posts: 36
Joined: Wed Jul 28, 2004 3:45 pm

Post by berklee »

I remembered running into this in my VB days.... in that world, it's done with subclassing.

http://vbnet.mvps.org/index.html?code/s ... ecombo.htm

Hope that helps.
Wolf
Enthusiast
Enthusiast
Posts: 232
Joined: Sat Apr 03, 2004 12:00 pm
Location: S.T

Post by Wolf »

Work perfect :D

Thanks Christian and Sparkie nice work :wink:
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Post by NoahPhense »

nice work sparkmaster...

- np
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

Yeah nice work!
Post Reply