Newsgroup: it.comp.lang.delphi
Titolo: tool x stampare i .pas di delphi

Ciao,
sapete se esiste un tool che stampa i sorgenti pascal come da esempio:
if blabla then
begin
|  ......
|  ......
|  .....
|
|
end;
ovvero che stampi delle righe che uniscono i blocchi begin end.
Grazie.
** Articolo inviato tramite i servizi gratuiti di 
www.x-privat.org
 **

 sapete se esiste un tool che stampa i sorgenti pascal come da esempio:
[CUT]
Se fai file print con il check Print selected block??? è quello che cerchi?
Ciao
gabriele

 Se fai file print con il check Print selected block??? è quello che
cerchi?
Scuasami non sono stato completo
volevo dire  selezionando prima il codice che ti interessa e poi file print

 ha scritto nel messaggio
news:3f0e...@x-privat.org...


Se lo vuoi te lo posto
Posta il link sul ng, se possibile, cosi' dai un contributo a futura memoria
di chi ne avra' bisogno un domani.
Ciao
-- 
Morde. 
(morde at programmer dot net)

 ha scritto nel messaggio
news:3f0e...@x-privat.org...


io vorrei stampare il codice come da esempio.
Mah.... imvho un occhio allenato da un po' di programmazione e' in grado di
fare questo solo osservando l'indentanzione.


 if blabla then
[Cut]
Mi sono fatto un programmino che legge i file PAS, li converte in formato
RTF e li visualizza a video con il componente TRichEdit; allo stesso modo
penso che sia anche possibile stamparli con il componente TQrRichText (se
non ricordo male) del QuickReport.
Se ti può essere utile scrivo la unit che contiene la procedura di
conversione da PAS a RTF:
---------------------------------------------------------------------------
unit PasToRtf;
interface
uses Windows, Graphics, Classes, ComCtrls, SysUtils;
const TsText      =0;
      TsComment   =1;
      TsSymbol    =2;
      TsString    =3;
      TsNumber    =4;
      TsAssembler =5;
      TsReserved  =6;
var TokenColor    : Array[0..6]of TColor;
    TokenStyle    : Array[0..6]of TFontStyles;
    TokenFontName : String;
    TokenFontSize : Integer;
    OpenedSize    : Longint;
procedure MakeRTFStream(Source: Boolean; Data : PChar; Stm: TStrings; PrBar:
TProgressBar);
implementation
var Sms, Dms  : TMemoryStream;
    Buf, iBuf : PChar;
    sRTF      : String;
    TsOld     : Integer;
const KW : array[0..98] of string =
        ('ABSOLUTE','ABSTRACT','AND','ARRAY','AS','ASM','ASSEMBLER',
         'AUTOMATED','BEGIN','CASE','CDECL','CLASS','CONST','CONSTRUCTOR',
         'DEFAULT','DESTRUCTOR','DISPID','DISPINTERFACE','DIV','DO',
         'DOWNTO','DYNAMIC','ELSE','END','EXCEPT','EXPORT','EXPORTS',
         'EXTERNAL','FAR','FILE','FINALIZATION','FINALLY','FOR','FORWARD',
         'FUNCTION','GOTO','IF','IMPLEMENTATION','IN','INDEX','INHERITED',
         'INITIALIZATION','INLINE','INTERFACE','IS','LABEL','LIBRARY',
         'MESSAGE','MOD','NAME','NEAR','NIL','NODEFAULT','NOT','OBJECT',
         'OF','OR','OUT','OVERRIDE','PACKED','PASCAL','PRIVATE','PROCEDURE',
         'PROGRAM','PROPERTY','PROTECTED','PUBLIC','PUBLISHED','RAISE',
         'READ','READONLY','RECORD','REGISTER','REPEAT','RESIDENT',
         'RESOURCESTRING','SAFECALL','SET','SHL','SHR','STDCALL','STORED',
         'STRING','STRINGRESOURCE','THEN','THREADVAR','TO','TRY','TYPE',
         'UNIT','UNTIL','USES','VAR','VIRTUAL','WHILE','WITH','WRITE',
         'WRITEONLY','XOR');
function IsReservedWord(Nrw : String): Boolean;
var ni : Byte;
begin
     Result := False;
     Nrw := UpperCase(Nrw);
     for ni := 0 to 98 do
      if KW[ni] = Nrw then
        begin Result := True; Break; end;
end;
function ColorToRTF(aColor: TColor): String;
begin
     aColor:=ColorToRGB(aColor);
     Result:='\red'+IntToStr(GetRValue(aColor))+
             '\green'+IntToStr(GetGValue(aColor))+
             '\blue'+IntToStr(GetBValue(aColor))+';';
