richedit2.pas

类似QQ的源码程序

      if (dwMask and CFM_SPACING) <> 0 then Include(Result, caSpacing);
      if (dwMask and CFM_KERNING) <> 0 then Include(Result, caKerning);
      if (dwMask and CFM_UNDERLINETYPE) <> 0 then Include(Result, caULType);
      if (dwMask and CFM_ANIMATION) <> 0 then Include(Result, caAnimation);
      if (dwMask and CFM_SMALLCAPS) <> 0 then Include(Result, caSmallCaps);
      if (dwMask and CFM_ALLCAPS) <> 0 then Include(Result, caAllCaps);
      if (dwMask and CFM_HIDDEN) <> 0 then Include(Result, caHidden);
      if (dwMask and CFM_OUTLINE) <> 0 then Include(Result, caOutline);
      if (dwMask and CFM_SHADOW) <> 0 then Include(Result, caShadow);
      if (dwMask and CFM_EMBOSS) <> 0 then Include(Result, caEmboss);
      if (dwMask and CFM_IMPRINT) <> 0 then Include(Result, caImprint);
      if (dwMask and CFM_LINK)<>0 then Include(result, caURL);
    end;
  end;
end;

procedure TTextAttributes98.GetAttributes(var Format: TCharFormat2W);
begin
  InitFormat(Format);
  if RichEdit.HandleAllocated then
    RichEdit.Perform(EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
end;

procedure TTextAttributes98.SetAttributes(var Format: TCharFormat2W);
var
  Flag: Longint;
begin
  if FType = atSelected then
    begin
      Flag:= SCF_SELECTION or SCF_USEUIRULES;
      if (RichEdit.SelLength=0) and RichEdit.WordFormatting then
        Flag:= Flag or SCF_WORD;
    end
  else
    Flag:= SCF_DEFAULT;
  if RichEdit.HandleAllocated then
    RichEdit.Perform(EM_SETCHARFORMAT, Flag, LPARAM(@Format))
end;

procedure TTextAttributes98.Assign(Source: TPersistent);
begin
  if Source is TTextAttributes98 then       
    begin
      Color := TTextAttributes98(Source).Color;
      Name := TTextAttributes98(Source).Name;
      Size:= TTextAttributes98(Source).Size;
      Pitch := TTextAttributes98(Source).Pitch;
      Weight := TTextAttributes98(Source).Weight;
      BackColor := TTextAttributes98(Source).BackColor;
      Language := TTextAttributes98(Source).Language;
      IndexKind := TTextAttributes98(Source).IndexKind;
      Offset := TTextAttributes98(Source).Offset;
      Spacing := TTextAttributes98(Source).Spacing;
      Kerning := TTextAttributes98(Source).Kerning;
      UnderlineType := TTextAttributes98(Source).UnderlineType;
      Bold := TTextAttributes98(Source).Bold;
      Italic := TTextAttributes98(Source).Italic;
      StrikeOut:= TTextAttributes98(Source).StrikeOut;
      Animation := TTextAttributes98(Source).Animation;
      SmallCaps := TTextAttributes98(Source).SmallCaps;
      AllCaps := TTextAttributes98(Source).AllCaps;
      Hidden := TTextAttributes98(Source).Hidden;
      Outline := TTextAttributes98(Source).Outline;
      Shadow := TTextAttributes98(Source).Shadow;
      Emboss := TTextAttributes98(Source).Emboss;
      Imprint := TTextAttributes98(Source).Imprint;
      IsURL:= TTextAttributes98(Source).IsURL;
    end
  else if Source is TTextAttributes then
    begin
      Color := TTextAttributes(Source).Color;
      Name := TTextAttributes(Source).Name;
      Size:= TTextAttributes(Source).Size;
      Pitch := TTextAttributes(Source).Pitch;
      Bold:= fsBold in TTextAttributes(Source).Style;
      Italic:= fsItalic in TTextAttributes(Source).Style;
      StrikeOut:= fsStrikeOut in TTextAttributes(Source).Style;
      UnderlineType:= TUnderlineType(fsUnderline in TTextAttributes(Source).Style);
    end
  else if Source is TFont then
    begin
      Color := TFont(Source).Color;
      Name := TFont(Source).Name;
      Size:= TFont(Source).Size;
      Pitch := TFont(Source).Pitch;
      Bold:= fsBold in TFont(Source).Style;
      Italic:= fsItalic in TFont(Source).Style;
      StrikeOut:= fsStrikeOut in TFont(Source).Style;
      UnderlineType:= TUnderlineType(fsUnderline in TFont(Source).Style);
    end
  else
    inherited Assign(Source);
end;

procedure TTextAttributes98.AssignTo(Dest: TPersistent);
begin
  if Dest is TTextAttributes98 then
    begin
      TTextAttributes98(Dest).Color := Color;
      TTextAttributes98(Dest).Name := Name;
      TTextAttributes98(Dest).Size := Size;
      TTextAttributes98(Dest).Pitch := Pitch;
      TTextAttributes98(Dest).Weight := Weight;
      TTextAttributes98(Dest).BackColor := BackColor;
      TTextAttributes98(Dest).Language := Language;
      TTextAttributes98(Dest).IndexKind := IndexKind;
      TTextAttributes98(Dest).Offset := Offset;
      TTextAttributes98(Dest).Spacing := Spacing;
      TTextAttributes98(Dest).Kerning := Kerning;
      TTextAttributes98(Dest).UnderlineType := UnderlineType;
      TTextAttributes98(Dest).Bold := Bold;
      TTextAttributes98(Dest).Italic := Italic;
      TTextAttributes98(Dest).Animation := Animation;
      TTextAttributes98(Dest).SmallCaps := SmallCaps;
      TTextAttributes98(Dest).AllCaps := AllCaps;
      TTextAttributes98(Dest).Hidden := Hidden;
      TTextAttributes98(Dest).Outline := Outline;
      TTextAttributes98(Dest).Shadow := Shadow;
      TTextAttributes98(Dest).Emboss := Emboss;
      TTextAttributes98(Dest).Imprint := Imprint;
      TTextAttributes98(Dest).IsURL := IsURL;
    end
  else if Dest is TTextAttributes then
    begin
      TTextAttributes(Dest).Color := Color;
      TTextAttributes(Dest).Name := Name;
      if Bold then
        TTextAttributes(Dest).Style:= [fsBold]
      else
        TTextAttributes(Dest).Style:= [];
      if Italic then
        TTextAttributes(Dest).Style:= TTextAttributes(Dest).Style+[fsItalic];
      if UnderlineType<>ultNone then
        TTextAttributes(Dest).Style:= TTextAttributes(Dest).Style+[fsUnderline];
      TTextAttributes(Dest).Charset := CharsetFromLocale(Language);
      TTextAttributes(Dest).Size := Size;
      TTextAttributes(Dest).Pitch := Pitch;
    end
  else if Dest is TFont then
    begin
      TFont(Dest).Color := Color;
      TFont(Dest).Name := Name;
      if Bold then
        TFont(Dest).Style:= [fsBold]
      else
        TFont(Dest).Style:= [];
      if Italic then
        TFont(Dest).Style:= TTextAttributes(Dest).Style+[fsItalic];
      if UnderlineType<>ultNone then
        TFont(Dest).Style:= TTextAttributes(Dest).Style+[fsUnderline];
      TFont(Dest).Charset := CharsetFromLocale(Language);
      TFont(Dest).Size := Size;
      TFont(Dest).Pitch := Pitch;
    end
  else
    inherited AssignTo(Dest);
end;

function TTextAttributes98.GetProtected: Boolean;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= FOldAttr.Protected;
      Exit;
    end;
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_PROTECTED) <> 0 then
      Result := True else
      Result := False;
