richedithighlight.pas.svn-base

这是一段游戏修改工具的源代码.ring3功能由dephi开发,驱动是C开发.希望对大家有帮助

          FIdentifierColor,
          FKeyColor,
          FNumberColor,
          FSpaceColor,
          FStringColor,
          FSymbolColor,
          FUnknownColor]);
      end;
    stXML :
      begin
       FSyntax.CreateColorTable([
       FElementColor,
       FAttributeColor,
       FnsAttributeColor,
       FEqualColor,
       FnsEqualColor,
       FQuoteAttrValueColor,
       FAPosAttrValueColor,
       FnsQuoteAttrValueColor,
       FnsAPosAttrValueColor,
       FTextColor,
       FCDATAColor]);
      end;
    stDelphi :
      begin
        FSyntax.CreateColorTable([
        FCommentColor,
        FIdentifierColor,
        FKeyColor,
        FNumberColor,
        FSpaceColor,
        FStringColor,
        FSymbolColor,
        FUnknownColor]);
      end;
  end;
end;

destructor TRichEditSyntax.Destroy;
begin
  if Assigned(FSyntax) then
   begin
     FSyntax.Free;
     FSyntax := nil;
   end;
  inherited;
end;

function TRichEditSyntax.GetTokenSet(
  ALanguage: TSyntaxType): TpsvTokenTypes;
begin
  case ALanguage of
   stCPlusPlus : Result := [ttAsm, ttComment, ttDirective, ttIdentifier, ttKey, ttNull,
    ttNumber, ttSpace, ttString, ttSymbol, ttUnknown,ttChar, ttFloat, ttHex, ttOctal];

   stDFM : Result := [ttComment, ttIdentifier, ttKey, ttNull, ttNumber, ttSpace,
    ttString, ttSymbol, ttUnknown];

   stJScript : Result := [ttComment, ttIdentifier, ttKey, ttNull, ttNumber, ttSpace,
    ttString, ttSymbol, ttUnknown];

   stSQL : Result := [ttComment, ttIdentifier, ttKey, ttNull,  ttNumber, ttString,
    ttSymbol, ttUnknown];

   stVB : Result := [ttComment, ttIdentifier, ttKey, ttNull, ttNumber, ttSpace,
    ttString, ttSymbol, ttUnknown];

   stVBScript : Result := [ttComment, ttIdentifier, ttKey, ttNull, ttNumber, ttSpace,
    ttString, ttSymbol, ttUnknown];

   stXML : Result := [ttNull,
    ttElement,
    ttAttribute,
    ttText,
    ttCDATA,
    ttEntityRef,
    ttProcessingInstruction,
    ttComment,
    ttQuoteAttrValue,
    ttAposAttrValue,
    ttQuoteEntityRef,
    ttAposEntityRef,
    ttSymbol,
    ttSpace,
    ttEqual,
    ttnsAttribute,
    ttnsQuoteAttrValue,
    ttnsAposAttrValue,
    ttnsQuoteEntityRef,
    ttnsAposEntityRef,
    ttnsEqual];

   stDelphi : Result := [ttAsm, ttComment, ttIdentifier, ttKey, ttNull, ttNumber,
    ttSpace, ttString, ttSymbol, ttUnknown];
  end;
end;