end;
function BuildTblColor: String;
var n : Byte;
begin
     Result := '{\colortbl';
     for n :=0 to 6 do
      Result := Result+ColorToRTF(TokenColor[n]);
     Result := Result+'}'+#13;
end;
procedure SetRTFTxtStyle(Tpos: Byte; var St: String);
begin
     St := '';
     if fsBold in TokenStyle[tsOld] then St := '\b0 ';
     if fsItalic in TokenStyle[tsOld] then St := St+'\i0 ';
     if fsUnderline in TokenStyle[tsOld] then St := St+'\ul0 ';
     if fsBold in TokenStyle[Tpos] then St := st+'\b ';
     if fsItalic in TokenStyle[Tpos] then St := St+'\i ';
     if fsUnderline in TokenStyle[Tpos] then St := St+'\ul ';
end;
procedure WriteRTFFormat(Mode: Integer; StoW: String);
var Bs : String;
begin
     if Mode>=0 then
       begin
            if tsOld<>Mode then
              begin
                   SetRTFTxtStyle(Mode,Bs);
                   StoW := '\cf'+IntToStr(Mode)+' '+Bs+StoW;
                   tsOld := Mode;
              end;
       end;
     if Dms.Size<Dms.Position+Length(StoW) then
Dms.SetSize(Dms.Position+Length(StoW));
     Dms.Write(Stow[1],Length(Stow));
end;
procedure WriteRTFHead;
begin
     sRTF := '{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fnil '
                           +TokenFontName+';}}'+#13;
     WriteRTFFormat(-1,sRTF);
     sRTF := BuildTblColor;
     WriteRTFFormat(-1,sRTF);
     sRTF := '\deflang1040\pard\plain\f2\fs'+IntToStr(TokenFontSize)+' ';
     WriteRTFFormat(-1,sRTF);
end;
procedure ScanForComment;
begin
     sRTF := '';
     repeat
      case Buf^ of
        '{' : sRTF := sRTF+'\{';
        '}' : begin sRTF := sRTF+'\}'; inc(Buf); break; end;
        '*' : if (Buf+1)^=')' then
                begin sRTF := sRTF+'*)'; inc(Buf,2); break; end
               else sRTF := sRTF+Buf^;
        '\' : sRTF := sRTF+'\\';
        #13 : begin
                   sRTF := sRTF+'\par '; inc(Buf);
                   if sRTF[1]='/' then Break;
              end;
        else sRTF := sRTF+Buf^;
      end;
      inc(Buf);
     until buf^=#0;
     writeRTFFormat(tsComment,sRTF);
end;
procedure ScanForAssembler;
var EndAsm : Boolean;
begin
    EndAsm := False;
    repeat
      sRTF := '';
      repeat
           case Buf^ of
            '{'     : Break;
            '('     : if (Buf+1)^='*' then Break;
            '/'     : if (Buf+1)^='/' then Break;
            #13     : begin sRTF := sRTF+'\par '; inc(Buf,2); end;
            'E','e' : if ((Buf+1)^ in['N','n']) and ((Buf+2)^ in['D','d'])
                        and ((Buf+3)^=';') then begin EndAsm := True; Break;
end
                       else inc(Buf);
            else begin sRTF := sRTF+Buf^; inc(Buf); end;
           end;
      until Buf^=#0;
      WriteRTFFormat(tsAssembler,sRTF);
      if not EndAsm then ScanForComment;
    until EndAsm;
end;
procedure ScanForText;
var Cp   : Char;
begin
     cp := (buf-1)^; iBuf := Buf; inc(Buf);
     while Buf^ in['A'..'Z','a'..'z','0'..'9','_'] do inc(Buf);
     SetString(sRTF,iBuf,Buf-iBuf);
     if Cp='.' then WriteRTFFormat(tsText,sRTF)
      else if isReservedWord(sRTF) then
             begin
                  WriteRTFFormat(tsReserved,sRTF);
                  if UpperCase(sRTF)='ASM' then ScanForAssembler;
             end
            else WriteRTFFormat(tsText,sRTF);
end;
procedure ScanForNumber;
begin
     iBuf := Buf; inc(Buf);
     while Buf^ in['0'..'9','.'] do inc(Buf);
     SetString(sRTF,iBuf,Buf-iBuf);
     WriteRTFFormat(tsNumber,sRTF);
end;
procedure ScanForHexNumber;
begin
     iBuf := Buf; inc(Buf);
     while Buf^ in['0'..'9','A'..'F','a'..'f'] do inc(Buf);
     SetString(sRTF,iBuf,Buf-iBuf);
     WriteRTFFormat(tsNumber,sRTF);
