Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > DB-Aware

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 07-30-2004, 05:48 AM
mahmood68 mahmood68 is offline
Junior Member
 
Join Date: Jul 2004
Posts: 6
Default wwDBRichEdit, formated text, OnMouseMove event

Hi,

I have inforpower's wwDBRichEdit component. This component allows to format text within it. I would like to know is there any way to determine whether the text is formated or not when mouse move over the text within the component. There is no mouse click just mouse move on the text.

One of our friend gave me solution on mouse up event. It works fine for mouse up, does not work for OnMouseMove event. I need to click with the component to get it to work.


Could you please guide me how can I implement this on "OnMouseMove" event. When mouse move over the formatted text, display a message or change the cursor style.

If I click on the formatted text cursor is changing and staying as long as I click again on the non formated text.

Thanks a lot for your help.

Thanks,
Mohammed.
Reply With Quote
  #2  
Old 08-02-2004, 05:45 AM
MrBaseball34 MrBaseball34 is offline
Senior Member
 
Join Date: Jan 2001
Posts: 7,260
Default RE: wwDBRichEdit, formated text, OnMouseMove event

That is a different thing altoghether.

I have done some code to get the word under the mouse:
http://216.101.185.148/scripts/isapi.dll/execute?SearchFor=GetTheWordUnderTheMouse+^Delphi

But in order to get the SelAttributes, you must set the
SelStart at the place you want to check the attributes.

This code does what you ask. However, you will only be able to set the attributes of the text if you turn off the
mousemove.

Code:
unit ureattrib;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit, Buttons, ColorGrd;

type
  TForm1 = class(TForm)
    RE: TRichEdit;
    Label1: TLabel;
    Button1: TButton;
    CG: TColorGrid;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    procedure REMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetFontStyle(Format: TCharFormat2): String;
var
    LBold:       Boolean; {CFE_BOLD}
    LItalic:     Boolean; {CFE_ITALIC}
    LUnderline:  Boolean; {CFE_UNDERLINE}
    LStrikeOut:  Boolean; {CFE_STRIKEOUT}
begin
    LBold      := False;
    LItalic    := False;
    LUnderline := False;
    LStrikeOut := False;
    Result := '';
    if ( Format.dwMask and CFM_BOLD ) > 0 then
        LBold := (Format.dwEffects and CFE_BOLD) > 0;
    if ( Format.dwMask and CFM_ITALIC ) > 0 then
        LItalic := (Format.dwEffects and CFE_ITALIC) > 0;
    if ( Format.dwMask and CFM_UNDERLINE ) > 0 then
        LUnderline := (Format.dwEffects and CFE_UNDERLINE) > 0;
    if ( Format.dwMask and CFM_STRIKEOUT ) > 0 then
        LStrikeOut := (Format.dwEffects and CFE_STRIKEOUT) > 0;
    if LBold then
        Result := Result + ' Bold,';
    if LItalic then
        Result := Result + ' Italic,';
    if LUnderline then
        Result := Result + ' Underline,';
    if LStrikeOut then
        Result := Result + ' StrikeOut';
    Result := Trim(Result);
end;

procedure TForm1.REMouseMove(Sender: TObject; Shift: TShiftState;
                                    X, Y: Integer);
var
  XFormat: TCharFormat2;
  pt: TPoint;
  clr1, clr2: String;
  charIndex:  Integer;
