SMF - Just Installed!
18 Ott 2011 - Esempio lista in pascal
A volte capita che si necessita di lavorare con liste, chi ha programmato in c o in c++ sa quanto queste liste possono tornare utili.
Bene in pascal è molto facile usare una lista e i puntatori. Segue un listato di esempio, basta guardare i commenti per poter capire cosa succede. unit ListaCaratteri; {nome della unit} {$mode objfpc}{$H+} interface uses Classes, SysUtils; {ci salvo i caratteri} Type Caratteri=^Cella; {Definisco un tipo di dato che si chiama caratteri ed è un puntatore ad un tipo cella} Cella=Record {definisco un nuovo tipo di dati che si chiama cella ed è un record ed è così composta:} Carattere:char; {contiene un carattere} Next:Caratteri {contiene un puntatore ad un altra variabile di tipo Caratteri, questo permette di puntare al nodo dopo della lista} End; {ci salvo le liste di caratteri - è in tutto e per tutto uguale al tipo di dato Caratteri come logica} Type ListeCar=^MiaCella; MiaCella=Record IdentificativoLista: string; Lista:Caratteri; {notare che come tipo di dato ho anche una lista, una lista all'interno di una lista si può fare} Next:ListeCar {puntatore al prossimo nodo} End; type ListKeyPress = Object {creo un oggetto che contiene funzioni e procedure ma anche i miei dati di tipo lista} private MiaLista: ListeCar; {dati: contiene la mia lista} procedure Cancella(NodoPartenza: ListeCar); {funzione che mi cancella un nodo della lista} procedure CancellaCaratteri(NodoPartenza: Caratteri); {cancello la lista di tipo caratteri contenuta nella lista di tipo ListeCar} public constructor Create; {costruttore dell'oggetto} destructor Destroy; {distruttore dell'oggetto} procedure InsertChar(Car: char; Identificativo: string); procedure Show(); procedure CancellaQuelloCheNonServe(LimiteMaxCar: integer); procedure CancellaNodiNonInLista(LenVettore: integer; var ListaValidi: array of string); function InVettore(LenVettore: integer; var ListaValidi: array of string; Identificativo: string): boolean; end; implementation constructor ListKeyPress.Create(); begin MiaLista:=nil; { inizializzo la mia lista padre con il nil=null del c, fondamentale per non far andare in errore il codice, perchè il null è sinonimo di fine lista } end; procedure ListKeyPress.InsertChar(Car: char; Identificativo: string); var app, ultimo: ListeCar; ElencoCar: Caratteri; Esci: boolean; begin app:=MiaLista; Esci:=FALSE; while ((app<>nil)and(Esci=FALSE)) do {finche'non finisce la lista} begin If (App^.IdentificativoLista = Identificativo) Then begin New(ElencoCar); ElencoCar^.Carattere:=Car; ElencoCar^.Next:=app^.Lista; app^.Lista:=ElencoCar; Esci:=TRUE; end; ultimo:=app; app:=app^.next; {tramite questa instruzione si va avanti nella lista} end; If Esci=FALSE then { vuol dire che è il primo carattere per questo identificativo } begin app:=ultimo; //serve per gestire dal secondo nodo in poi altrimenti mi cera problemi New(ultimo); //simile alla malloc del c ultimo^.IdentificativoLista:=Identificativo; //valorizzo il campo del nodo della lista ultimo^.Lista:=nil; ultimo^.Next:=Nil; //valorizzo con nil perchè lo metto come ultimo carattere della lista if MiaLista=nil then begin app:=ultimo; //gestisco il primo nodo della lista end else begin app^.Next:=ultimo; end; New(ElencoCar); ElencoCar^.Carattere:=Car; ElencoCar^.Next:=ultimo^.Lista; ultimo^.Lista:=ElencoCar; end; if MiaLista=nil then MiaLista:=app; end; procedure ListKeyPress.Show(); var app: ListeCar; ElencoCar: Caratteri; begin writeln('--- Inizio stampa ---'); app:=MiaLista; while (app<>nil) do {finche'non finisce la lista} begin writeln('Identificativo della lista: ', app^.IdentificativoLista); ElencoCar:=app^.Lista; while (ElencoCar<>nil) do {finche'non finisce la lista} begin write(Elencocar^.Carattere); ElencoCar:=ElencoCar^.Next; end; writeln; app:=app^.next; {tramite questa instruzione si va avanti nella lista} end; writeln('--- Fine stampa ---'); end; destructor ListKeyPress.Destroy(); begin Cancella(MiaLista); MiaLista:=nil; end; procedure ListKeyPress.Cancella(NodoPartenza: ListeCar); var app: ListeCar; begin app:=NodoPartenza; if (app<>nil) then {finche'non finisce la lista} begin Cancella(app^.next); {tramite questa instruzione si va avanti nella lista} CancellaCaratteri(app^.Lista); {cancello i caratteri del nodo della lista} dispose(app); {cancello dalla memoria il nodo della lista, simile la free del c} end; end; procedure ListKeyPress.CancellaCaratteri(NodoPartenza: Caratteri); var app: Caratteri; begin app:=NodoPartenza; if (app<>nil) then {finche'non finisce la lista} begin CancellaCaratteri(app^.next); {tramite questa instruzione si va avanti nella lista} dispose(app); {cancello dalla memoria il nodo della lista} end; end; procedure ListKeyPress.CancellaQuelloCheNonServe(LimiteMaxCar: integer); var app: ListeCar; ElencoCar: Caratteri; Cont: integer; Esci: boolean; begin app:=MiaLista; while (app<>nil) do {finche'non finisce la lista} begin {devo scorrere tutte le variabili } Cont:=1; Esci:=FALSE; ElencoCar:=app^.Lista; while ((ElencoCar<>nil)and(Esci=FALSE)) do {finche'non finisce la lista} begin If (Cont >= LimiteMaxCar) Then begin CancellaCaratteri(ElencoCar^.Next); ElencoCar^.Next:=nil; Esci:=TRUE; End Else begin ElencoCar:=ElencoCar^.Next; Inc(Cont); end; end; app:=app^.next; {tramite questa instruzione si va avanti nella lista} end; end; procedure ListKeyPress.CancellaNodiNonInLista(LenVettore: integer; var ListaValidi: array of string); Var app, app2, precedente: ListeCar; Flag: boolean; begin app:=MiaLista; app2:=MiaLista; precedente:=nil; while (app<>nil) do {finche'non finisce la lista} begin Flag:=FALSE; {devo scorrere tutte le variabili } If InVettore(LenVettore, ListaValidi, app^.IdentificativoLista) = False Then begin Flag:=TRUE; app2:=app^.Next; CancellaCaratteri(app^.Lista); dispose(app); app:=app2; if precedente=nil then MiaLista:=app else precedente^.Next:=app; end; if ((app<>nil)AND(Flag=FALSE)) then begin precedente:=app; app:=app^.next; {tramite questa instruzione si va avanti nella lista} end; end; end; function ListKeyPress.InVettore(LenVettore: integer; var ListaValidi: array of string; Identificativo: string): boolean; Var ret: boolean; i: integer; begin ret:=FALSE; i:=0; while ((i //writeln('Confronto:',ListaValidi[i],'-',Identificativo); if (ListaValidi[i]=Identificativo) then ret:=TRUE; Inc(i); end; InVettore:=ret; end; end. Potete trovare un esempio completo qui: www.lazaruspascal.it/esempi/Lista_Pascal.zip 17 Ott 2011 - Stabilire il sistema operativo
A volte può essere utile stabilire il sistema operativo, per poter rendere le nostre applicazioni multi piattaforma, cambiando dei parametri. Per fare questo basta usare la seguente funzione:
function GetOsVer: string; begin {$IFDEF WIN32} if WindowsVersion = wv95 then Result:='Windows 95' else if WindowsVersion = wvNT4 then Result:='Windows NT v.4' else if WindowsVersion = wv98 then Result:='Windows 98' else if WindowsVersion = wvMe then Result:='Windows ME' else if WindowsVersion = wv2000 then Result:='Windows 2000' else if WindowsVersion = wvXP then Result:='Windows XP' else if WindowsVersion = wvServer2003 then Result:='Windows Server 2003' else if WindowsVersion = wvVista then Result:='Windows Vista' else if WindowsVersion = wv7 then Result:='Windows 7' else Result:='Unknown'; {$ENDIF} {$IFDEF UNIX} Result:='Linux'; {$ENDIF} end; Utilizzando il seguente codice nella sezione uses della unit che contiene la funzione GetOSVer: {$IFDEF WIN32} ,Win32Proc //serve per stabilire i vari sistemi operativi {$ENDIF} A questo indirizzo puoi scaricare un esempio www.lazaruspascal.it/esempi/Get_OS.zip 17 Ott 2011 - Recuperare codice HTML da pagina webA volte può crearsi la necessità di recuperare codice HTML da una pagina web, in lazarus fare ciò è molto semplice. Come prima cosa bisogna andare al sito http://www.ararat.cz/synapse/doku.php e scaricare l'ultima versione di Synapse disponibile per Lazarus. Scompattate il file che avete scaricato e copiare tutti i file contenuti in source\lib dentro la cartella che contiene il vostro progetto. Dopodiche aggiungete al vostro progetto una nuova unit che chiamerete GetHtml e che conterrà le seguenti righe. Libreria realizzata da Sammarco Francesco Mail: francesco.sammarco@gmail.com Utilità: recuperare codice html }
unit GetHtml; {$mode objfpc}{$H+} interface uses HTTPSend, Classes, SysUtils,blcksock, synautil, synaip, synsock, ftpsend, pingsend; {synapse library} function RecuperaHtml(Url: string): string; implementation function RecuperaHtml(Url: string): string; var http : THTTPSend; page : TStringList; i : longint; risultato: string; begin risultato:=''; http:=THTTPSend.Create; page:=TStringList.Create; try if not http.HTTPMethod('GET',Url) then begin RecuperaHtml:=''; exit; end else begin page.LoadFromStream(http.Document); for i:=0 to page.Count-1 do risultato:=risultato + UpCase(page[i]); end; http.Clear; page.Clear; finally http.Free; page.Free; end; RecuperaHtml:=risultato; end; end.
Fatto questo andiamo nella form del nostro progetto e aggiungiamo la libreria GetHtml nella sezione uses della nostra form. Alla form aggiungiamo una TEditBox, un campo TMemo, e un TButton. Lasceremo i nomi di default ovvero Edit1, Memo1 e Button1. Creiamo l'evento Click per il pulsante e andiamo a scriverci dentro il seguente codice:
procedure TForm1.Button1Click(Sender: TObject); Compilate, eseguite e scrivete un url nella EditBox, premete il pulsante e vedrete il codice HTML nel campo memo. Spero che vi sia stato utile. 17 Ott 2011 - Trascinare un file nel programmaPuò capitare a volte di avere la necessità di trascinare un file su un programma aperto per poter effettuare una qualsiasi tipologia di elaborazione su tale file. In Lazarus è davvero molto semplice effettuare tale operazione.
Per prima cosa create una nuova applicazione di prova, cliccate sulla form appena creata e impostate la proprietà AllowDropFile a true, ora andate nell'evento FormDropFiles della form e fate in modo che coincida con il seguente codice: procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String); begin ShowMessage(FileNames[0]); end; Ora compilate e lanciate il programma. Provate a trascinare un file qualsiasi sulla finestra del eseguibile appena lanciato e vedrete il percorso e il nome di tale file. Ora stà a voi e alla vostra fantasia farne quello che volete. 17 Ott 2011 - Mandare mail con LazarusSe una delle vostre esigenze è mandare una mail tramite un programma scritto in Lazarus, questo How To vi spiegherà come farlo. Come prima cosa bisogna andare al sito http://www.ararat.cz/synapse/doku.php e scaricare l'ultima versione di Synapse disponibile per Lazarus. Scompattate il file che avete scaricato e copiare tutti i file contenuti in source\lib dentro la cartella che contiene il vostro progetto. Dopodiche aggiungete al vostro progetto una nuova unit che chiamerete MyLibMail e che conterrà le seguenti righe. { Ora ipotizziamo che il progetto contiene solo una form di nome Unit1 e che a sua volta contiene solo un pulsante chiamato Button1. Il codice del programma sarà. unit Unit1;
In linux bisogna installare: libssl-dev
Spero che questo articolo vi sia stato d'aiuto. |