end;
procedure ScanForChar;
begin
     iBuf := Buf; inc(Buf);
     while Buf^ in['0'..'9'] do inc(Buf);
     SetString(sRTF,iBuf,Buf-iBuf);
     WriteRTFFormat(tsString,sRTF);
end;
procedure ScanForString;
begin
     sRTF := '';
     repeat
           case Buf^ of
             #13         : begin sRTF := sRTF+'\par '; inc(Buf); end;
             '\','{','}' : sRTF := sRTF+'\'+Buf^;
              else sRTF := sRTF+Buf^;
           end;
           inc(Buf);
     until Buf^='''';
     sRTF := sRTF+Buf^; inc(Buf);
     WriteRTFFormat(tsString,sRTF);
end;
procedure ScanForSymbol;
begin
     sRTF := Buf^; inc(Buf);
     while Buf^ in['!','"','%','&','('..'/',':'..'@','['..'^','`','~'] do
      begin
           case Buf^ of
            '\' : sRTF := sRTF+'\'+Buf^;
             else sRTF := sRTF+Buf^;
           end;
           inc(Buf);
      end;
     WriteRTFFormat(tsSymbol,sRTF);
end;
procedure MakeRTFStream(Source: Boolean; Data : PChar; Stm: TStrings; PrBar:
TProgressBar);
var SBuf : PChar;
begin
     tsOld := -2;
     Dms := TMemoryStream.Create;
     if Source then
       begin
            Sms := TMemoryStream.Create;
            Sms.LoadFromFile(StrPas(Data)); Dms.SetSize(Sms.Size);
            OpenedSize := Sms.Size;
            PrBar.Max := Sms.Size; Buf := Sms.Memory;
       end
      else begin
                Buf := Data; PrBar.Max := StrLen(Data);
                Dms.SetSize(StrLen(Data));
            end;
     WriteRTFHead;
     SBuf := Buf;
     PrBar.Min := 0;  PrBar.Position := 0; PrBar.Visible := True;
     while Buf^<>#0 do
      begin
       case Buf^ of
        #13                       : begin
                                         WriteRTFFormat(-1,'\par ');
                                         inc(Buf,2);
                                    end;
        'A'..'Z','a'..'z','_'     : ScanForText;
        '0'..'9'                  : ScanForNumber;
        '{'                       : ScanForComment;
        '$'                       : ScanForHexNumber;
        '#'                       : ScanForChar;
        ''''                      : ScanForString;
        '('                       : if (Buf+1)^='*' then ScanForComment
                                      else ScanForSymbol;
        '/'                       : if (Buf+1)^='/' then ScanForComment
                                      else ScanForSymbol;
        '!','"','%','&',')'..'.',
        ':'..'@','['..'^','`','~' : ScanForSymbol;
        else begin
                  WriteRTFFormat(-1,Buf^); inc(Buf);
              end;
        end;
        PrBar.Position := Buf-SBuf;
      end;
     WriteRTFFormat(-1,'}'+#0);
     Dms.Position := 0;
     Stm.LoadFromStream(Dms);
     PrBar.Visible := False;
     Dms.Free;
     if Source then Sms.Free;
end;
end.
Siccome l'ho scritta un po di tempo fa non mi ricordo bene come funzionano
tutte le procedure, ma i parametri della proc. principale sono:
  se "Source" = true bisogna passare in "Data" il nome del file PAS da
convertire, se invece è false in "Data" contiene i dati pronti da
convertire.
In "Stm" contiene il risultato della conversione e "PrBar" non ha bisogno di
commenti.
variabili:
    TokenColor  -> array che contiene i colori per i numeri, le stringhe,
etc...
    TokenStyle   -> come sopra per lo stile del testo
    TokenFontName -> nome del font utilizzato per il file RTF
    TokenFontSize -> dimensione del font RTF
Se hai domande o se vuoi il listato completo del programma fammi sapere.
Non aspettarti una risposta in tempo breve...in questo periodo mi collego a
internet molto di rado.
Dimenticavo: io uso delphi 3, ma dovrebbe funzionare bene anche con le
versioni successive
Ciao
Michele Rossa

 ha scritto nel messaggio
news:gtrtgvgf9km87l8jd...@4ax.com...


 ha scritto nel messaggio
news:H_YQa.178025$lK4.5...@twister1.libero.it...

** Articolo inviato tramite i servizi gratuiti di 
www.x-privat.org
 **

 ci provo
quotando, sotto, undici k di messaggio.
*plonk*
Saluti
Paolo Arosio