rm_jvrichedit.pas

这是一个功能强大

    if (dwEffects and CFE_STRIKEOUT) <> 0 then
      Include(Result, fsStrikeOut);
  end;
end;

procedure TJvTextAttributes.SetStyle(Value: TFontStyles);
var
  Format: TJvCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
    if fsBold in Value then
      dwEffects := dwEffects or CFE_BOLD;
    if fsItalic in Value then
      dwEffects := dwEffects or CFE_ITALIC;
    if fsUnderline in Value then
      dwEffects := dwEffects or CFE_UNDERLINE;
    if fsStrikeOut in Value then
      dwEffects := dwEffects or CFE_STRIKEOUT;
  end;
  SetAttributes(Format);
end;

function TJvTextAttributes.GetUnderlineType: TUnderlineType;
var
  Format: TJvCharFormat2;
begin
  Result := utNone;
  if RichEditVersion < 2 then
    Exit;
  GetAttributes(Format);
  with Format do
  begin
    if (dwEffects and CFE_UNDERLINE <> 0) and
      (dwMask and CFM_UNDERLINETYPE = CFM_UNDERLINETYPE) then
      Result := TUnderlineType(bUnderlineType);
  end;
end;

procedure TJvTextAttributes.SetUnderlineType(Value: TUnderlineType);
var
  Format: TJvCharFormat2;
begin
  if RichEditVersion < 2 then
    Exit;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_UNDERLINETYPE or CFM_UNDERLINE;
    bUnderlineType := Ord(Value);
    if Value <> utNone then
      dwEffects := dwEffects or CFE_UNDERLINE;
  end;
  SetAttributes(Format);
end;

function TJvTextAttributes.GetOffset: Integer;
var
  Format: TJvCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.yOffset div 20;
end;

procedure TJvTextAttributes.SetOffset(Value: Integer);
var
  Format: TJvCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := DWORD(CFM_OFFSET);
    yOffset := Value * 20;
  end;
  SetAttributes(Format);
end;

function TJvTextAttributes.GetSize: Integer;
var
  Format: TJvCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.yHeight div 20;
end;

procedure TJvTextAttributes.SetSize(Value: Integer);
var
  Format: TJvCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := DWORD(CFM_SIZE);
    yHeight := Value * 20;
  end;
  SetAttributes(Format);
end;

function TJvTextAttributes.GetHeight: Integer;
begin
  Result := MulDiv(Size, FRichEdit.FScreenLogPixels, 72);
end;

procedure TJvTextAttributes.SetHeight(Value: Integer);
begin
  Size := MulDiv(Value, 72, FRichEdit.FScreenLogPixels);
end;

function TJvTextAttributes.GetPitch: TFontPitch;
var
  Format: TJvCharFormat2;
begin
  GetAttributes(Format);
  case Format.bPitchAndFamily and $03 of
    DEFAULT_PITCH:
      Result := fpDefault;
    VARIABLE_PITCH:
      Result := fpVariable;
    FIXED_PITCH:
      Result := fpFixed;
  else
    Result := fpDefault;
  end;
end;

procedure TJvTextAttributes.SetPitch(Value: TFontPitch);
var
  Format: TJvCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    case Value of
      fpVariable:
        bPitchAndFamily := VARIABLE_PITCH;
      fpFixed:
        bPitchAndFamily := FIXED_PITCH;
    else
      bPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  SetAttributes(Format);
end;

function TJvTextAttributes.GetSubscriptStyle: TSubscriptStyle;
var
  Format: TJvCharFormat2;
begin
  Result := ssNone;
  if RichEditVersion < 2 then
    Exit;
  GetAttributes(Format);
  with Format do
  begin
    if (dwEffects and CFE_SUBSCRIPT) <> 0 then
      Result := ssSubscript
    else
      if (dwEffects and CFE_SUPERSCRIPT) <> 0 then
        Result := ssSuperscript;
  end;
end;

