View Issue Details

IDProjectCategoryView StatusLast Update
0008996LazarusPatchpublic2007-12-12 16:33
ReporterZaher Dirkey Assigned ToPaul Ishenin  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version0.9.23 (SVN) 
Fixed in Version0.9.23 (SVN) 
Summary0008996: Patch for Add BidiMode to Win32 widget for StdCtrls and Menus
DescriptionMove changing FlagsEx from whale Win32wsButtons.pp and Win32wsStdCtrls.pp to function PrepareCreateWindow in win32wsControls.pp

Move SetBidiMode for all control and use TWin32WSWinControl.SetBidiMode for all controls (Delphi make this also)

Add 2 procedures in win32wsControls.pp (SetStdBiDiModeParams, UpdateStdBiDiModeFlags)
Add 1 procedure in win32proc.pp (SetMenuFlag)

in WedGetSet
Added procedure to WSMenus
    class procedure TWSMenuClass.BiDiModeChanged(const AMenu: TMenu); virtual;

By that we finish (TForm, TButton, TEdit, TListBox, TComboBox, TCheckBox, TStaticText, TGroupBox, TRadioButton,

TMainMenu, TPopupMenu) for Win32

Menus still need modify DrawMenuItem function i will do it in next patch with TLabel, TPanel

Additional InformationI like to make some discusses about this way to send notification to all comoponent in the form for ParentBidiMode

in customform.inc

procedure TCustomForm.CMBiDiModeChanged(var Message: TLMessage);
var
  i:Integer;
  lMessage:TLMessage;
begin
  inherited;
  //send CM_PARENTBIDIMODECHANGED to All Component owned by Form
{ prefer use IMenu and check it then call IMenu.ParentBidiMode
  This way is usefull for other TMenu components that need BidiMode of form changed
  Like as TToolbar }
  lMessage.msg := CM_PARENTBIDIMODECHANGED;
  lMessage.wParam := 0;
  lMessage.lParam := 0;
  lMessage.Result := 0;
  for i := 0 to ComponentCount - 1 do
  begin
    if not (Components[i] is TCustomControl) then//TCustomControl already has this notification
      Components[i].Dispatch(lMessage);
//the old way
// if Components[i] is TMenu then
// TMenu(Components[i]).ParentBiDiModeChanged;
  end;
end;
Tagsbidi
Fixed in Revision11408,11409
LazTarget
WidgetsetWin32/Win64
Attached Files

Activities

2007-06-02 11:48

 

add_bidimode_stdctrls.patch (25,880 bytes)   
Index: buttons.pp
===================================================================
--- buttons.pp	(revision 11212)
+++ buttons.pp	(working copy)
@@ -85,6 +85,7 @@
     function DialogChar(var Message: TLMKey): boolean; override;
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
     function IsBorderSpacingInnerBorderStored: Boolean; override;
+    function UseRightToLeftAlignment: Boolean; override;
     property ParentColor default false;
   public
     constructor Create(TheOwner: TComponent); override;
Index: forms.pp
===================================================================
--- forms.pp	(revision 11212)
+++ forms.pp	(working copy)
@@ -418,6 +418,7 @@
     procedure WMPaint(var message: TLMPaint); message LM_PAINT;
     procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
     procedure WMSize(var message: TLMSize); message LM_Size;
+    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
     procedure AddHandler(HandlerType: TFormHandlerType;
                          const Handler: TMethod; AsLast: Boolean);
     procedure RemoveHandler(HandlerType: TFormHandlerType;
Index: include/buttons.inc
===================================================================
--- include/buttons.inc	(revision 11212)
+++ include/buttons.inc	(working copy)
@@ -287,6 +287,12 @@
   Result:=BorderSpacing.InnerBorder<>2;
 end;
 
+function TCustomButton.UseRightToLeftAlignment: Boolean;
+begin
+  //Button always has center alignment
+  Result := False;
+end;
+
 {------------------------------------------------------------------------------
   procedure TCustomButton.DoSendBtnDefault;
  ------------------------------------------------------------------------------}
Index: include/customform.inc
===================================================================
--- include/customform.inc	(revision 11212)
+++ include/customform.inc	(working copy)
@@ -574,6 +574,30 @@
   end;
 End;
 
+procedure TCustomForm.CMBiDiModeChanged(var Message: TLMessage);
+var
+  i:Integer;
+  lMessage:TLMessage;
+begin
+  inherited;
+  //send CM_PARENTBIDIMODECHANGED to All Component owned by Form
+{   prefer use IMenu and check it then call IMenu.ParentBidiMode
+  This way is usefull for other TMenu components that need BidiMode of form changed
+  Like as TToolbar }
+  lMessage.msg := CM_PARENTBIDIMODECHANGED;
+  lMessage.wParam := 0;
+  lMessage.lParam := 0;
+  lMessage.Result := 0;
+  for i := 0 to ComponentCount - 1 do
+  begin
+    if not (Components[i] is TCustomControl) then//TCustomControl already has this notification
+      Components[i].Dispatch(lMessage);
+//the old way
+//    if Components[i] is TMenu then
+//      TMenu(Components[i]).ParentBiDiModeChanged;
+  end;
+end;
+
 procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
   const Handler: TMethod; AsLast: Boolean);
 begin