procedure TRichEditSyntax.LoadFromFile(AFileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TRichEditSyntax.LoadFromStream(AStream: TStream);
var
 S : string;
 MS : TMemoryStream;
 EditStream: TEditStream;
 Format: WPARAM;
begin
  try
  FLoading := true;
  SetLength(S,AStream.Size);
  AStream.Position := 0;
  MS := TMemoryStream.Create;
  AStream.ReadBuffer(S[1],AStream.Size);
  FSyntax.SetText(S);
  FSyntax.CreateFontTable([Self.Font]);
  FSyntax.ConvertToRTFStream(MS);
  MS.Position := 0;
  with EditStream do
    begin
    dwCookie    := Longint(MS);
    pfnCallBack := @doStreamIn;
    dwError := 0;
    end;

  Format := SF_RTF;
  SendMessage(Handle, EM_STREAMIN, Format,
            Longint(@EditStream));
  if EditStream.dwError <> 0 then
      raise EOutOfResources.Create('Cannot load RTF text');
  finally
    PlainText := true;
    FLoading := false;
  end;
end;

procedure TRichEditSyntax.LoadFromStreamToSelection(AStream: TStream);
var
 S : string;
 MS : TMemoryStream;
 EditStream: TEditStream;
 Format: WPARAM;
begin
  try
  FLoading := true;
  SetLength(S,AStream.Size);
  AStream.Position := 0;
  MS := TMemoryStream.Create;
  AStream.ReadBuffer(S[1],AStream.Size);
  FSyntax.SetText(S);
  FSyntax.CreateFontTable([Self.Font]);
  FSyntax.ConvertToRTFStream(MS);
  MS.Position := 0;
  with EditStream do
    begin
    dwCookie    := Longint(MS);
    pfnCallBack := @doStreamIn;
    dwError := 0;
    end;
  // faz carregar apenas para o texto selecionado
  Format := SF_RTF or SFF_SELECTION;
//  lockWindowUpdate(Handle);
  SendMessage(Handle, EM_STREAMIN, Format, Longint(@EditStream));
//  lockWindowUpdate(0);
  if EditStream.dwError <> 0 then
      raise EOutOfResources.Create('Cannot load RTF text');
  finally
    PlainText := true;
    FLoading := false;
  end;
end;

procedure TRichEditSyntax.SaveToFile(AFileName: string);
begin
  PlainText := true;
  Lines.SaveToFile(AFileName);
end;

procedure TRichEditSyntax.SaveToStream(AStream: TStream);
begin
  PlainText := true;
  Lines.SaveToStream(AStream);
end;

procedure TRichEditSyntax.SetSyntaxType(AValue: TSyntaxType);
begin
  FSyntaxType := AValue;
  if Assigned(FSyntax) then
   begin
     FSyntax.Free;
     FSyntax := nil;
   end;
  case FSyntaxType of
   stCPlusPlus : FSyntax := TpsvCppRTF.Create;
  // stDFM : FSyntax := TpsvDFMRTF.Create;
   //stJScript : FSyntax := TpsvJScriptRTF.Create;
   //stSQL : FSyntax := TpsvSQLRTF.Create;
   //stVB : fSyntax := TpsvVBRTF.Create;
  // stVBScript : FSyntax := TpsvVBScriptRTF.Create;
  // stDelphi : FSyntax := TpsvPasRTF.Create;
   //stXML : FSyntax := TpsvXMLRTF.Create;
  end;
  Change;
end;

procedure TRichEditSyntax.SetUseDefaultColors(const Value: boolean);
begin
  FUseDefaultColors := Value;
  if FUseDefaultColors then
   begin
     if Assigned(FSyntax) then
      begin
        FSyntax.SetupDefaultColors;
      end;
   end
    else
      begin
        if Assigned(FSyntax) then
         Self.CreateColorTable;
      end;
end;


function TRichEditSyntax.SelectLine(Index: Integer): boolean;
var
  StartPos, EndPos: integer;
begin
  result := false;
  if Index < 0 then Exit;
  StartPos :=  Perform(EM_LINEINDEX, Index, 0);
  if StartPos <> -1 then
    begin
      EndPos := SendMessage(Handle, EM_LINEINDEX, Index + 1, 0);
      if EndPos = -1 then
        EndPos := StartPos + Perform(EM_LINELENGTH, StartPos, 0);
      Perform(EM_SETSEL, StartPos, EndPos);
      result := true;
    end;
end;



procedure TRichEditSyntax.UpdateSyntax;
var
  TempMS: TStringStream;
  pos, top: Integer;
  SaveOnChange: TNotifyEvent;
  SaveOnKeyDown : TKeyEvent;
  SaveOnSelectionChange : TNotifyEvent;
  EventMask : integer;
begin
 if (Length(Text) <= 0) then
  exit;
 if FLoading then
  Exit;
 Perform(WM_SETREDRAW, 0, 0);
 EventMask := Perform(EM_SETEVENTMASK, 0, 0);
 SaveOnChange := OnChange;
 SaveOnKeyDown := OnKeyDown;
 SaveOnSelectionChange := OnSelectionChange;
 OnChange := nil;
 OnKeyDown := nil;
 OnSelectionChange := nil;
 pos := Selstart;
 top := Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
 TempMS := TStringStream.Create(Text);
  try
    LoadFromStream(TempMS);
    Perform(EM_LINESCROLL, 0, top);
  finally
    PlainText := True;
    SelStart := Pos;
    TempMS.Free;
    OnChange := SaveOnChange;
    OnKeyDown := SaveOnKeyDown;
    OnSelectionChange := SaveOnSelectionChange;
    Perform(EM_SETEVENTMASK, 0, EventMask);
    Perform(WM_SETREDRAW, -1, 0);
    InvalidateRect(Handle, nil,true);
   end;
end;

procedure TRichEditSyntax.UpdateLineSyntax;
var
  TempMS: TStringStream;
  pos: Integer;
  SaveOnChange: TNotifyEvent;
  SaveOnKeyDown : TKeyEvent;
  SaveOnSelectionChange : TNotifyEvent;
  EventMask : integer;
  I: integer;
  S: string;
begin
 if (Length(Text) < 3) then
  exit;
 if FLoading then
  Exit;

 EventMask := Perform(EM_SETEVENTMASK, 0, 0);
 Perform(EM_HIDESELECTION,1,0);
 SaveOnChange := OnChange;
 SaveOnKeyDown := OnKeyDown;
 SaveOnSelectionChange := OnSelectionChange;
 OnChange := nil;
 OnKeyDown := nil;
 OnSelectionChange := nil;
 pos := Selstart;
 enabled:= false;

  if SelectLine(Perform(EM_LINEFROMCHAR,SelStart,0)) and (SelLength > 2)  then
  begin
    I:= SelLength;
    S:= SelText;

    if (S[I]= #10) or (S[I]= #13) then
    begin
      if (S[I-1]= #10) or (S[I-1]= #13) then
        SelLength:= I - 2
      else
        SelLength:= I - 1;
    end;

      TempMS := TStringStream.Create(SelText);
      try
        LockWindowUpdate(handle);
        LoadFromStreamToSelection(TempMS);
        LockWindowUpdate(0);
        Sellength:= 0;
      finally
        PlainText := True;
        SelStart := Pos;
        TempMS.Free;
        OnChange := SaveOnChange;
        OnKeyDown := SaveOnKeyDown;
        OnSelectionChange := SaveOnSelectionChange;
        Perform(EM_SETEVENTMASK, 0, EventMask);
        Perform(EM_HIDESELECTION,0,0);
        enabled:= true;
        if (visible) and (parent.Visible) then
          SetFocus;
      end;
  end
  else
  begin
      PlainText := True;
      SelStart := Pos;
      OnChange := SaveOnChange;
      OnKeyDown := SaveOnKeyDown;
      OnSelectionChange := SaveOnSelectionChange;
      Perform(EM_SETEVENTMASK, 0, EventMask);
      Perform(EM_HIDESELECTION,0,0);
      Enabled:= true;
      if (visible) and (parent.Visible) then
        SetFocus;

  end;
end;


procedure TRichEditSyntax.Change;
begin
  if HandleAllocated then
    UpdateLineSyntax;
  inherited;
end;

end.