rxrichedit(unicode).pas

delphi下UDP协议穿透[打洞]源代码

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: TCharFormat2W;
begin
  Result := 0;
  if RichEditVersion < 2 then Exit;
  GetAttributes(Format);
  Result := Format.yOffset div 20;
end;

procedure TRxTextAttributes.SetOffset(Value: Integer);
var
  Format: TCharFormat2W;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask := DWORD(CFM_OFFSET);
    yOffset := Value * 20;
  end;
  SetAttributes(Format);
end;

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

procedure TRxTextAttributes.SetSize(Value: Integer);
var
  Format: TCharFormat2W;
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: TCharFormat2W;
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: TCharFormat2W;
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: TCharFormat2W;
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: TCharFormat2W;
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;

function TRxTextAttributes.GetWeight: Word;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.wWeight;
end;

procedure TRxTextAttributes.SetWeight(Value: Word);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_Weight;
    wWeight := Value;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetSpacing: Double;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.sSpacing/20;
end;

procedure TRxTextAttributes.SetSpacing(Value: Double);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_SPACING;
    sSpacing := Round(Value*20);
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetKerning: Double;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.wKerning/20;
end;

procedure TRxTextAttributes.SetKerning(Value: Double);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_KERNING;
    wKerning := Round(Value*20);
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetAnimation: TAnimationType;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := TAnimationType(Format.bAnimation);
end;

procedure TRxTextAttributes.SetAnimation(Value: TAnimationType);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_ANIMATION;
    bAnimation := Byte(Value);
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetSmallCaps: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_SMALLCAPS <>0;
end;

procedure TRxTextAttributes.SetSmallCaps(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_SMALLCAPS;
    if Value then
      dwEffects:= CFE_SMALLCAPS;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetAllCaps: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_ALLCAPS <>0;
end;

procedure TRxTextAttributes.SetAllCaps(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_ALLCAPS;
    if Value then
      dwEffects:= CFE_ALLCAPS;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetOutline: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_OUTLINE <>0;
end;

procedure TRxTextAttributes.SetOutline(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_OUTLINE;
    if Value then
      dwEffects:= CFE_OUTLINE;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetShadow: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_SHADOW <>0;
end;

procedure TRxTextAttributes.SetShadow(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_SHADOW;
    if Value then
      dwEffects:= CFE_SHADOW;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetEmboss: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_EMBOSS <>0;
end;

procedure TRxTextAttributes.SetEmboss(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_EMBOSS;
    if Value then
      dwEffects:= CFE_EMBOSS;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetImprint: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_IMPRINT <>0;
end;

procedure TRxTextAttributes.SetImprint(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_IMPRINT;
    if Value then
      dwEffects:= CFE_IMPRINT;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetIsURL: Boolean;
var
  Format: TCharFormat2W;
begin
  GetAttributes(Format);
  Result := Format.dwEffects and CFE_LINK <>0;
end;

procedure TRxTextAttributes.SetIsURL(Value: Boolean);
var
  Format: TCharFormat2W;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_LINK;
    if Value then
      dwEffects:= CFE_LINK;
  end;
  SetAttributes(Format);
end;

procedure TRxTextAttributes.AssignFont(Font: TFont);
var
  LogFont: TLogFont;
  Format: TCharFormat2W;
  fn: WideString;
  I: Integer;
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;

    fn := CharToWide(Font.Name,RichEdit.__FCP);
    for I:= 0 to Length(Font.Name)-1 do
      szFaceName[I]:= fn[I+1];

    //I know ObjectPascal less, so make below trials.
    //MoveMemory(@szFaceName, PWideChar(fn), SizeOf(szFaceName));
    //MoveMemory(POINTER(szFaceName[0]), PWideChar(fn), SizeOf(szFaceName));
    //StrPLCopy(szFaceName, PWideChar(fn), SizeOf(szFaceName));
    //StrPLCopy(szFaceName, Font.Name, SizeOf(szFaceName));

    if (Font.Color = clWindowText) or (Font.Color = clDefault) then
      dwEffects := CFE_AUTOCOLOR
    else crTextColor := ColorToRGB(Font.Color);
{$IFNDEF VER90}
    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 TRxTextAttributes.Assign(Source: TPersistent);
var
  Format: TCharFormat2W;
begin
  if Source is TFont then AssignFont(TFont(Source))
  else if Source is TTextAttributes then begin
    Name := TTextAttributes(Source).Name;
{$IFDEF RX_D3}
    Charset := TTextAttributes(Source).Charset;
{$ENDIF}
    Style := TTextAttributes(Source).Style;
    Pitch := TTextAttributes(Source).Pitch;
    Color := TTextAttributes(Source).Color;
  end
  else if Source is TRxT