Index: include/menu.inc
===================================================================
--- include/menu.inc	(revision 11212)
+++ include/menu.inc	(working copy)
@@ -32,6 +32,9 @@
   FItems.FMenu := Self;
   FImageChangeLink := TChangeLink.Create;
   FImageChangeLink.OnChange := @ImageListChange;
+  FBidiMode := bdLeftToRight;
+  FParentBidiMode := True;
+  ParentBidiModeChanged(AOwner);
   Inherited Create(AOwner);
 end;
 
@@ -46,6 +49,55 @@
   FImages:=AValue;
 end;
 
+procedure TMenu.SetBidiMode(const AValue: TBidiMode);
+begin
+  if FBidiMode=AValue then exit;
+  FBidiMode:=AValue;
+  FParentBiDiMode := False;
+  if not (csLoading in ComponentState) then
+    BidiModeChanged;
+end;
+
+procedure TMenu.SetParentBidiMode(const AValue: Boolean);
+begin
+  if FParentBiDiMode = AValue then exit;
+  FParentBiDiMode := AValue;
+  if not (csLoading in ComponentState) then
+    ParentBidiModeChanged;
+end;
+
+procedure TMenu.CMParentBiDiModeChanged(var Message: TLMessage);
+begin
+  ParentBidiModeChanged;
+end;
+
+procedure TMenu.BidiModeChanged;
+begin
+  if HandleAllocated then
+    TWSMenuClass(WidgetSetClass).BiDiModeChanged(Self);
+end;
+
+procedure TMenu.ParentBidiModeChanged(AOwner: TComponent);
+begin
+  if FParentBidiMode then
+  begin
+    //Take the value from the Owner
+    //i can not use parent because TPopupMenu.Parent = nil
+    if (AOwner<>nil)
+    and (AOwner is TCustomForm)
+    and not (csDestroying in AOwner.ComponentState) then
+    begin
+      BiDiMode := TCustomForm(AOwner).BiDiMode;
+      FParentBiDiMode := True;
+    end;
+  end;
+end;
+
+procedure TMenu.ParentBidiModeChanged;
+begin
+  ParentBidiModeChanged(Owner);
+end;
+
 {------------------------------------------------------------------------------
   procedure TMenu.SetParent(const AValue: TComponent);
 
@@ -57,7 +109,7 @@
   if (FParent=nil) and (Items<>nil) and Items.HandleAllocated then begin
     // disconnect from form
     DestroyHandle;
-  end;
+  end
 end;
 
 procedure TMenu.ImageListChange(Sender: TObject);
@@ -270,6 +322,11 @@
   end;
 end;
 
+function TMenu.IsBiDiModeStored: boolean;
+begin
+  Result := not FParentBidiMode;
+end;
+
 {------------------------------------------------------------------------------
   Function: TMenu.IsRightToLeft
   Params:
@@ -279,8 +336,7 @@
  ------------------------------------------------------------------------------}
 function TMenu.IsRightToLeft : Boolean;
 Begin
-  //TODO: Make sure it should return FALSE!!!!!!!!!!
-  Result := False;
+  Result := BidiMode <> bdLeftToRight;
 end;
 
 // included by menus.pp
Index: include/menuitem.inc
===================================================================
--- include/menuitem.inc	(revision 11212)
+++ include/menuitem.inc	(working copy)
@@ -532,6 +532,20 @@
 end;
 
 {------------------------------------------------------------------------------
+  Function: TMenuItem.GetIsRightToLeft
+  Returns:  Get IsRightToLeft value from Menu
+  
+ ------------------------------------------------------------------------------}
+
+function TMenuItem.GetIsRightToLeft: Boolean;
+var
+  LMenu:TMenu;
+begin
+  LMenu := GetParentMenu;
+  Result := (LMenu <> nil) and (LMenu.IsRightToLeft);
+end;
+
+{------------------------------------------------------------------------------
   Function: TMenuItem.HandleAllocated
   Params:   None
   Returns:  True is handle is allocated
Index: interfaces/win32/win32object.inc
===================================================================
--- interfaces/win32/win32object.inc	(revision 11212)
+++ interfaces/win32/win32object.inc	(working copy)
@@ -493,6 +493,8 @@
   begin
     AWinControl := TWinControl(AMenu.Owner);
     Windows.SetMenu(AWinControl.Handle, AMenu.Handle);
+    //Set the right order menu after attach the menu
+    SetMenuFlag(AMenu.Handle, MFT_RIGHTORDER or MFT_RIGHTJUSTIFY, AMenu.IsRightToLeft);
     AddToChangedMenus(AWinControl.Handle);
   end;
 end;
Index: interfaces/win32/win32proc.pp
===================================================================
--- interfaces/win32/win32proc.pp	(revision 11212)
+++ interfaces/win32/win32proc.pp	(working copy)
@@ -108,6 +108,7 @@
 procedure RedrawMenus;
 function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
 function GetControlText(AHandle: HWND): string;
+function SetMenuFlag(const Menu:HMenu; Flag: Integer; Value: boolean): boolean;
 
 type
   PDisableWindowsInfo = ^TDisableWindowsInfo;
@@ -1103,6 +1104,33 @@
   ChangedMenus.Clear;
 end;
 
+{------------------------------------------------------------------------------
+  Method: SetMenuFlags
+  Returns: Nothing
+
+  Change the menu flags for handle of TMenuItem or TMenu,
+  added for BidiMode Menus
+ ------------------------------------------------------------------------------}
+function SetMenuFlag(const Menu:HMenu; Flag: Integer; Value: boolean): boolean;
+var
+  MenuInfo: MENUITEMINFO;
+  Buffer:PChar;
+begin
+  MenuInfo.cbSize := SizeOf(MENUITEMINFO);
+  MenuInfo.fMask := MIIM_TYPE;
+  MenuInfo.dwTypeData := nil;
+  GetMenuItemInfo(Menu, 0, True, @MenuInfo);
+  MenuInfo.cch := MenuInfo.cch + 1;
+  Buffer := GetMem(MenuInfo.cch);
+  MenuInfo.dwTypeData := Buffer;
+  GetMenuItemInfo(Menu, 0, True, @MenuInfo);
+  if Value then
+    MenuInfo.fType := MenuInfo.fType or Flag
+  else
+    MenuInfo.fType := MenuInfo.fType and not Flag;
+  SetMenuItemInfo(Menu, 0, True, @MenuInfo);
+end;
+
 function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
 var
   textSize: Windows.SIZE;
Index: interfaces/win32/win32wsbuttons.pp
===================================================================
--- interfaces/win32/win32wsbuttons.pp	(revision 11212)
+++ interfaces/win32/win32wsbuttons.pp	(working copy)
@@ -48,7 +48,6 @@
   public
     class function  CreateHandle(const AWinControl: TWinControl;
           const AParams: TCreateParams): HWND; override;
-    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
     class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override;
   end;
@@ -102,11 +101,6 @@
       Flags := Flags or BS_DEFPUSHBUTTON
     else
       Flags := Flags or BS_PUSHBUTTON;
-    with Params do {BidiMode}
-    begin
-      if AWinControl.UseRightToLeftReading then
-        FlagsEx := FlagsEx or WS_EX_RTLREADING;
-    end;
     pClassName := 'BUTTON';
     WindowTitle := StrCaption;
   end;
@@ -115,12 +109,6 @@
   Result := Params.Window;
 end;
 
-class procedure TWin32WSButton.SetBiDiMode(const AWinControl: TWinControl;
-  const ABiDiMode: TBiDiMode);
-begin
-  RecreateWnd(AWinControl);
-end;
-
 class procedure TWin32WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
 var
   WindowStyle: dword;
Index: interfaces/win32/win32wscontrols.pp
===================================================================
--- interfaces/win32/win32wscontrols.pp	(revision 11212)
+++ interfaces/win32/win32wscontrols.pp	(working copy)
@@ -74,6 +74,7 @@
     class procedure AddControl(const AControl: TControl); override;
 
     class function  GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
     class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
     class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
@@ -137,6 +138,10 @@
   const AlternateCreateWindow: boolean);
 procedure WindowCreateInitBuddy(const AWinControl: TWinControl;
   var Params: TCreateWindowExParams);
+  
+// Must be in win32proc but TCreateWindowExParams declared here
+procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams);
+procedure UpdateStdBiDiModeFlags(const AWinControl: TWinControl);
 
 implementation
 
@@ -182,6 +187,7 @@
     if AWinControl is TCustomControl then
       if TCustomControl(AWinControl).BorderStyle = bsSingle then
         FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
+    SetStdBiDiModeParams(AWinControl, Params);
     {$IFDEF VerboseSizeMsg}
     writeln('TWin32WidgetSet.CreateComponent A ',AWinControl.Name,':',AWinControl.ClassName,' ',Left,',',Top,',',Width,',',Height);
     {$ENDIF}
@@ -280,6 +286,38 @@
       BuddyWindowInfo := nil;
 end;
 
+procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams);
+begin
+  with Params do
+  begin
+    //remove old bidimode ExFlags
+    FlagsEx := FlagsEx and not(WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR);
+
+    if AWinControl.UseRightToLeftAlignment then
+      FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT;
+    if AWinControl.UseRightToLeftReading then
+      FlagsEx := FlagsEx or WS_EX_RTLREADING;
+  end;
+end;
+
+procedure UpdateStdBiDiModeFlags(const AWinControl: TWinControl);
+var
+  FlagsEx: dword;
+begin
+  //UpdateStdBiDiModeFlags must called after form loaded when the BidiMode changed at run time
+  if not WSCheckHandleAllocated(AWinControl, 'UpdateStdBiDiModeFlags') then Exit;
+
+  FlagsEx := GetWindowLong(AWinControl.Handle, GWL_EXSTYLE);
+  FlagsEx := FlagsEx and not (WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR);
+  if AWinControl.UseRightToLeftAlignment then
+    FlagsEx := FlagsEx or WS_EX_RIGHT;
+  if AWinControl.UseRightToLeftReading then
+    FlagsEx := FlagsEx or WS_EX_RTLREADING ;
+  if AWinControl.UseRightToLeftScrollBar then
+    FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR;
+  SetWindowLong(AWinControl.Handle, GWL_EXSTYLE, FlagsEx);
+end;
+
 { TWin32WSWinControl }
 
 class function TWin32WSWinControl.CreateHandle(const AWinControl: TWinControl;
@@ -332,6 +370,12 @@
   Result := false;
 end;
 
+class procedure TWin32WSWinControl.SetBiDiMode(const AWinControl: TWinControl;
+  const ABiDiMode: TBiDiMode);
+begin
+  UpdateStdBiDiModeFlags(AWinControl);
+end;
+
 class procedure TWin32WSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
 begin
   RecreateWnd(AWinControl);
Index: interfaces/win32/win32wsforms.pp
===================================================================
--- interfaces/win32/win32wsforms.pp	(revision 11212)
+++ interfaces/win32/win32wsforms.pp	(working copy)
@@ -245,14 +245,8 @@
        ( not (csDesigning in lForm.ComponentState) and
         (lForm.ShowInTaskBar = stAlways)) then
       Parent := 0;
-    with Params do {BidiMode}
-    begin
-      if AWinControl.UseRightToLeftAlignment then
-        FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT;
-      if AWinControl.UseRightToLeftReading then
-        FlagsEx := FlagsEx or WS_EX_RTLREADING ;
-    end;
   end;
+  SetStdBiDiModeParams(AWinControl, Params);
   // create window
   FinishCreateWindow(AWinControl, Params, false);
   // TODO: proper icon, for now set default icon
Index: interfaces/win32/win32wsmenus.pp
===================================================================
--- interfaces/win32/win32wsmenus.pp	(revision 11212)
+++ interfaces/win32/win32wsmenus.pp	(working copy)
@@ -62,6 +62,7 @@
   protected
   public
     class function  CreateHandle(const AMenu: TMenu): HMENU; override;
+    class procedure BiDiModeChanged(const AMenu: TMenu); override;
   end;
 
   { TWin32WSMainMenu }
@@ -501,7 +502,13 @@
     end;
     dwTypeData := PChar(AMenuItem);
     if AMenuItem.RadioItem then fType := fType or MFT_RADIOCHECK;
-    if AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY;
+    if (AMenuItem.GetIsRightToLeft) then
+    begin
+      fType := fType or MFT_RIGHTORDER;
+      //Reverse the RIGHTJUSTIFY to be left
+      if not AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY;
+    end
+    else if AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY;
   end;
   if dword(InsertMenuItem(ParentMenuHandle,
        AMenuItem.Parent.VisibleIndexOf(AMenuItem), true, @MenuInfo)) = 0 then
@@ -557,6 +564,20 @@
   Result := CreateMenu;
 end;
 
+class procedure TWin32WSMenu.BiDiModeChanged(const AMenu: TMenu);
+begin
+  if AMenu.HandleAllocated then
+  begin
+    SetMenuFlag(AMenu.Handle, MFT_RIGHTORDER or MFT_RIGHTJUSTIFY, AMenu.IsRightToLeft);
+    //TriggerFormUpdate not take TMenu, we repeate the code
+    if (AMenu<>nil) and (AMenu.Parent<>nil)
+    and (AMenu.Parent is TCustomForm)
+    and TCustomForm(AMenu.Parent).HandleAllocated
+    and not (csDestroying in AMenu.Parent.ComponentState) then
+    AddToChangedMenus(TCustomForm(AMenu.Parent).Handle);
+  end;
+end;
+
 { TWin32WSPopupMenu }
 
 class function TWin32WSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU;
@@ -568,11 +589,13 @@
 var
   MenuHandle: HMENU;
   AppHandle: HWND;
+const
+  lAlign: array[Boolean] of Word = (TPM_LEFTALIGN, TPM_RIGHTALIGN);
 begin
   MenuHandle := APopupMenu.Handle;
   AppHandle := TWin32WidgetSet(WidgetSet).AppHandle;
   GetWindowInfo(AppHandle)^.PopupMenu := APopupMenu;
-  TrackPopupMenuEx(MenuHandle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
+  TrackPopupMenuEx(MenuHandle, lAlign[APopupMenu.IsRightToLeft] or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
     X, Y, AppHandle, Nil);
 end;
 
Index: interfaces/win32/win32wsstdctrls.pp
===================================================================
--- interfaces/win32/win32wsstdctrls.pp	(revision 11212)
+++ interfaces/win32/win32wsstdctrls.pp	(working copy)
@@ -62,6 +62,7 @@
           const AParams: TCreateParams): HWND; override;
     class procedure AdaptBounds(const AWinControl: TWinControl;
           var Left, Top, Width, Height: integer; var SuppressMove: boolean); override;
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
   end;
 
   { TWin32WSGroupBox }
@@ -161,7 +162,6 @@
     class function  GetMaxLength(const ACustomEdit: TCustomEdit): integer; {override;}
     class function  GetText(const AWinControl: TWinControl; var AText: string): boolean; override;
 
-    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
     class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
     class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
@@ -247,6 +247,7 @@
     class function  RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
     class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
           const OldShortCut, NewShortCut: TShortCut); override;
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
   end;
 
