PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

TitleBarIcons

https://www.purebasic.fr/english/viewtopic.php?t=9687

Page 1 of 1

Posted: Wed Mar 07, 2007 11:54 pm
by Konne
Translated Code to PB 4.0:

Code: Select all


Global OldWndProc, mDC, WindowWidth, xPos, yPos, BtnWidth, BtnHeight 
Global OrBtnWidth, OrBtnHeight, BtnDown, BGColour, FGColour, hToolTip, tp.TOOLINFO 

Procedure UpdateTP() 
  tp\cbSize = SizeOf(TOOLINFO) 
  tp\uFlags = #TTF_SUBCLASS 
  tp\hwnd = WindowID(0) 
  tp\uId = WindowID(0) 
  tp\rect\left = xPos-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER) 
  tp\rect\top = yPos-GetSystemMetrics_(#SM_CYCAPTION)-GetSystemMetrics_(#SM_CYDLGFRAME)-GetSystemMetrics_(#SM_CYBORDER) 
  tp\rect\right = xPos+BtnWidth 
  tp\rect\bottom = tp\rect\top+BtnHeight 
  tp\lpszText = @"Stay on top" 
EndProcedure 

Procedure UpdateMetrics() 
  WindowWidth = WindowWidth(0) 
  CaptionHeight = GetSystemMetrics_(#SM_CYCAPTION) 
  BtnWidth = GetSystemMetrics_(#SM_CXSIZE)-2 
  BtnHeight = GetSystemMetrics_(#SM_CYSIZE)-4 
  xPos = WindowWidth-(BtnWidth*4)-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER) 
  yPos = ((CaptionHeight-BtnHeight)/2)+GetSystemMetrics_(#SM_CYDLGFRAME)+GetSystemMetrics_(#SM_CXBORDER) 
  BGColour = GetSysColor_(#COLOR_3DFACE) 
  FGColour = GetSysColor_(#COLOR_BTNTEXT) 
  hDC = GetDC_(WindowID(0)) 
  *Icon = AllocateMemory(1760) 
  For z=#OBM_REDUCED To #OBM_REDUCE Step #OBM_REDUCE-#OBM_REDUCED 
    If z-#OBM_REDUCED:*OnTops = ?OnTop0:Else:*OnTops = ?OnTop1:EndIf 
    hSysBitmap = LoadBitmap_(0, z) 
    If z-#OBM_REDUCED 
      CreateImage(1, 22, 24) 
      StartDrawing(ImageOutput(1)) 
      DrawImage(hSysBitmap, 0, 0, 22, 24) 
      StopDrawing() 
      ImageID = GrabImage(1, z-#OBM_REDUCED, 0, 2, 22, 20) 
    Else 
      ImageID = CreateImage(z-#OBM_REDUCED, 22, 20) 
      StartDrawing(ImageOutput(z-#OBM_REDUCED)) 
      DrawImage(hSysBitmap, 0, 0, 22, 20) 
      StopDrawing() 
    EndIf 
    DeleteObject_(hSysBitmap) 
    bmih.BITMAPINFOHEADER 
    bmih\biSize = SizeOf(BITMAPINFOHEADER) 
    bmih\biWidth = 22 
    bmih\biHeight = -20 
    bmih\biPlanes = 1 
    bmih\biBitCount = 32 
    bmih\biCompression = #BI_RGB 
    If GetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0) 
      For i=0 To 15 
        *PixelPlace.LONG = *Icon+((i+2)*(88))+12 
        For j=0 To 1 
          ThisByte = PeekB(*OnTops+(i*2)+j)&$FF 
          For p=0 To 7 
            ThisByte<<1 
            If ThisByte>=%100000000 
              *PixelPlace\l = ((FGColour&$FF)<<16)|(FGColour&$FF00)|((FGColour&$FF0000)>>16) 
            Else 
              *PixelPlace\l = ((BGColour&$FF)<<16)|(BGColour&$FF00)|((BGColour&$FF0000)>>16) 
            EndIf 
            *PixelPlace+4 
            ThisByte&$FF 
          Next p 
        Next j 
      Next i 
    EndIf 
    SetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0) 
  Next z 
  FreeMemory(*Icon) 
  ReleaseDC_(WindowID(0), hDC) 
  If BtnDown 
    SelectObject_(mDC, ImageID(0)) 
  Else 
    SelectObject_(mDC, ImageID(#OBM_REDUCE-#OBM_REDUCED)) 
  EndIf 
  If hToolTip 
    UpdateTP() 
    SendMessage_(hToolTip, #TTM_NEWTOOLRECT, 0, @tp) 
  EndIf 
EndProcedure 

Procedure CreateIconButtonToolTip(hWnd) 
  UpdateMetrics() 
  hToolTip = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP|#TTS_NOPREFIX|#TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, GetModuleHandle_(0), 0) 
  If hToolTip 
    UpdateTP() 
    SendMessage_(hToolTip, #TTM_ADDTOOL, 0, @tp) 
  EndIf 
  ProcedureReturn hToolTip 
EndProcedure 

Procedure TestInButton(hWnd, *pt.POINT) 
  ScreenToClient_(hWnd, *pt) 
  UpdateMetrics() 
  xCur = *pt\x+GetSystemMetrics_(#SM_CXDLGFRAME) 
  yCur = *pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME) 
  If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight) 
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False 
  EndIf 
EndProcedure 

Procedure PaintButton(hWnd) 
  hDC = GetWindowDC_(hWnd) 
  SetStretchBltMode_(hDC, #HALFTONE) 
  StretchBlt_(hDC, xPos, yPos, BtnWidth, BtnHeight, mDC, 0, 0, OrBtnWidth, OrBtnHeight, #SRCCOPY) 
  ReleaseDC_(hWnd, hDC) 
EndProcedure 

Procedure WndProc(hWnd, uMsg, wParam, lParam) 
  Select uMsg 
    Case #WM_NCACTIVATE 
      result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
      UpdateMetrics() 
      PaintButton(hWnd) 
    Case #WM_NCPAINT 
      UpdateMetrics() 
      hRegion = CreateRectRgn_(xPos, yPos, xPos+BtnWidth, yPos+BtnHeight) 
      CombineRgn_(wParam, wParam, hRegion, #RGN_DIFF) 
      result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
      DeleteObject_(hRegion) 
      PaintButton(hWnd) 
    Case #WM_NCLBUTTONDBLCLK 
      If wParam=#HTCAPTION 
        pt.POINT 
        pt\x = lParam&$FFFF 
        pt\y = lParam>>16 
        If TestInButton(hWnd, pt) 
          SendMessage_(hWnd, #WM_NCLBUTTONDOWN, wParam, lParam) 
        Else 
          result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
        EndIf 
      Else 
        result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_NCLBUTTONDOWN 
      If wParam=#HTCAPTION 
        pt.POINT 
        pt\x = lParam&$ffff 
        pt\y = lParam>>16 
        ScreenToClient_(hWnd, @pt) 
        UpdateMetrics() 
        xCur = pt\x+GetSystemMetrics_(#SM_CXDLGFRAME) 
        yCur = pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME) 
        If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight) 
          If BtnDown 
            SetWindowPos_(hWnd, #HWND_NOTOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE) 
            SelectObject_(mDC, ImageID(#OBM_REDUCE-#OBM_REDUCED)) 
            BtnDown = 0 
          Else 
            SetWindowPos_(hWnd, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE) 
            SelectObject_(mDC, ImageID(0)) 
            BtnDown = 1 
          EndIf 
          PaintButton(hWnd) 
        Else 
          result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
        EndIf 
      Else 
        result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
      EndIf 
    Default 
      result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

If OpenWindow(0, 0, 0, 320, 256, "Title button", #PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered) 
  WindowID = WindowID(0) 
  OrBtnWidth = 22 
  OrBtnHeight = 20 
  hDC = GetDC_(WindowID) 
  mDC = CreateCompatibleDC_(hDC) 
  CreateImage(0, 22, 20) 
  mOldOblect = SelectObject_(mDC, ImageID(0)) 
  ReleaseDC_(WindowID, hDC) 
  UpdateMetrics() 
  OldWndProc = SetWindowLong_(WindowID, #GWL_WNDPROC, @WndProc()) 
  CreateIconButtonToolTip(WindowID) 
  PaintButton(WindowID) 
  Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow 
  DeleteObject_(mOldOblect) 
  DeleteDC_(mDC) 
EndIf 
End 

DataSection 
OnTop0: 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
Data.b %00000011,%00000000 
Data.b %00000010,%10000110 
Data.b %00000010,%01111010 
Data.b %00000010,%01001010 
Data.b %11111110,%01001010 
Data.b %11111110,%11111010 
Data.b %00000011,%11111110 
Data.b %00000011,%11111110 
Data.b %00000011,%10000110 
Data.b %00000011,%00000000 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
OnTop1: 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
Data.b %00000000,%11110000 
Data.b %00000011,%00001000 
Data.b %00001110,%00001100 
Data.b %00001010,%00001100 
Data.b %00010010,%00011100 
Data.b %00010011,%00111100 
Data.b %00011011,%11111000 
Data.b %00011111,%11111000 
Data.b %00001111,%11111000 
Data.b %00001111,%11110000 
Data.b %00011001,%11100000 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
Data.b %00000000,%00000000 
EndDataSection
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited