ariched.pas

来自「delphi编程控件」· PAS 代码 · 共 2,114 行 · 第 1/5 页

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

procedure TAutoTextAttributes.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 TAutoTextAttributes.GetOffset: Longint;
var
  Format: TCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.yOffset div 20;
end;

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

function TAutoTextAttributes.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 TAutoTextAttributes.SetPitch(Value: TFontPitch);
var
  Format: TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    case Value of
      fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
      fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
    else
      Format.bPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  SetAttributes(Format);
end;

function TAutoTextAttributes.GetProtected: Boolean;
var
  Format: TCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_PROTECTED <> 0;
end;

procedure TAutoTextAttributes.SetProtected(Value: Boolean);
var
  Format: TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_PROTECTED;
    if Value then dwEffects := CFE_PROTECTED;
  end;
  SetAttributes(Format);
end;

function TAutoTextAttributes.GetRevAuthor: Byte;
var
  Format: TCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.bRevAuthor;
end;

procedure TAutoTextAttributes.SetRevAuthor(Value: Byte);
var
  Format: TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_REVAUTHOR;
    bRevAuthor := Value;
  end;
  SetAttributes(Format);
end;

function TAutoTextAttributes.GetScript: TScript;
var
  Format: TCharFormat2;
begin
  GetAttributes(Format);
  with Format do
    if dwMask and CFM_SUBSCRIPT = 0 then Result := rscNone
    else
      if dwEffects and CFE_SUBSCRIPT <> 0 then Result := rscSubScript
      else
        if dwEffects and CFE_SUPERSCRIPT <> 0 then Result := rscSuperScript
        else Result := rscNone;
end;

procedure TAutoTextAttributes.SetScript(Value: TScript);
var
  Format: TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_SUBSCRIPT;
    case Value of
      rscSubScript: dwEffects := CFE_SUBSCRIPT;
      rscSuperScript: dwEffects := CFE_SUPERSCRIPT;
    end;
  end;
  SetAttributes(Format);
end;

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

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

function TAutoTextAttributes.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 TAutoTextAttributes.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 TAutoTextAttributes.GetWeight: Word;
var
  Format: TCharFormat2;
begin
  GetAttributes(Format);
  Result := Format.wWeight;
end;

procedure TAutoTextAttributes.SetWeight(Value: Word);
var
  Format: TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_WEIGHT;
    wWeight := Value;
  end;
  SetAttributes(Format);
end;

procedure TAutoTextAttributes.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 TAutoTextAttributes then
    begin
      TAutoTextAttributes(Dest).Color := Color;
      TAutoTextAttributes(Dest).Name := Name;
      TAutoTextAttributes(Dest).Charset := Charset;
      TAutoTextAttributes(Dest).Style := Style;
      TAutoTextAttributes(Dest).Pitch := Pitch;
    end
    else inherited AssignTo(Dest);
end;

procedure TAutoTextAttributes.Assign(Source: TPersistent);
begin
  if Source is TFont then
  begin
    Color := TFont(Source).Color;
    Name := TFont(Source).Name;
    Charset := TFont(Source).Charset;
    Style := TFont(Source).Style;
    Size := TFont(Source).Size;
    Pitch := TFont(Source).Pitch;
  end
  else
    if Source is TAutoTextAttributes then
    begin
      Color := TAutoTextAttributes(Source).Color;
      Name := TAutoTextAttributes(Source).Name;
      Charset := TAutoTextAttributes(Source).Charset;
      Style := TAutoTextAttributes(Source).Style;
      Pitch := TAutoTextAttributes(Source).Pitch;
    end
    else inherited Assign(Source);
end;

{ TAutoParaAttributes }

constructor TAutoParaAttributes.Create(AOwner: TCustomAutoRichEdit);
begin
  inherited Create;
  RichEdit := AOwner;
end;

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

procedure TAutoParaAttributes.InitParagraph(var Paragraph: TParaFormat2);
begin
  FillChar(Paragraph, SizeOf(Paragraph), 0);
  Paragraph.cbSize := SizeOf(Paragraph);
end;

procedure TAutoParaAttributes.SetAttributes(var Paragraph: TParaFormat2);
begin
  if RichEdit.HandleAllocated then
    SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
end;

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

procedure TAutoParaAttributes.SetAlignment(Value: TParagraphAlignment);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_ALIGNMENT;
    wAlignment := Word(Value) + 1;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetFirstIndent: Longint;
begin
  Result := FirstIndentInTwips div 20;
end;

function TAutoParaAttributes.GetFirstIndentInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxStartIndent;
end;

procedure TAutoParaAttributes.SetFirstIndent(Value: Longint);
begin
  FirstIndentInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetFirstIndentInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_STARTINDENT;
    dxStartIndent := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetLeftIndent: Longint;
begin
  Result := LeftIndentInTwips div 20;
end;

function TAutoParaAttributes.GetLeftIndentInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxOffset;
end;

procedure TAutoParaAttributes.SetLeftIndent(Value: Longint);
begin
  LeftIndentInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetLeftIndentInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_OFFSET;
    dxOffset := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetLineSpacing: Longint;
begin
  Result := LineSpacingInTwips div 20;
end;

function TAutoParaAttributes.GetLineSpacingInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dyLineSpacing;
end;

procedure TAutoParaAttributes.SetLineSpacing(Value: Longint);
begin
  LineSpacingInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetLineSpacingInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_LINESPACING;
    dyLineSpacing := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetLineSpacingRule: TLineSpacingRule;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := TLineSpacingRule(Paragraph.bLineSpacingRule);
end;

procedure TAutoParaAttributes.SetLineSpacingRule(Value: TLineSpacingRule);
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_LINESPACING;
    bLineSpacingRule := Byte(Value);
  end;