@@ -445,6 +446,12 @@
   end;
 end;
 
+class procedure TWin32WSCustomGroupBox.SetBiDiMode(
+  const AWinControl: TWinControl; const ABiDiMode: TBiDiMode);
+begin
+  RecreateWnd(AWinControl);
+end;
+
 { TWin32WSCustomListBox }
 
 class procedure TWin32WSCustomListBox.AdaptBounds(
@@ -874,13 +881,6 @@
     pClassName := 'EDIT';
     WindowTitle := StrCaption;
     Flags := Flags or ES_AUTOHSCROLL;
-    with Params do {BidiMode}
-    begin
-      if AWinControl.UseRightToLeftAlignment then
-        FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT;
-      if AWinControl.UseRightToLeftReading then
-        FlagsEx := FlagsEx or WS_EX_RTLREADING ;
-    end;
   end;
   // create window
   FinishCreateWindow(AWinControl, Params, false);
@@ -912,12 +912,6 @@
   AText := GetControlText(AWinControl.Handle);
 end;
 
-class procedure TWin32WSCustomEdit.SetBiDiMode(const AWinControl: TWinControl;
-  const ABiDiMode: TBiDiMode);
-begin
-  RecreateWnd(AWinControl);
-end;
-
 class procedure TWin32WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
 const
   EditStyles: array[TEditCharCase] of integer = (0, ES_UPPERCASE, ES_LOWERCASE);
@@ -1151,6 +1145,13 @@
   // TODO: implement me!
 end;
 
+class procedure TWin32WSCustomCheckBox.SetBiDiMode(
+  const AWinControl: TWinControl; const ABiDiMode: TBiDiMode);
+begin
+//  UpdateStdBiDiModeFlags(AWinControl); not worked
+  RecreateWnd(AWinControl);
+end;
+
 class procedure TWin32WSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
 var
   Flags: WPARAM;
Index: menus.pp
===================================================================
--- menus.pp	(revision 11212)
+++ menus.pp	(working copy)
@@ -189,6 +189,7 @@
     function GetImageList: TCustomImageList; virtual;
     function GetParentComponent: TComponent; override;
     function GetParentMenu: TMenu; virtual;
+    function GetIsRightToLeft:Boolean; virtual;
     function HandleAllocated : Boolean;
     function HasIcon: boolean; virtual;
     function HasParent: Boolean; override;
@@ -295,14 +296,28 @@
     function FindItem(AValue: PtrInt; Kind: TFindItemKind) : TMenuItem;
     function IsShortcut(var Message: TLMKey): boolean;
     function HandleAllocated: Boolean;
-    Function IsRightToLeft: Boolean;
+    function IsRightToLeft: Boolean; virtual;
     procedure HandleNeeded;
     function DispatchCommand(ACommand: Word): Boolean;
+  private
+    FBiDiMode: TBiDiMode;
+    FParentBiDiMode: Boolean;
+    function IsBiDiModeStored: Boolean;
+    procedure SetBiDiMode(const AValue: TBiDiMode);
+    procedure SetParentBiDiMode(const AValue: Boolean);
+//See TCustomForm.CMBiDiModeChanged
+    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
+  protected
+    procedure BidiModeChanged; virtual;
+    procedure ParentBidiModeChanged(AOwner:TComponent);//used in Create constructor
+    procedure ParentBidiModeChanged;
   public
     property Handle: HMenu read GetHandle;
     property Parent: TComponent read FParent write SetParent;
     property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled;
   published
+    property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight;
+    property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
     property Items: TMenuItem read FItems;
     property Images: TCustomImageList read FImages write SetImages;
   end;
Index: stdctrls.pp
===================================================================
--- stdctrls.pp	(revision 11212)
+++ stdctrls.pp	(working copy)
@@ -119,6 +119,7 @@
   published
     property Align;
     property Anchors;
+    property BidiMode;
     property BorderSpacing;
     property Constraints;
     property Ctl3D;
@@ -131,6 +132,7 @@
     property Max;
     property Min;
     property PageSize;
+    property ParentBidiMode;
     property ParentCtl3D;
     property ParentShowHint;
     property PopupMenu;
@@ -170,6 +172,7 @@
     property Align;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property Caption;
     property ChildSizing;
@@ -184,6 +187,7 @@
     property DragMode;
     property Enabled;
     property Font;
+    property ParentBidiMode;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
@@ -383,6 +387,7 @@
     property AutoCompleteText;
     property AutoDropDown;
     property AutoSelect;
+    property BidiMode;
     property BorderSpacing;
     property CharCase;
     property Color;
@@ -419,6 +424,7 @@
     property OnMouseUp;
     property OnStartDrag;
     property OnSelect;
+    property ParentBidiMode;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
@@ -574,6 +580,7 @@
   published
     property Align;
     property Anchors;
+    property BidiMode;
     property BorderSpacing;
     property BorderStyle;
     property ClickOnSelChange;
@@ -613,6 +620,7 @@
     property OnSelectionChange;
     property OnShowHint;
     property OnStartDrag;
+    property ParentBidiMode;
     property ParentShowHint;
     property ParentFont;
     property PopupMenu;
@@ -903,6 +911,7 @@
     property Alignment;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property BorderStyle;
     property Caption;
@@ -925,6 +934,7 @@
     property OnMouseUp;
     property OnResize;
     property OnStartDrag;
+    property ParentBidiMode;
     property ParentFont;
     property ShowAccelChar;
     property TabOrder;
@@ -1019,6 +1029,7 @@
     property AllowGrayed;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property Caption;
     property Checked;
@@ -1049,6 +1060,7 @@
     property ParentColor;
     property ParentFont;
     property ParentShowHint;
+    property ParentBidiMode;
     property PopupMenu;
     property ShowHint;
     property State;
@@ -1192,6 +1204,7 @@
     property AllowGrayed;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property Caption;
     property Checked;
@@ -1217,6 +1230,7 @@
     property OnMouseUp;
     property OnResize;
     property OnStartDrag;
+    property ParentBidiMode;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
@@ -1291,6 +1305,7 @@
     property Alignment;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property Caption;
     property Color;
@@ -1301,6 +1316,7 @@
     property FocusControl;
     property Font;
     property Layout;
+    property ParentBidiMode;
     property ParentColor;
     property ParentFont;
     property ParentShowHint;
Index: widgetset/wsmenus.pp
===================================================================
--- widgetset/wsmenus.pp	(revision 11212)
+++ widgetset/wsmenus.pp	(working copy)
@@ -70,6 +70,7 @@
   TWSMenuClass = class of TWSMenu;
   TWSMenu = class(TWSLCLComponent)
     class function  CreateHandle(const AMenu: TMenu): HMENU; virtual;
+    class procedure BiDiModeChanged(const AMenu: TMenu); virtual;
   end;
 
   { TWSMainMenu }
@@ -146,6 +147,10 @@
   Result := 0;
 end;
 
+class procedure TWSMenu.BiDiModeChanged(const AMenu: TMenu);
+begin
+end;
+
 { TWSPopupMenu }
 
 class procedure TWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
@@ -163,4 +168,4 @@
 //  RegisterWSComponent(TMainMenu, TWSMainMenu);
 //  RegisterWSComponent(TPopupMenu, TWSPopupMenu);
 ////////////////////////////////////////////////////
-end.
\ No newline at end of file
+end.
add_bidimode_stdctrls.patch (25,880 bytes)   

2007-06-08 20:49

 

add_bidimode_tlabel.patch (1,633 bytes)   
Index: graphics.pp
===================================================================
--- graphics.pp	(revision 11212)
+++ graphics.pp	(working copy)
@@ -104,6 +104,8 @@
                               //            foreground color
 
     SystemFont: Boolean;     // Use the system font instead of Canvas Font
+    
+    RightToLeft: Boolean;    //For RightToLeft text reading (Text Direction)
   end;
 
 type
Index: include/canvas.inc
===================================================================
--- include/canvas.inc	(revision 11212)
+++ include/canvas.inc	(working copy)
@@ -1032,6 +1032,9 @@
   If not Style.ShowPrefix then
     Options := Options or DT_NOPREFIX;
 
+  If Style.RightToLeft then
+    Options := Options or DT_RTLREADING;
+
   ReqState:=[csHandleValid];
   if not Style.SystemFont then
     Include(ReqState,csFontValid);
Index: include/customlabel.inc
===================================================================
--- include/customlabel.inc	(revision 11212)
+++ include/customlabel.inc	(working copy)
@@ -392,6 +392,7 @@
       Clipping := True;
       ShowPrefix := ShowAccelChar;
       SystemFont:=false;
+      RightToLeft:=UseRightToLeftReading;
     end;
     TextLeft := R.Left;
     if Layout = tlTop then begin
Index: lcltype.pp
===================================================================
--- lcltype.pp	(revision 11212)
+++ lcltype.pp	(working copy)
@@ -209,6 +209,7 @@
   DT_EDITCONTROL = $2000;
   DT_END_ELLIPSIS = $8000;
   DT_MODIFYSTRING = $10000;
+  DT_RTLREADING =  $20000;
 
 //==============================================
 // Draw frame constants
add_bidimode_tlabel.patch (1,633 bytes)   

Zaher Dirkey

2007-06-08 20:49

reporter   ~0013035

This small patch for TLabel

I DrawMenuItem to also RightToLeft but i can make Patch file (already patched) so i will post here the changes

[code]
procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var checkMarkWidth: integer;
    checkMarkHeight: integer;
    hdcMem: HDC;
    monoBitmap: HBITMAP;
    oldBitmap: HBITMAP;
    checkMarkShape: integer;
    checkMarkRect: Windows.RECT;
    x:Integer;
begin
  hdcMem := CreateCompatibleDC(aHDC);
  checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK);
  checkMarkHeight := GetSystemMetrics(SM_CYMENUCHECK);
  monoBitmap := CreateBitmap(checkMarkWidth, checkMarkHeight, 1, 1, nil);
  oldBitmap := SelectObject(hdcMem, monoBitmap);
  checkMarkRect.left := 0;
  checkMarkRect.top := 0;
  checkMarkRect.right := checkMarkWidth;
  checkMarkRect.bottom := checkMarkHeight;
  if aMenuItem.RadioItem then checkMarkShape := DFCS_MENUBULLET
  else checkMarkShape := DFCS_MENUCHECK;
  DrawFrameControl(hdcMem, @checkMarkRect, DFC_MENU, checkMarkShape);
  if aMenuItem.GetIsRightToLeft then
    x := aRect.Right - checkMarkWidth
  else
    x := aRect.left;
  BitBlt(aHDC, x, aRect.top + topPosition(aRect.bottom - aRect.top, checkMarkRect.bottom - checkMarkRect.top), checkMarkWidth, checkMarkHeight, hdcMem, 0, 0, SRCCOPY);
  SelectObject(hdcMem, oldBitmap);
  DeleteObject(monoBitmap);
  DeleteDC(hdcMem);