procedure TJvTextAttributes.SetSubscriptStyle(Value: TSubscriptStyle);
var
  Format: TJvCharFormat2;
begin
  if RichEditVersion < 2 then
    Exit;
  InitFormat(Format);
  with Format do
  begin
    dwMask := DWORD(CFM_SUBSCRIPT);
    case Value of
      ssSubscript:
        dwEffects := CFE_SUBSCRIPT;
      ssSuperscript:
        dwEffects := CFE_SUPERSCRIPT;
    end;
  end;
  SetAttributes(Format);
end;

procedure TJvTextAttributes.AssignFont(Font: TFont);
var
  LogFont: TLogFont;
  Format: TJvCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    case Font.Pitch of
      fpVariable:
        bPitchAndFamily := VARIABLE_PITCH;
      fpFixed:
        bPitchAndFamily := FIXED_PITCH;
    else
      bPitchAndFamily := DEFAULT_PITCH;
    end;
    dwMask := dwMask or CFM_SIZE or CFM_BOLD or CFM_ITALIC or
      CFM_UNDERLINE or CFM_STRIKEOUT or CFM_FACE or CFM_COLOR;
    yHeight := Font.Size * 20;
    if fsBold in Font.Style then
      dwEffects := dwEffects or CFE_BOLD;
    if fsItalic in Font.Style then
      dwEffects := dwEffects or CFE_ITALIC;
    if fsUnderline in Font.Style then
      dwEffects := dwEffects or CFE_UNDERLINE;
    if fsStrikeOut in Font.Style then
      dwEffects := dwEffects or CFE_STRIKEOUT;
    StrPLCopy(szFaceName, Font.Name, SizeOf(szFaceName));
    if (Font.Color = clWindowText) or (Font.Color = clDefault) then
      dwEffects := CFE_AUTOCOLOR
    else
      crTextColor := ColorToRGB(Font.Color);
{$IFNDEF COMPILER2}
    dwMask := dwMask or CFM_CHARSET;
    bCharSet := Font.Charset;
{$ENDIF}
    if GetObject(Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then
    begin
      dwMask := dwMask or DWORD(CFM_WEIGHT);
      wWeight := Word(LogFont.lfWeight);
    end;
  end;
  SetAttributes(Format);
end;

procedure TJvTextAttributes.Assign(Source: TPersistent);
var
  Format: TJvCharFormat2;
begin
  if Source is TFont then
    AssignFont(TFont(Source))
  else
    if Source is TTextAttributes then
    begin
      Name := TTextAttributes(Source).Name;
{$IFDEF COMPILER3_UP}
      Charset := TTextAttributes(Source).Charset;
{$ENDIF}
      Style := TTextAttributes(Source).Style;
      Pitch := TTextAttributes(Source).Pitch;
      Color := TTextAttributes(Source).Color;
    end
    else
      if Source is TJvTextAttributes then
      begin
        TJvTextAttributes(Source).GetAttributes(Format);
        SetAttributes(Format);
      end
      else
        inherited Assign(Source);
end;

procedure TJvTextAttributes.AssignTo(Dest: TPersistent);
begin
  if Dest is TFont then
  begin
    TFont(Dest).Color := Color;
    TFont(Dest).Name := Name;
{$IFNDEF COMPILER2}
    TFont(Dest).Charset := Charset;
{$ENDIF}
    TFont(Dest).Style := Style;
    TFont(Dest).Size := Size;
    TFont(Dest).Pitch := Pitch;
  end
  else
    if Dest is TTextAttributes then
    begin
      TTextAttributes(Dest).Color := Color;
      TTextAttributes(Dest).Name := Name;
{$IFDEF COMPILER3_UP}
      TTextAttributes(Dest).Charset := Charset;
{$ENDIF}
      TTextAttributes(Dest).Style := Style;
      TTextAttributes(Dest).Pitch := Pitch;
    end
    else
      inherited AssignTo(Dest);
end;

//=== TJvParaAttributes ======================================================

constructor TJvParaAttributes.Create(AOwner: TJvCustomRichEdit);
begin
  inherited Create;
  FRichEdit := AOwner;
end;

procedure TJvParaAttributes.InitPara(var Paragraph: TJvParaFormat2);
begin
  FillChar(Paragraph, SizeOf(Paragraph), 0);
  if RichEditVersion >= 2 then
    Paragraph.cbSize := SizeOf(Paragraph)
  else
    Paragraph.cbSize := SizeOf(TParaFormat);
end;

procedure TJvParaAttributes.GetAttributes(var Paragraph: TJvParaFormat2);
begin
  InitPara(Paragraph);
  if FRichEdit.HandleAllocated then
    SendMessage(FRichEdit.Handle, EM_GETPARAFORMAT, 0, LParam(@Paragraph));
end;

procedure TJvParaAttributes.SetAttributes(var Paragraph: TJvParaFormat2);
begin
{$IFDEF COMPILER4_UP}
  FRichEdit.HandleNeeded; { we REALLY need the handle for BiDi }
{$ENDIF}
  if FRichEdit.HandleAllocated then
  begin
{$IFDEF COMPILER4_UP}
    if FRichEdit.UseRightToLeftAlignment then
      if Paragraph.wAlignment = PFA_LEFT then
        Paragraph.wAlignment := PFA_RIGHT
      else
        if Paragraph.wAlignment = PFA_RIGHT then
          Paragraph.wAlignment := PFA_LEFT;
{$ENDIF}
    SendMessage(FRichEdit.Handle, EM_SETPARAFORMAT, 0, LParam(@Paragraph));
  end;
end;

function TJvParaAttributes.GetAlignment: TParaAlignment;
var
  Paragraph: TJvParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := TParaAlignment(Paragraph.wAlignment - 1);
end;

procedure TJvParaAttributes.SetAlignment(Value: TParaAlignment);
var
  Paragraph: TJvParaFormat2;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_ALIGNMENT;
    wAlignment := Ord(Value) + 1;
  end;
  SetAttributes(Paragraph);
end;

function TJvParaAttributes.GetNumbering: TJvNumbering;
var
  Paragraph: TJvParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := TJvNumbering(Paragraph.wNumbering);
  if RichEditVersion = 1 then
    if Result <> nsNone then
      Result := nsBullet;
end;

procedure TJvParaAttributes.SetNumbering(Value: TJvNumbering);
var
  Paragraph: TJvParaFormat2;
begin
  if RichEditVersion = 1 then
    if Value <> nsNone then
      Value := TJvNumbering(PFN_BULLET);
  case Value of
    nsNone:
      LeftIndent := 0;
  else
    if LeftIndent < 10 then
      LeftIndent := 10;
  end;
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_NUMBERING;
    wNumbering := Ord(Value);
  end;
  SetAttributes(Paragraph);
end;

function TJvParaAttributes.GetNumberingStyle: TJvNumberingStyle;
var
  Paragraph: TJvParaFormat2;
begin
  if RichEditVersion < 2 then
    Result := nsSimple
  else
  begin
    GetAttributes(Paragraph);
    Result := TJvNumberingStyle(Paragraph.wNumberingStyle);
  end;
end;

procedure TJvParaAttributes.SetNumberingStyle(Value: TJvNumberingStyle);
var
  Paragraph: TJvParaFormat2;
begin
  if RichEditVersion < 2 then
    Exit;
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_NUMBERINGSTYLE;
    wNumberingStyle := Ord(Value);
  end;
  SetAttributes(Paragraph);
end;

function TJvParaAttributes.GetNumberingTab: Word;
var
  Paragraph: TJvParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.wNumberingTab div 20;
end;

procedure TJvParaAttributes.SetNumberingTab(Value: Word);
var
  Paragraph: TJvParaFormat2;
begin
  if RichEditVersion < 2 then
    Exit;
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_NUMBERINGTAB;
    wNumberingTab := Value * 20;