end;

procedure TTextAttributes98.SetProtected(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      FOldAttr.Protected:= Value;
      Exit;
    end;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_PROTECTED;
    if Value then dwEffects := CFE_PROTECTED;
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetColor: TColor;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= FOldAttr.Color;
      Exit;
    end;
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_AUTOCOLOR) <> 0 then
      Result := clWindowText else
      Result := crTextColor;
end;

procedure TTextAttributes98.SetColor(Value: TColor);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      FOldAttr.Color:= Value;
      Exit;
    end;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_COLOR;
    if Value = clWindowText then
      dwEffects := CFE_AUTOCOLOR
    else
      crTextColor := ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetName: TFontName;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= FOldAttr.Name;
      Exit;
    end;
  GetAttributes(Format);
  Result := Format.szFaceName;
end;

procedure TTextAttributes98.SetName(Value: TFontName);
var
  Format: TCharFormat2W;
  I: Integer;
  W: WideString;
begin
  if RichEdit.FVer10 then
    begin
      FOldAttr.Name:= Value;
      Exit;
    end;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_FACE;
    W:= Value;
    for I:= 0 to Length(Value)-1 do
      szFaceName[I]:= W[I+1];
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetPitch: TFontPitch;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= FOldAttr.Pitch;
      Exit;
    end;
  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 TTextAttributes98.SetPitch(Value: TFontPitch);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      FOldAttr.Pitch:= Value;
      Exit;
    end;
  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 TTextAttributes98.GetSize: Integer;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= FOldAttr.Size;
      Exit;
    end;
  GetAttributes(Format);
  Result := Format.yHeight div 20;
end;

procedure TTextAttributes98.SetSize(Value: Integer);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      FOldAttr.Size:= Value;
      Exit;
    end;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_SIZE;
    yHeight := Value * 20;
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetWeight: Word;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      if Bold then
        Result:= 700
      else
        Result:= 400;
      Exit;
    end;
  GetAttributes(Format);
  Result := Format.wWeight;
end;

procedure TTextAttributes98.SetWeight(Value: Word);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    Exit;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_Weight;
    wWeight := Value;
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetBackColor: TColor;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= clNone;
      Exit;
    end;
  GetAttributes(Format);
  with Format do
    Result := crBackColor;
end;

procedure TTextAttributes98.SetBackColor(Value: TColor);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    Exit;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_BACKCOLOR;
    crBackColor := ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetLanguage: TLanguage;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= 2048;
      Exit;
    end;
  GetAttributes(Format);
  Result := Format.lid;
end;

procedure TTextAttributes98.SetLanguage(Value: TLanguage);
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    Exit;
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_LCID;
    lid := Value;
  end;
  SetAttributes(Format);
end;

function TTextAttributes98.GetIndexKind: TIndexKind;
var
  Format: TCharFormat2W;
begin
  if RichEdit.FVer10 then
    begin
      Result:= ikNone;
      Exit;
    end;
  GetAttributes(Format);
  case (Format.dwEffects and CFM_SUPERSCRIPT) shr 16 of
  1: Result:= ikSubscript;
  2: Result:= ikSuperscript;
  else Result:= ikNone;
  end;
end;

procedure TTextAttributes98.SetIndexKind(Value: TIndexKind);
var
  Format: TCharFormat2W;
begin