Some for Windows LTR & RTL Users

[RASHAD]

Code: Select all

  #SIZEOF_WORD = 2
  #CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
  #CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT
  #MB_RIGHT      = $80000
  #MB_RTLREADING = $100000 

Global ListGadget,EditGadget,LangFlag,WinFlag,Color_1,Color_2,FontReg,FontBold,Fontname$

Color_1 = RGB(255, 255, 224) 
Color_2 = RGB(255, 240, 177)
Fontname$ = "Microsoft Sans Serif"                                                                         
FontReg = LoadFont(1, Fontname$, 12)
FontBold = LoadFont(2, Fontname$, 12, #PB_Font_Bold)

ArbLang.s = "00000401"
EngLang.s = "00000409"

ProcedureDLL.l Ansi2Uni(string.s)
  *out = AllocateMemory(Len(string)*2 * #SIZEOF_WORD) 
  MultiByteToWideChar_(#CP_ACP, 0, string, -1, *out, Len(string))  
  ProcedureReturn *out  
EndProcedure

Procedure AlignColumn(liGad, col, align)
  liColumn.LV_COLUMN
  liColumn\mask = #LVCF_FMT
  liColumn\fmt = align
  SendMessage_(liGad, #LVM_SETCOLUMN, col, liColumn)
EndProcedure   


Procedure WndProc(hwnd, uMsg, wParam, lParam)
   
   result = #PB_ProcessPureBasicEvents 

 Select uMsg
   
   Case #WM_NOTIFY

    *pnmh.NMHDR = lParam
    
    Select *pnmh\code    
        Case #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam
           If *LVCDHeader\nmcd\hdr\hWndFrom=ListGadget
            Select *LVCDHeader\nmcd\dwDrawStage 
;               Case #CDDS_PREPAINT 
;                 result = #CDRF_NOTIFYITEMDRAW 
              Case #CDDS_ITEMPREPAINT 
                result = #CDRF_NOTIFYSUBITEMDRAW 
              Case #CDDS_SUBITEMPREPAINT 
                Row = *LVCDHeader\nmcd\dwItemSpec 
                Col = *LVCDHeader\iSubItem 
                If Col=0 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontBold) 
                Else 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
                EndIf 
                If Row&1=1 
                  *LVCDHeader\clrTextBk = Color_2
;                   If Col <> 0 
;                     *LVCDHeader\clrText = RGB(0, 0, 0) 
;                   Else 
;                   *LVCDHeader\clrText = RGB(255, 0, 0) 
;                   EndIf 
;                 Else 
;                   *LVCDHeader\clrTextBk = RGB(255, 255, 223)
;                   If Col <> 0 
;                     *LVCDHeader\clrText = RGB(0, 0, 0) 
;                   Else 
;                    *LVCDHeader\clrText = RGB(255, 0, 0) 
;                   EndIf 
                EndIf
                 result = #CDRF_NEWFONT
            EndSelect 
          EndIf
      EndSelect
      

      Case #WM_GETMINMAXINFO
          *pMinMax.MINMAXINFO = lParam
          *pMinMax\ptMinTrackSize\x=808
          *pMinMax\ptMinTrackSize\y=634

                             
       
      Case #WM_SIZE
          WinX = WindowWidth(0)
          WinY = WindowHeight(0)         
          
          MoveWindow_(GadgetID(1),10,WinY*6/10+20,WinX-20,WinY*3/10,1)          
          MoveWindow_(GadgetID(2),10,WinY-30,80,25,1)
          MoveWindow_(GadgetID(3),10,10,WinX-20,WinY*6/10,1)
              
   EndSelect
    
  ProcedureReturn result 
EndProcedure
      
      
      WinX = 800
      WinY = 600
      
      hWnd = OpenWindow(0,0,0,800,600," RASHAD Database Control ",#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)
      SetWindowCallback(@WndProc(),0)
      EditorGadget(1,10,380,780,170)
      ButtonGadget(2, 10,560, 80, 25, "TEST")
      
      ListGadget = ListIconGadget(3,10,10,780,360,"#######",80,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#WS_BORDER)
      header = SendMessage_(ListGadget, #LVM_GETHEADER, 0, 0)
      SetWindowTheme_(header, @null.w, @null.w)
      AlignColumn(ListGadget, 0,#LVCFMT_CENTER)
      SetGadgetColor(3, #PB_Gadget_BackColor, Color_1)
      SetGadgetFont(3, FontID(1))
      AddGadgetColumn(3,1,"Column 1",200)
      AddGadgetColumn(3,2,"Column 2",200)
      AddGadgetColumn(3,3,"Column 3",200)
      AddGadgetColumn(3,4,"Column 4",200)
      AddGadgetColumn(3,5,"Column 5",200)
      AddGadgetColumn(3,6,"Column 6",200)
      AddGadgetColumn(3,7,"Column 7",200)
      
      For i=0 To 1000
         AddGadgetItem(3, -1, "Line "+Str(i)+Chr(10)+"Line "+Str(i)+" col 1"+Chr(10)+"Line "+Str(i)+" col 2"+Chr(10)+"Line "+Str(i)+" col 3"+Chr(10)+"Line "+Str(i)+" col 4"+Chr(10)+"Line "+Str(i)+" col 5"+Chr(10)+"Line "+Str(i)+" col 6"+Chr(10)+"Line "+Str(i)+" col 7")
      Next
      
View0:      
 
      If LangFlag = 0
      WinFlag = #WS_EX_LAYOUTRTL | 0
      LoadKeyboardLayout_(@ArbLang,#KLF_ACTIVATE)      
      Else
      WinFlag = 0
      LoadKeyboardLayout_(@EngLang,#KLF_ACTIVATE)
      EndIf
      
      SetWindowLong_(ListGadget,#GWL_EXSTYLE,WinFlag)      
      SetWindowLong_(header,#GWL_EXSTYLE,WinFlag)      
      SendMessage_(ListGadget, #LVM_SCROLL, 0, 1)
      
      If OpenLibrary(0, "UxTheme.dll") = 0
          MessageRequester("Error", "Couldn't open UxTheme.dll")
      Else
          *f = GetFunction(0, "IsThemeActive") 
            If *f
              swt = GetFunction(0, "SetWindowTheme")
              CallFunctionFast(swt, header, @null.w, Ansi2Uni("HEADER"))
            EndIf     
      EndIf
      
      If LangFlag = 0
          MessageBox_(0,"عربي","RTL Text",#MB_RIGHT|#MB_RTLREADING|#MB_OK)
      Else
          MessageBox_(0,"English","LTR Text",#MB_OK	)
      EndIf       
  
Repeat
   
   EventID = WaitWindowEvent()
   
   Select EventID

    Case #PB_Event_Gadget
    
     Select EventGadget()         
    
      Case 2
          If LangFlag = 0
          LangFlag = 1
          ElseIf LangFlag = 1
          LangFlag = 0
          EndIf
          Goto View0
         
                 
       EndSelect
       
     Case #PB_Event_CloseWindow 
          Quit = 1
                                  
    EndSelect
   
Until Quit = 1


End

I hope it will help you

RASHAD

[+18]

Thanks RASHAD
It was useful for me.
please more RTL supports ,if it's and you can sharing
many thanks

[yrreti]

Very interesting, but just a little minor note.
I'm still using 4.31 until 4.4 finalizes. I had to change
ProcedureDLL.l Ansi2Uni(string.s) (same as external command error)
to
ProcedureDLL.l Ansi_2_Uni(string.s)
And had to add #PB_Window_SystemMenu to the OpenWindow, or you can't close the program.

Thanks for sharing

[RASHAD]

@+18 Hi
I am waiting for V4.4 final then I have a lot (Workaround) to deal with Ascii,UTF-8,Unicode problems
specially when you are using Character set other than English
and enforced to compile your prog. in ascii mode(ODBC database prog. for example .csv or .xml )
may be some of these problems will be solved in the next release

@yrreti Hi
The conflict with Ansi2Uni Procedure may be beacause you are using user lib may be PBOSL or Droopy
But you handeled it all right
no problem

have a good day both of you

[+18]

Hello
Wow, best news, it's really worth i waiting for reach it surely.
thank you very much for useful shares.

[SFSxOI]

Nice, thank you.

There is one little thing with it though on Windows 7, when its run it forces the Windows 7 language bar to appear in the taskbar.