end;

procedure DrawMenuItemText(const aMenuItem: TMenuItem; const aHDC: HDC; aRect: Windows.RECT; const aSelected: boolean);
var crText: COLORREF;
    crBkgnd: COLORREF;
    TmpLength: integer;
    TmpHeight: integer;
    oldFont: HFONT;
    newFont: HFONT;
    decoration: TCaptionFlagsSet;
    shortCutText: string;
    WorkRect: Windows.RECT;
  IsRightToLeft: Boolean;
  etoFlags: Cardinal;
  dtFlags: Word;
begin
  crText := TextColorMenu(aSelected, aMenuItem.Enabled);
  crBkgnd := BackgroundColorMenu(aSelected, aMenuItem.IsInMenuBar);
  SetTextColor(aHDC, crText);
  SetBkColor(aHDC, crBkgnd);
  if aMenuItem.Default then decoration := [cfBold]
  else decoration := [];
  newFont := getMenuItemFont(decoration);
  oldFont := SelectObject(aHDC, newFont);
  IsRightToLeft := aMenuItem.GetIsRightToLeft;
  etoFlags := ETO_OPAQUE;
  dtFlags := 0;
  if IsRightToLeft then
  begin
    etoFlags := etoFlags or ETO_RTLREADING;
    dtFlags := dtFlags or DT_RIGHT or DT_RTLREADING;
  end;
  ExtTextOut(aHDC, 0, 0, etoFlags, @aRect, PChar(''), 0, nil);
  TmpLength := aRect.right - aRect.left;
  TmpHeight := aRect.bottom - aRect.top;

  DrawText(aHDC, pChar(aMenuItem.Caption), length(aMenuItem.Caption), @WorkRect, DT_CALCRECT);
  if IsRightToLeft then
    Dec(aRect.Right, leftCaptionPosition(TmpLength, WorkRect.Right - WorkRect.Left, aMenuItem))
  else
    Inc(aRect.Left, leftCaptionPosition(TmpLength, WorkRect.Right - WorkRect.Left, aMenuItem));
  Inc(aRect.Top, topPosition(TmpHeight, WorkRect.Bottom - WorkRect.Top));
  DrawText(aHDC, pChar(aMenuItem.Caption), length(aMenuItem.Caption), @aRect, dtFlags);
  if aMenuItem.ShortCut <> scNone then
  begin
    shortCutText := ShortCutToText(aMenuItem.ShortCut);
    if IsRightToLeft then
    begin
      Inc(aRect.Left, GetSystemMetrics(SM_CXMENUCHECK));
      dtFlags := DT_LEFT;
    end
    else
    begin
      Dec(aRect.Right, GetSystemMetrics(SM_CXMENUCHECK));
      dtFlags := DT_RIGHT;
    end;
      DrawText(aHDC, pChar(shortCutText), Length(shortCutText), @aRect, dtFlags);
  end;
  SelectObject(aHDC, oldFont);
  DeleteObject(newFont);