begin
  pt:= Point(X, Y);
  charindex := RE.Perform(Messages.EM_CHARFROMPOS, 0,
                          integer(@pt));
  TRichEdit(Sender).SelStart := charindex;
  FillChar(XFormat, SizeOf(XFormat), 0);
  XFormat.cbSize:=sizeOf(TCharFormat2);
  SendMessage(RE.Handle, EM_GETCHARFORMAT,
              SCF_SELECTION, LPARAM(@XFormat));
  ColorToIdent(XFormat.crTextColor, clr1);
  ColorToIdent(XFormat.crBackColor, clr2);
  Label1.Caption := 'Text:' + clr1 + #13 + 'Back:'+ clr2 + #13 + 'Style:' + GetFontStyle(XFormat);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // I'm only doing this to allow me to select text and apply
  // attributes. If your RE is already formatted, you can set your
  // OnMouseMove and remove this code.
  if not Assigned(RE.OnMouseMove) then
    RE.OnMouseMove := REMouseMove
  else
    RE.OnMouseMove := nil;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if not (fsBold in RE.SelAttributes.Style ) then
    RE.SelAttributes.Style :=  RE.SelAttributes.Style + [fsBold]
  else
    RE.SelAttributes.Style :=  RE.SelAttributes.Style - [fsBold];
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  XFormat: TCharFormat2;
begin
  RE.SelAttributes.Color :=  CG.ForegroundColor;
  FillChar(XFormat, SizeOf(XFormat), 0);
  XFormat.cbSize:=sizeOf(TCharFormat2);
  XFormat.dwMask:=CFM_BACKCOLOR;
  XFormat.crBackColor:=ColorToRGB(CG.BackgroundColor and $00FFFFFF);
  SendMessage(RE.Handle, EM_SETCHARFORMAT,
              SCF_SELECTION, LPARAM(@XFormat));
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  if not (fsItalic in RE.SelAttributes.Style ) then
    RE.SelAttributes.Style :=  RE.SelAttributes.Style + [fsItalic]
  else
    RE.SelAttributes.Style :=  RE.SelAttributes.Style - [fsItalic];
end;


procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if not (fsStrikeOut in RE.SelAttributes.Style ) then
    RE.SelAttributes.Style :=  RE.SelAttributes.Style + [fsStrikeOut]
  else
    RE.SelAttributes.Style :=  RE.SelAttributes.Style - [fsStrikeOut];
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  if not (fsUnderline in RE.SelAttributes.Style ) then
    RE.SelAttributes.Style :=  RE.SelAttributes.Style + [fsUnderline]
  else
    RE.SelAttributes.Style :=  RE.SelAttributes.Style - [fsUnderline];
end;

end.
MB34
Reply With Quote
  #3  
Old 08-02-2004, 08:03 AM
mahmood68 mahmood68 is offline
Junior Member
 
Join Date: Jul 2004
Posts: 6
Default RE: wwDBRichEdit, formated text, OnMouseMove event

Hi MB34,

Thanks a lot for your reply.

GetFontStyle is not returning the value for me. And I cannot select text in the component.

Do I need to make changes to any settings.

Thanks,
Mohammed.
Reply With Quote
  #4  
Old 08-02-2004, 08:15 AM
MrBaseball34 MrBaseball34 is offline
Senior Member
 
Join Date: Jan 2001
Posts: 7,260
Default RE: wwDBRichEdit, formated text, OnMouseMove event

OK, it works like this. The sample I provided dose not have
the OnMouseMove set, you must click the button to set it.
It is not set because I wanted to be able to select text
and set its attributes. If your RTF is already formatted,
you don't need that, just set your OnMouseMove to the code.

If you want to send one of your RTF documents to me, I will
modify that sample to work with it.

Remember, if you have the MouseMove set to get the
attributes, you CAN NOT select text with it unless you also
use some other key like Ctrl or Shift and capture that in
the mousemove, too.

Please give me more info about how you want this thing to
work. I was expecting you to be a little more understanding
and be able to take the sample and make it work for you.


MB34
Reply With Quote
  #5  
Old 08-02-2004, 12:37 PM
MrBaseball34 MrBaseball34 is offline
Senior Member
 
Join Date: Jan 2001
Posts: 7,260
Default RE: wwDBRichEdit, formated text, OnMouseMove event

Remember, you can only SELECT text with the mouse when
holding the ctrl key also. Add another label called Label2,
it wil show the word under the mouse.

