frxrichedit.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

    if (Value = clWindow) or (Value = clDefault) then
      dwEffects:= CFE_AUTOBACKCOLOR
    else crBackColor:= ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetName:TFontName;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  Result:= Format.szFaceName;
end;

procedure TRxTextAttributes.SetName(Value:TFontName);
var
  Format:TCharFormat2;
begin
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_FACE;
    StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetStyle:TFontStyles;
var
  Format:TCharFormat2;
begin
  Result:= [];
  GetAttributes(Format);
  with Format do begin
    if (dwEffects and CFE_BOLD)<>0 then Include(Result, fsBold);
    if (dwEffects and CFE_ITALIC)<>0 then Include(Result, fsItalic);
    if (dwEffects and CFE_UNDERLINE)<>0 then Include(Result, fsUnderline);
    if (dwEffects and CFE_STRIKEOUT)<>0 then Include(Result, fsStrikeOut);
  end;
end;

procedure TRxTextAttributes.SetStyle(Value:TFontStyles);
var
  Format:TCharFormat2;
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 TRxTextAttributes.GetUnderlineType:TUnderlineType;
var
  Format:TCharFormat2;
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 TRxTextAttributes.SetUnderlineType(Value:TUnderlineType);
var
  Format:TCharFormat2;
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 TRxTextAttributes.GetOffset:Integer;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  Result:= Format.yOffset div 20;
end;

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

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

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

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

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

function TRxTextAttributes.GetPitch:TFontPitch;
var
  Format:TCharFormat2;
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 TRxTextAttributes.SetPitch(Value:TFontPitch);
var
  Format:TCharFormat2;
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 TRxTextAttributes.GetSubscriptStyle:TSubscriptStyle;
var
  Format:TCharFormat2;
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 TRxTextAttributes.SetSubscriptStyle(Value:TSubscriptStyle);
var
  Format:TCharFormat2;
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 TRxTextAttributes.AssignFont(Font:TFont);
var
  LogFont:TLogFont;
  Format:TCharFormat2;
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);
    dwMask:= dwMask or CFM_CHARSET;
    bCharSet:= Font.Charset;
    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 TRxTextAttributes.Assign(Source:TPersistent);
var
  Format:TCharFormat2;
begin
  if Source is TFont then AssignFont(TFont(Source))
  else if Source is TTextAttributes then begin
    Name:= TTextAttributes(Source).Name;
    Charset:= TTextAttributes(Source).Charset;
    Style:= TTextAttributes(Source).Style;
    Pitch:= TTextAttributes(Source).Pitch;
    Color:= TTextAttributes(Source).Color;
  end
  else if Source is TRxTextAttributes then begin
    TRxTextAttributes(Source).GetAttributes(Format);
    SetAttributes(Format);
  end
  else inherited Assign(Source);
end;

procedure TRxTextAttributes.AssignTo(Dest:TPersistent);
begin
  if Dest is TFont then begin
    TFont(Dest).Color:= Color;
    TFont(Dest).Name:= Name;
    TFont(Dest).Charset:= Charset;
    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;
    TTextAttributes(Dest).Charset:= Charset;
    TTextAttributes(Dest).Style:= Style;
    TTextAttributes(Dest).Pitch:= Pitch;
  end
  else inherited AssignTo(Dest);
end;

{ TRxParaAttributes }

constructor TRxParaAttributes.Create(AOwner:TRxCustomRichEdit);
begin
  inherited Create;
  RichEdit:= AOwner;
end;

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

procedure TRxParaAttributes.GetAttributes(var Paragraph:TParaFormat2);
begin
  InitPara(Paragraph);
  if RichEdit.HandleAllocated then
    SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
end;

procedure TRxParaAttributes.SetAttributes(var Paragraph:TParaFormat2);
begin
  RichEdit.HandleNeeded; { we REALLY need the handle for BiDi }
  if RichEdit.HandleAllocated then begin
    if RichEdit.UseRightToLeftAlignment then
      if Paragraph.wAlignment = PFA_LEFT then
        Paragraph.wAlignment:= PFA_RIGHT
      else if Paragraph.wAlignment = PFA_RIGHT then
        Paragraph.wAlignment:= PFA_LEFT;
    SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
  end;
end;

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

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

function TRxParaAttributes.GetNumbering:TRxNumbering;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= TRxNumbering(Paragraph.wNumbering);
  if RichEditVersion = 1 then
    if Result<>nsNone then Result:= nsBullet;
end;

procedure TRxParaAttributes.SetNumbering(Value:TRxNumbering);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion = 1 then
    if Value<>nsNone then Value:= TRxNumbering(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 TRxParaAttributes.GetNumberingStyle:TRxNumberingStyle;
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then
    Result:= nsSimple
  else begin
    GetAttributes(Paragraph);
    Result:= TRxNumberingStyle(Paragraph.wNumberingStyle);
  end;
end;

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

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

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

function TRxParaAttributes.GetFirstIndent:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dxStartIndent div 20;
end;

procedure TRxParaAttributes.SetFirstIndent(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask:= PFM_STARTINDENT;
    dxStartIndent:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;