end;

procedure DrawMenuItemIcon(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var hdcMem: HDC;
    hbmpOld: HBITMAP;
    x:Integer;
begin
  hdcMem := aMenuItem.Bitmap.Canvas.Handle;
  hbmpOld := SelectObject(hdcMem, aMenuItem.Bitmap.Handle);
  if aMenuItem.GetIsRightToLeft then
    x := aRect.Right - LeftIconPosition - aMenuItem.Bitmap.Width
  else
    x := aRect.Left + LeftIconPosition;
  TWin32WidgetSet(WidgetSet).MaskBlt(aHDC, x, aRect.top + TopPosition(aRect.bottom - aRect.top, aMenuItem.Bitmap.Height), aMenuItem.Bitmap.Width, aMenuItem.Bitmap.Height, hdcMem, 0, 0, aMenuItem.Bitmap.MaskHandle, 0, 0);
  SelectObject(hdcMem, hbmpOld);
end;
[/code]

Felipe Monteiro de Carvalho

2007-06-10 21:30

developer   ~0013108

If you modify a patch before it's applied, please create another patch (with all changes) instead of showing the modifications. This is much easier to be checked and applied.

Zaher Dirkey

2007-06-18 14:30

reporter   ~0013245

Ok
"add_bidimode_tlabel.patch" it is worked on different files, but i will make new
patch for last revision of Lazarus with all my modifications, i will do to after modify the TApplication to add BidiMode

Sorry if my note is late, Mantis not send a notification to my email for new notes?

Paul Ishenin

2007-07-02 09:05

manager   ~0013527

Thanks, applied with modifications (look at SetMenuFlag - I removed buffer there)

Issue History

Date Modified Username Field Change
2007-06-02 11:48 Zaher Dirkey New Issue
2007-06-02 11:48 Zaher Dirkey File Added: add_bidimode_stdctrls.patch
2007-06-02 11:48 Zaher Dirkey Widgetset => Win32
2007-06-02 16:28 Paul Ishenin Status new => assigned
2007-06-02 16:28 Paul Ishenin Assigned To => Paul Ishenin
2007-06-08 20:49 Zaher Dirkey File Added: add_bidimode_tlabel.patch
2007-06-08 20:49 Zaher Dirkey Note Added: 0013035
2007-06-10 21:30 Felipe Monteiro de Carvalho Note Added: 0013108
2007-06-18 14:30 Zaher Dirkey Note Added: 0013245
2007-07-02 09:05 Paul Ishenin Fixed in Revision => 11408,11409
2007-07-02 09:05 Paul Ishenin Status assigned => resolved
2007-07-02 09:05 Paul Ishenin Fixed in Version => 0.9.23 (SVN)
2007-07-02 09:05 Paul Ishenin Resolution open => fixed
2007-07-02 09:05 Paul Ishenin Note Added: 0013527
2007-12-12 16:33 Vincent Snijders Status resolved => closed
2010-01-25 23:17 Zaher Dirkey Tag Attached: bidi