Code:
function GetFontStyle(Format: TCharFormat2): String;
var
    LBold:       Boolean; {CFE_BOLD}
    LItalic:     Boolean; {CFE_ITALIC}
    LUnderline:  Boolean; {CFE_UNDERLINE}
    LStrikeOut:  Boolean; {CFE_STRIKEOUT}
begin
    LBold      := False;
    LItalic    := False;
    LUnderline := False;
    LStrikeOut := False;
    Result := '';
    if ( Format.dwMask and CFM_BOLD ) > 0 then
        LBold := (Format.dwEffects and CFE_BOLD) > 0;
    if ( Format.dwMask and CFM_ITALIC ) > 0 then
        LItalic := (Format.dwEffects and CFE_ITALIC) > 0;
    if ( Format.dwMask and CFM_UNDERLINE ) > 0 then
        LUnderline := (Format.dwEffects and CFE_UNDERLINE) > 0;
    if ( Format.dwMask and CFM_STRIKEOUT ) > 0 then
        LStrikeOut := (Format.dwEffects and CFE_STRIKEOUT) > 0;
    if LBold then
        Result := Result + ' Bold,';
    if LItalic then
        Result := Result + ' Italic,';
    if LUnderline then
        Result := Result + ' Underline,';
    if LStrikeOut then
        Result := Result + ' StrikeOut';
    Result := Trim(Result);
end;

function TForm1.GetTheWordUnderTheMouse(RE: TRichEdit; pt: TPoint): String;
  function GetWordFromCharIndex(Line: String; Index: Integer): String;
  var
    i, iBeg, iEnd: Integer;
    temp: String;
  begin
    iBeg := 0;
    iEnd := Length(Line);
    // Find space at end of word
    for i := index to Length(Line) do
    begin
      if Trim(Line[i]) = '' then
      begin
        iEnd := i;
        Break;
      end;
    end;
    // find space at beg of word
    for i := index downto 0 do
    begin
      if Trim(line[i]) = '' then
      begin
        iBeg := i+1;
        Break;
      end;
    end;
    Result := Copy(Line, iBeg, iEnd-iBeg);
  end;

var
  i, charindex, lineindex, charoffset, iWordBeg, iWordEnd: Integer;
  sWord, sWordbeg: String;
  XFormat: TCharFormat2;
  clr1, clr2: String;
  charIndex2:  Integer;
begin
  charindex := RE.Perform(Messages.EM_CHARFROMPOS, 0,
                          integer(@pt));
  if charindex >= 0 then
  begin
    lineindex := RE.Perform(EM_EXLINEFROMCHAR, 0, charindex);
    charoffset := charindex - RE.Perform( EM_LINEINDEX, lineindex, 0 );
    sWord := RE.Lines[lineindex];
    if Length(Trim(sWord)) > 0 then
    begin
      sWord := GetWordFromCharIndex(sWord, charoffset);
    end;
  end;
  charIndex2 := RE.SelStart;
  RE.SelStart := charindex;
  FillChar(XFormat, SizeOf(XFormat), 0);
  XFormat.cbSize:=sizeOf(TCharFormat2);
  SendMessage(RE.Handle, EM_GETCHARFORMAT,
              SCF_SELECTION, LPARAM(@XFormat));
  RE.SelStart := charindex2;
  ColorToIdent(XFormat.crTextColor, clr1);
  ColorToIdent(XFormat.crBackColor, clr2);
  Label1.Caption := 'Text:' + clr1 + #13 + 'Back:'+ clr2 + #13 + 'Style:' + GetFontStyle(XFormat);
  Result := sWord;
end;

procedure TForm1.REMouseMove(Sender: TObject; Shift: TShiftState;
                                    X, Y: Integer);
var
  pt: TPoint;
begin
  pt:= Point(X, Y);
  if not (ssCtrl in Shift) then
    Label2.Caption := GetTheWordUnderTheMouse(Sender as TRichEdit, pt);
end;
MB34
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT. The time now is 01:39 PM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.