Textes et codes de couleurs....

Question

Salut à tous! Tiré de la source de Costello, mIRC Reader. procedure CheckBold(var S: string); var IsOpen: boolean; begin { Vérification du gras } IsOpen := false; while pos('',S)>0 do begin if not IsOpen then S := StringReplace(S,'','\b ',[]) else S := StringReplace(S,'','\b0 ',[]); IsOpen := not IsOpen; end; if IsOpen then S := S + '\b0'; end; procedure CheckUnder(var S: string); var IsOpen: boolean; begin { Vérification du soulignage } IsOpen := false; while pos('',S)>0 do begin if not IsOpen then S := StringReplace(S,'','\ul ',[]) else S := StringReplace(S,'','\ulnone ',[]); IsOpen := not IsOpen; end; if IsOpen then S := S + '\ulnone'; end; procedure CheckReverse(var S: string); var IsOpen: boolean; begin { Vérification du reverse } IsOpen := false; while pos('',S)>0 do begin if not IsOpen then S := StringReplace(S,'','\cf1\highlight2 ',[]) else S := StringReplace(S,'','\highlight0\cf0 ',[]); IsOpen := not IsOpen; end; if IsOpen then S := S + '\highlight0\cf0'; end; procedure CheckSingleColors(var S: string); var i: integer; buf: string; IsModified: boolean; begin IsModified := false; for i := 15 downto 0 do begin buf := S; S := AnsiReplaceStr(S,''+inttostr(i),'\cf'+inttostr(i+1)+' '); if (buf<>S) then IsModified := true; end; if IsModified then S := S + '\cf0'; end; procedure CheckDoubleColors(var S: string); var i,j: integer; buf: string; IsModified: boolean; begin IsModified := false; for i := 15 downto 0 do for j := 15 downto 0 do begin buf := S; S := AnsiReplaceStr(S,''+inttostr(i)+','+inttostr(j), '\cf'+inttostr(i+1)+'\highlight'+inttostr(j+1)); if (buf<>S) then ISModified := true; end; if IsModified then S := S + '\cf0\highlight0'; end; Événement OnCreate de ma Form Principale procedure TMainForm.FormCreate(Sender: TObject); begin List := TstringList.Create; end; Événement OnMessage du TidIRC procedure TMainForm.ircMessage(Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; Content: String); var i: integer; buf: string; begin DateTime := Time; //sTime := TimeToStr(DateTime); sTime := FormatDateTime('hh:mm', DateTime); List.Add('['+sTime+'] <'+AUser.Nick+'> '+Content); //List.Free; Output := TStringList.Create; Output.Add('{\rtf1\ansi\ansicpg1252\deff0\deflang1036\deflangfe1036\deftab708{\fonttbl{\f0\fswiss\fprq2\fcharset0 Fixedsys;}{\f1\froman\fprq2\fcharset0 Fixedsys;}}'); Output.Add('{\colortbl ;\red255\green255\blue255;\red0\green0\blue0;\red51\green51\blue153;\red0\green128\blue0;\red255\green0\blue0;\red128\green0\blue0;\red156\gre'+ 'en0\blue156;\red255\green161\blue67;\red255\green255\blue0;\red0\green255\blue0;\red0\green128\blue128;\red153\green204\blue255;\red51\green102\blue255;\re'+ 'd255\green0\blue255;\red128\green128\blue128;\red192\green192\blue192;}'); OutPut.Add('{\*\generator Costello;}\viewkind4\uc1\pard\cf2\f1\fs20'); for i := 0 to List.Count-1 do begin buf := List[i]; CheckBold(buf); CheckUnder(buf); Checkreverse(buf); CheckDoubleColors(buf); ChecksingleColors(buf); buf := AnsiReplaceStr(buf,'','\highlight0\ulnone\b0\cf0 '); OutPut.Add(buf+'\par'); end; OutPut.Add('}'); TChannels.Lines.Add(Output.Text); Output.Clear; List.Clear; OutPut.Free; List.Free; end; Quand je reçoit mon message sur un canal, la premiere fois il s'affiche correctement avec les codes de couleurs voulu, cependant la 2ieme fois, il n'affiche plus rien etc... on voit juste le premier message et les autres on ne les recoits pas? Comment faire? Mon code n'est pas correct? Pourtant, il n'y a pas d'erreur. Merci d'avance! MAsterC Visitez notre site!

cs_neko · Answer

Si le code etait correct &#231;a marcherait ;)


Je suis loin d'&#234;tre un expert en codage rtf mais je pense que tu ne
peux afficher qu'un seul block de texte ( enfin c'est ce qu'il parait
le plus logique selon ta description du probl&#232;me ).

essais &#231;a:



 &#201;v&#233;nement OnCreate du TidIRC ( enfin n'importe quel evennement au debut execut&#233; une seule fois )



Procedure TMainForm.OnCreate(Sender: TObject);

begin



  Output := TStringList.Create;

 
Output.Add('{\rtf1\ansi\ansicpg1252\deff0\deflang1036\deflangfe1036\deftab708{\fonttbl{\f0\fswiss\fprq2\fcharset0
Fixedsys;}{\f1\froman\fprq2\fcharset0 Fixedsys;}}');

  Output.Add('{\colortbl
;\red255\green255\blue255;\red0\green0\blue0;\red51\green51\blue153;\red0\green128\blue0;\red255\green0\blue0;\red128\green0\blue0;\red156\gre'+

            
'en0\blue156;\red255\green161\blue67;\red255\green255\blue0;\red0\green255\blue0;\red0\green128\blue128;\red153\green204\blue255;\red51\green102\blue255;\re'+

            
'd255\green0\blue255;\red128\green128\blue128;\red192\green192\blue192;}');

  OutPut.Add('{\*\generator Costello;}\viewkind4\uc1\pard\cf2\f1\fs20');

    TChannels.Lines.Add(Output.Text);

    Output.Clear;

    OutPut.Free;

end;



&#201;v&#233;nement OnMessage du TidIRC

procedure TMainForm.ircMessage(Sender: TObject; AUser: TIdIRCUser;
  AChannel: TIdIRCChannel; Content: String);
var
  i: integer;
  buf: string;


begin
  DateTime := Time;
  //sTime := TimeToStr(DateTime);
  sTime := FormatDateTime('hh:mm', DateTime);


  List.Add('['+sTime+'] <'+AUser.Nick+'> '+Content);
  //List.Free;



  Output := TStringList.Create;

  OutPut.Add('{');

  for i := 0 to List.Count-1 do

  begin

    buf := List[i];

    CheckBold(buf);

    CheckUnder(buf);

    Checkreverse(buf);

    CheckDoubleColors(buf);

    ChecksingleColors(buf);

    buf := AnsiReplaceStr(buf,'','\highlight0\ulnone\b0\cf0 ');

    OutPut.Add(buf+'\par');

  end;

    OutPut.Add('}');

    TChannels.Lines.Add(Output.Text);

    Output.Clear;

    List.Clear;

    OutPut.Free;

    List.Free;

end;



C'est juste une id&#233;e, je ganranti pas que &#231;a marche :)




bouh

cs_MAsterC · Answer

Dommage, sa ne marche pas! 

 MAsterC 
Visitez notre site!

Textes et codes de couleurs....

2 réponses

Votre réponse

Discussions similaires