syneditexport.pas

一个非常好的c++编译器

  {$ENDIF}
  else
    CopyToClipboardFormat(GetClipboardFormat);
end;

procedure TSynCustomExporter.CopyToClipboardFormat(AFormat: UINT);
{$IFNDEF SYN_CLX}
var
  hData: THandle;
  hDataSize: UINT;
  PtrData: PChar;
{$ENDIF}
begin
{$IFNDEF SYN_CLX}
  hDataSize := GetBufferSize + 1;
  hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT or GMEM_SHARE, hDataSize);
  if hData <> 0 then try
    PtrData := GlobalLock(hData);
    if Assigned(PtrData) then begin
      try
        fBuffer.Position := 0;
        fBuffer.Read(PtrData^, hDataSize - 1); // trailing #0
      finally
        GlobalUnlock(hData);
      end;
      Clipboard.SetAsHandle(AFormat, hData);
    end else
      Abort;
  except
    GlobalFree(hData);
    OutOfMemoryError;
  end;
{$ENDIF}
end;

procedure TSynCustomExporter.ExportAll(ALines: TStrings);
begin
  ExportRange(ALines, BufferCoord(1, 1), BufferCoord(MaxInt, MaxInt));
end;

procedure TSynCustomExporter.ExportRange(ALines: TStrings; Start, Stop: TBufferCoord);
var
  i: integer;
  Line, Token: string;
  Attri: TSynHighlighterAttributes;
begin
  // abort if not all necessary conditions are met
  if not Assigned(ALines) or not Assigned(Highlighter) or (ALines.Count = 0)
    or (Start.Line > ALines.Count) or (Start.Line > Stop.Line)
  then
  {$IFDEF SYN_CLX}
    exit;
  {$ELSE}
    Abort;
  {$ENDIF}
  Stop.Line := Max(1, Min(Stop.Line, ALines.Count));
  Stop.Char := Max(1, Min(Stop.Char, Length(ALines[Stop.Line - 1]) + 1));
  Start.Char := Max(1, Min(Start.Char, Length(ALines[Start.Line - 1]) + 1));
  if (Start.Line = Stop.Line) and (Start.Char >= Stop.Char) then
  {$IFDEF SYN_CLX}
    exit;
  {$ELSE}
    Abort;
  {$ENDIF}
  // initialization
  fBuffer.Position := 0;
  // Size is ReadOnly in Delphi 2
  fBuffer.SetSize(Max($1000, (Stop.Line - Start.Line) * 128));
  Highlighter.ResetRange;
  // export all the lines into fBuffer
  fFirstAttribute := TRUE;
  for i := Start.Line to Stop.Line do
  begin
    Line := ALines[i - 1];
    // order is important, since Start.Y might be equal to Stop.Y
    if i = Stop.Line then
      Delete(Line, Stop.Char, MaxInt);
    if (i = Start.Line) and (Start.Char > 1) then
      Delete(Line, 1, Start.Char - 1);
    // export the line
    Highlighter.SetLine(Line, i);
    while not Highlighter.GetEOL do begin
      Attri := Highlighter.GetTokenAttribute;
      Token := ReplaceReservedChars(Highlighter.GetToken);
      SetTokenAttribute(Attri);
      FormatToken(Token);
      Highlighter.Next;
    end;
    FormatNewLine;
  end;
  if not fFirstAttribute then
    FormatAfterLastAttribute;
  // insert header
  fBuffer.SetSize(fBuffer.Position);
  InsertData(0, GetHeader);
  // add footer
  AddData(GetFooter);
  // Size is ReadOnly in Delphi 2
  fBuffer.SetSize(fBuffer.Position);
end;

procedure TSynCustomExporter.FormatToken(Token: string);
begin
  AddData(Token);
end;

function TSynCustomExporter.GetBufferSize: integer;
begin
  Result := fBuffer.Size;
end;

function TSynCustomExporter.GetClipboardFormat: UINT;
begin
  Result := fClipboardFormat;
end;

function TSynCustomExporter.GetFormatName: string;
begin
  Result := '';
end;

procedure TSynCustomExporter.InsertData(APos: integer; const AText: string);
var
  Len, ToMove, SizeNeeded: integer;
  Dest: PChar;
begin
  Len := Length(AText);
  if Len > 0 then begin
    ToMove := fBuffer.Position;
    SizeNeeded := ToMove + Len;
    if fBuffer.Size < SizeNeeded then
      // Size is ReadOnly in Delphi 2
      fBuffer.SetSize((SizeNeeded + $1800) and not $FFF); // increment in pages
    Dest := fBuffer.Memory;
    Inc(Dest, Len);
    Move(fBuffer.Memory^, Dest^, ToMove);
    fBuffer.Position := 0;
    fBuffer.Write(AText[1], Len);
    fBuffer.Position := ToMove + Len;
  end;
end;

{$IFDEF SYN_MBCSSUPPORT}
function TSynCustomExporter.ReplaceMBCS(Char1, Char2: char): string;
begin
  SetLength(Result, 2);
  Result[1] := Char1;
  Result[2] := Char2;
