Recent

Author Topic: Add support "Bidi Mode"/"Right to left"  (Read 22548 times)

Zaher

  • Hero Member
  • *****
  • Posts: 571
    • parmaja.com
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #15 on: June 02, 2007, 11:57:55 am »
I added new patch in the tracker.
I need show this function

This way to send notification to all components in the form for ParentBidiMode

in customform.inc

Code: [Select]

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;

If you not like it you can return to the old way.

Some components visual in the form but derived from TComponent like as Menu some some of TToolbar like as Toolbar2000.
This component need notification from the Form about visual changes like as BidiMode, i think we need a middle class between TCompnent (or TLCLComponent) and and TCustomControl and TCustomControl derived from it and TMenu also.

Zaher

  • Hero Member
  • *****
  • Posts: 571
    • parmaja.com
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #16 on: June 08, 2007, 08:51:48 pm »
Added small patch for TLabel in same issue in bug tracker
http://www.freepascal.org/mantis/view.php?id=8996

Also DrawMenuItem to be RightToLeft drawing but i can not make Patch file (already patched) so i will post here the changes, or i make patch again

Code: [Select]

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;

Paul Ishenin

  • Sr. Member
  • ****
  • Posts: 274
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #17 on: June 09, 2007, 09:33:40 am »
I cannot promice that your latest patches will be in 0.9.24 since we have now other problems that should be solved in short time. But I promice you that after 0.9.24 will be released I will apply your patches (or if we'll have enough time after current problems before release).

Zaher

  • Hero Member
  • *****
  • Posts: 571
    • parmaja.com
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #18 on: June 09, 2007, 11:58:00 pm »
Yes Paul, i know how long it take (i have a long breath), and we all have job and family :)
The first patch that you applied is enough to me to start to porting my components, but i will keep to make some patches here and in bug the tracker to save my work (i hate to save it only in my computer).

I like to get round about GTK2, it is still strange to me but i wish a good luck with it.

Paul Ishenin

  • Sr. Member
  • ****
  • Posts: 274
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #19 on: July 02, 2007, 09:06:45 am »
Sorry for long delay. I applied your patches today with some modifications. Look at mantis issue for details and please check if it will work with that modification.

Zaher

  • Hero Member
  • *****
  • Posts: 571
    • parmaja.com
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #20 on: July 03, 2007, 12:13:32 am »
Thanks, do not sorry about long time, i know you are (all the team) hard working on Lazarus.

SetMenuFlag worked now without buffer but need to make MIIM_TYPE instead of MIIM_FTYPE (i fixed in the patch), but i believed i needed a buffer to save the caption of first item (this is a bug or something wrong in MS Windows) but now it is worked without it.

I have next patch to fix drawing the menu item in the
bug tracker

See this picture for the demo after it finished

(http://www.parmaja.com/temp/BidiMode_RightToLeft.png)

There is also another patch (not now) i will make it for TApplication.BidiMode.

Paul Ishenin

  • Sr. Member
  • ****
  • Posts: 274
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #21 on: July 03, 2007, 03:32:50 am »
Well done. Maybe better to place this image to Wiki page too and to update it when new parts will be ready?

Paul Ishenin

  • Sr. Member
  • ****
  • Posts: 274
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #22 on: July 03, 2007, 05:36:17 am »
I applied your latest patch. But I have a question why we need MIIM_TYPE instead of MIIM_FTYPE if we only need to change menu flag?
from MS help:
Quote
MIIM_TYPE Retrieves or sets the fType and dwTypeData members. Windows 98/Me, Windows 2000/XP: MIIM_TYPE is replaced by MIIM_BITMAP, MIIM_FTYPE, and MIIM_STRING.


If we need to change only fType then we should use MIIM_FTYPE mask.

Zaher

  • Hero Member
  • *****
  • Posts: 571
    • parmaja.com
RE: Re: Add support "Bidi Mode"/"Right to lef
« Reply #23 on: July 03, 2007, 03:31:36 pm »
I think we must lookup to Windows source :) , in fact that problem come from Win 95 and still to WinXp

http://support.microsoft.com/kb/253308

With MIIM_FTYPE
(http://www.parmaja.com/temp/BidiModeBadMenu.png)

With MIIM_TYPE
(http://www.parmaja.com/temp/BidiModeGoodMenu.png)

I make many test to menus and look in Delphi source before make menu patch.