end;
{$ENDIF}

function TSynCustomExporter.ReplaceReservedChars(AToken: string): string;
var
  I, ISrc, IDest, SrcLen, DestLen: integer;
  Replace: string;
  c: char;
begin
  if AToken <> '' then begin
    SrcLen := Length(AToken);
    ISrc := 1;
    DestLen := SrcLen;
    IDest := 1;
    SetLength(Result, DestLen);
    while ISrc <= SrcLen do begin
      c := AToken[ISrc];
      if fReplaceReserved[c] <> nil then begin
        Replace := StrPas(fReplaceReserved[c]);
        Inc(ISrc);
{$IFDEF SYN_MBCSSUPPORT}
      end else if (AToken[ISrc] in LeadBytes) and (AToken[ISrc + 1] <> #0) then
      begin
        Replace := ReplaceMBCS(AToken[ISrc], AToken[ISrc + 1]);
        Inc(ISrc, 2);
{$ENDIF}
      end else begin
        if IDest > DestLen then begin
          Inc(DestLen, 32);
          SetLength(Result, DestLen);
        end;
        Result[IDest] := c;
        Inc(ISrc);
        Inc(IDest);
        continue;
      end;
      if IDest + Length(Replace) - 1 > DestLen then begin
        Inc(DestLen, Max(32, IDest + Length(Replace) - DestLen));
        SetLength(Result, DestLen);
      end;
      for I := 1 to Length(Replace) do begin
        Result[IDest] := Replace[I];
        Inc(IDest);
      end;
    end;
    SetLength(Result, IDest - 1);
  end else
    Result := '';
end;

procedure TSynCustomExporter.SaveToFile(const AFileName: string);
begin
  fBuffer.Position := 0;
  fBuffer.SaveToFile(AFileName);
end;

procedure TSynCustomExporter.SaveToStream(AStream: TStream);
begin
  fBuffer.Position := 0;
  fBuffer.SaveToStream(AStream);
end;

procedure TSynCustomExporter.SetExportAsText(Value: boolean);
begin
  if fExportAsText <> Value then begin
    fExportAsText := Value;
    Clear;
  end;
end;

procedure TSynCustomExporter.SetFont(Value: TFont);
begin
  AssignFont(Value);
end;

procedure TSynCustomExporter.SetHighlighter(Value: TSynCustomHighlighter);
begin
  if fHighlighter <> Value then begin
    if fHighlighter <> nil then
      fHighlighter.FreeNotification(Self);
    fHighlighter := Value;
    Clear;
    if Assigned(fHighlighter) and Assigned(fHighlighter.WhitespaceAttribute) and fUseBackground then
      fBackgroundColor := fHighlighter.WhitespaceAttribute.Background;
  end;
end;

procedure TSynCustomExporter.SetTitle(const Value: string);
begin
  if fTitle <> Value then begin
    if Value <> '' then
      fTitle := Value
    else
      fTitle := SYNS_Untitled;
  end;
end;

procedure TSynCustomExporter.SetTokenAttribute(Attri: TSynHighlighterAttributes);
var
  ChangedBG: boolean;
  ChangedFG: boolean;
  ChangedStyles: TFontStyles;

  function ValidatedColor(AColor, ADefColor: TColor): TColor;
  begin
    if AColor = clNone then
      Result := ColorToRGB(ADefColor)
    else
      Result := ColorToRGB(AColor);
  end;

begin
  if fFirstAttribute then begin
    fFirstAttribute := FALSE;
    fLastBG := ValidatedColor(Attri.Background, fBackgroundColor);
    fLastFG := ValidatedColor(Attri.Foreground, fFont.Color);
    fLastStyle := Attri.Style;
    FormatBeforeFirstAttribute(UseBackground and (fLastBG <> fBackgroundColor),
      fLastFG <> fFont.Color, Attri.Style);
  end else begin
    ChangedBG := UseBackground and
      (fLastBG <> ValidatedColor(Attri.Background, fBackgroundColor));
    ChangedFG := (fLastFG <> ValidatedColor(Attri.Foreground, fFont.Color));
    // which font style bits are to reset?
    ChangedStyles := fLastStyle - Attri.Style;
    if ChangedBG or ChangedFG or (fLastStyle <> Attri.Style) then begin
      FormatAttributeDone(ChangedBG, ChangedFG, ChangedStyles);
      // which font style bits are to set?
      ChangedStyles := Attri.Style - fLastStyle;
      fLastBG := ValidatedColor(Attri.Background, fBackgroundColor);
      fLastFG := ValidatedColor(Attri.Foreground, fFont.Color);
      fLastStyle := Attri.Style;
      FormatAttributeInit(ChangedBG, ChangedFG, ChangedStyles);
    end;
  end;
end;

procedure TSynCustomExporter.SetUseBackground(const Value: boolean);
begin
  fUseBackground := Value;
  if Assigned(fHighlighter) and Assigned(fHighlighter.WhitespaceAttribute) and fUseBackground then
    fBackgroundColor := fHighlighter.WhitespaceAttribute.Background;
end;

end.