Search the Community

Caríssimos, decidi desenferrujar algumas linguagens nas quais não tive a chance de pegar há muito. Chegou a hora do Delphi / Object Pascal. Ora bem, estou a fazer uma pequena biblioteca que me permite aplicar ANSI escape codes (AECs) no output, e tenho uma situação muito peculiar. De notar, estou a usar o Free Pascal 3.2.2. Indo directo ao problema: writeln( Ansify([BOLD, FG_RED], 'Fatality!') ); writeln( Ansify([ITALIC, FG(69)], 'Color Test, Standard') ); writeln( Ansify([UNDERLINE, BG(100, 50, 9)], 'Color Test, RGB') ); Quando executo este código de teste, a primeira chamada a Ansify funciona sem problemas. Contudo, a segunda chamada, independentemente do array que passo no primeiro argumento, dispara um Access Violation: \x[1;31mFatality!\x[0m An unhandled exception occurred at $00000000004124CA: EAccessViolation: Access violation $00000000004124CA $00000000004243FC $00000000004011AB Nota: forcei o output dos AECs para debugging durante o desevolvimento. Esta é a definição de Ansify: function Ansify(const codes : array of IAnsiCode; const msg : string) : string; begin Result := Codify(codes) + msg + Codify([RESET]); end; Onde: function Codify(const codes : array of IAnsiCode) : string; var code : IAnsiCode; begin Result := '\x['; // Result := ANSI_BEGIN; // TODO: switch when finishing first version for code in codes do begin Result += code.AsString; Result += ANSI_SEPARATOR; end; Delete(Result, Length(Result), 1); Result += ANSI_END; end; A ideia é ter IAnsiCode como uma interface comum a duas classes que implementam AECs, mas que apenas obriga ao mínimo: IAnsiCode = interface['{eeb511e3-0dbe-4fec-a72f-473f8bf8a8de}'] function AsString : string; function AsByte : byte; end; Não estou a usar uma class function construtora que permita gerir automaticamente a libertação de recursos uma vez que posso precisar de qualquer código a qualquer momento por N vezes num programa, pelo que estou a alocar os objectos na inicialização do módulo e a "destruí-los" na finalização: initialization RESET := TAnsiCode.Create(0); BOLD := TAnsiCode.Create(1); FAINT := TAnsiCode.Create(2); // etc... Aparentemente os objectos parecem ser todos destruídos após a primeira chamada a Ansify, tenham sido ou não usados na primeira chamada. A classe TAnsiCode está definida da seguinte forma: TAnsiCode = class(TInterfacedObject, IAnsiCode) private vCode : byte; vString : string; function WithCode(const code : byte) : IAnsiCode; public constructor Create(const code : byte); function AsString : string; function AsByte : byte; end; A minha questão é simples: Por quê Access Violation? Para onde foram os objectos todos? 😄 Cumprimentos.

A Embarcadero está a disponibilizar de forma gratuita (não sei se a oferta é permanente ou temporária) o livro "Object Pascal Handbook", do Marco Cantu. O livro foi revisto e actualizado para o Delphi 10.1 Berlin, e é um óptimo parceiro para o ainda gratuito Delphi 10.1 Berlin e o também gratuito Delphi BootCamp. Cá fica ele: http://cc.embarcadero.com/item/30605

Como já tinha saudades de pegar no Free Pascal, decidi brincar com as possibilidades que os tipos genéricos nos proporcionam. Trago-vos, desta vez, uma unit que possui uma pequena classe genérica com um objectivo muito simples mas, ao mesmo tempo, interessante: ordenar um array que possua dados de qualquer tipo segundo um termo de comparação à escolha. Ou seja, eu tentei arranjar uma forma de fazer isto: Sort(arr, @compare); Onde arr é o array com conteúdos de um tipo qualquer, e compare é a função que define o tipo de ordenamento que queremos para os dados. Deixo-vos a unit e dois exemplos: um que ordena por ordem crescente um array de inteiros, e outro que ordena por ordem alfabética inversa uma lista de nomes. Espero que apreciem 🙂 (Disponível na Wiki) Unit {$mode objfpc} unit UOrder; interface uses classes, sysutils; type generic TOrdering<T> = class(TObject) private type TFnBool = function (a, b : T) : boolean; TArrayOfT = array of T; public procedure Sort(var arr : TArrayOfT; f : TFnBool); end; implementation procedure TOrdering.Sort(var arr : TArrayOfT; f : TFnBool); var i, j : longint; temp : T; begin for i := Low(arr) to High(arr)-1 do for j := i+1 to High(arr) do if f(arr[i], arr[j]) then begin temp := arr[i]; arr[i] := arr[j]; arr[j] := temp; end; end; end. Teste 1: Ordenar por ordem crescente um array of integer {$mode objfpc} program order_any_array; uses classes, sysutils, UOrder; type TOrdInt = specialize TOrdering<integer>; TArrInt = array of integer; function Greater(a, b : integer) : boolean; begin Greater := a > b; end; procedure WriteArrInt(arr : TArrInt); var i : integer; begin for i in arr do write(i:3); writeln; end; var ordint : TOrdInt; l : TArrInt; begin try SetLength(l, 6); l[0] := 5; l[1] := 5; l[2] := 0; l[3] := 4; l[4] := 2; l[5] := 8; write('Initial array: '); WriteArrInt(l); writeln; ordint.Create; ordint.Sort(l, @Greater); ordint.Free; write(' Final array: '); WriteArrInt(l); except on ex:exception do writeln('[ERR: ', ex.classname, ' -> ', ex.message, ']'); end; readln; // pausa end. Output: Initial array: 5 5 0 4 2 8 Final array: 0 2 4 5 5 8 Teste 2: Ordenar, por ordem alfabética inversa, uma lista de nomes: {$mode objfpc} program order_any_array; uses classes, sysutils, UOrder; type TOrdStr = specialize TOrdering<string>; TArrStr = array of string; function Max(x, y : word) : word; begin if x >= y then Max := x else Max := y; end; function AlphaBefore(p1, p2 : string) : boolean; // Is p1 before p2 in the dictionary? It may not work with spaces! var i : word; begin AlphaBefore := true; for i := 1 to Max(Length(p1), Length(p2)) do if Ord(LowerCase(p1[i])) < Ord(LowerCase(p2[i])) then break else if Ord(LowerCase(p1[i])) > Ord(LowerCase(p2[i])) then begin AlphaBefore := false; break; end; end; procedure WriteArr(arr : TArrStr); var s : string; begin for s in arr do writeln(s); writeln; end; var ordstr : TOrdStr; names : TArrStr; begin try SetLength(names, 4); names[0] := 'thoga31'; names[1] := 'pwseo'; names[2] := 'nunopicado'; names[3] := 'Pascal'; writeln('Initial array:'); WriteArr(names); writeln; ordstr.Create; ordstr.Sort(names, @AlphaBefore); ordstr.Free; writeln('Final array:'); WriteArr(names); except on ex:exception do writeln('[ERR: ', ex.classname, ' -> ', ex.message, ']'); end; readln; end. Output: Initial array: thoga31 pwseo nunopicado Pascal Final array: thoga31 pwseo Pascal nunopicado

Proponho que se faça neste tópico uma colectânea de exercícios, com ou sem solução, de Pascal - isto inclui Extended Pascal, Free Pascal e Object Pascal (não Delphi). O objectivo é simples: proporcionar aos nossos principiantes/estudantes uma série de exercícios que ponham à prova os seus conhecimentos teóricos e práticos. Sim, os exercícios devem ser não só práticos mas também teóricos, e podem ser acerca de qualquer tema, desde o mais básico até ao mais difícil. Atenção! Dúvidas acerca da resolução destes exercícios devem ser colocados em tópicos próprios. Neste tópico apenas se deve debater as questões em si mesmas, as soluções propostas pelos autores das questões e ideias para mais questões. Qualquer membro é bem-vindo a participar nesta colectânea. 😉 Modelo de questão Compilador/dialecto: Turbo Pascal, Free Pascal, Object Pascal... Tema(s): I/O, strings, records, tipos genéricos... Dificuldade: muito fácil, fácil, médio, difícil, muito difícil. Questão: ... Resolução: (opcional) [b]Compilador/dialecto:[/b] [b]Tema(s):[/b] [b]Dificuldade:[/b] muito fácil / fácil / médio / difícil / muito difícil [b]Questão:[/b] [b]Resolução:[/b]

Teste de Free Pascal Ver Ficheiro Este teste tem por objectivo avaliar conhecimentos de âmbito geral acerca da programação em Free Pascal. Está dividido em 5 partes - 2 teóricas e 3 práticas. Inclui questões de escolha múltipla e questões de resposta aberta. Qualquer questão deste teste não deve ser usado em avaliações oficiais de qualquer estabelecimento de ensino. O propósito deste teste é auto-avaliação através de questões de dificuldade de vários níveis. Submetido por thoga31 Submetido em 18-09-2014 Categoria Exercícios s/ Solução Licença Uso de questões não permitido Website Submetido pelo Autor? Sim

Bom, vamos lá tirar o pó ao quadro com algo simples mas útil para quem programa em consola 😉 Já aconteceu estarmos a querer ler um número e o utilizador introduz um valor alfanumérico. Resultado: o programa crasha. Podemos tratar a excepção com uma estrutura try-except. No entanto, não acho propriamente elegante. Portanto, deixo aqui um pequeno excerto de uma unit que tenho implementada há c'anos. A partir desta amostra poderão acrescentar com muito mais tipos de dados e novas funcionalidades. Aqui fica o código da unit e do programa de teste: USecRead.pas {$mode objfpc} unit USecRead; interface uses sysutils; type TSecureRead = class(TObject) private var vErrorPos : word; public function TLongint(const PROMPT : string; var i : longint) : boolean; function TReal(const PROMPT : string; var r : real) : boolean; property ErrorPos : word read vErrorPos; end; var SecureRead : TSecureRead; implementation function TSecureRead.TLongint(const PROMPT : string; var i : longint) : boolean; var s : string; e : word; begin Write(PROMPT); ReadLn(s); Val(s, i, e); TLongint := (e = 0); self.vErrorPos := e; end; function TSecureRead.TReal(const PROMPT : string; var r : real) : boolean; // DIY end; initialization SecureRead := TSecureRead.Create; finalization SecureRead.Free; end. USecRead_test.pas program USecRead_test; uses USecRead; const CRLF = #13+#10; var n : longint; begin repeat while not SecureRead.TLongint('n? ', n) do WriteLn('[KO] Nao foi lido um Longint!', CRLF, ' * Erro na posicao ', SecureRead.ErrorPos, CRLF, ' * Por curiosiade, n=', n, CRLF); Writeln('[OK] Longint lido correctamente!', CRLF, ' * n=', n); until n=0; end. E aqui um teste no Ubuntu: $ ./USecRead_test n? 123e5 [KO] Nao foi lido um Longint! * Erro na posicao 4 * Por curiosiade, n=0 n? 12345 [OK] Longint lido correctamente! * n=12345 n? 0 [OK] Longint lido correctamente! * n=0 $

Olá, pessoal. Uma das coisas que mais me fascina é o ensino da programação. Por alguma razão, gosto de ensinar os mais "jovens" (em conhecimentos) acerca de programação em geral e acerca de Pascal em particular. Algo que eu já me meti a desenvolver foi um protótipo de um programa de uma Unidade Curricular (UC) de uma faculdade em que a cadeira seria de Programação com a linguagem Pascal, e seria uma UC anual. Gostaria de debater convosco não um programa de uma UC (isso foi só uma introdução ao tópico e um devaneio meu), mas sim qual seria porventura a melhor sequência de ensinamentos a dar a um aprendiz que se esteja a iniciar em Pascal até atingir um nível mínimo (qual é este nível?) de Object Pascal. Acho que se torna um assunto interessante na medida em que, como sabemos, não é fácil escolher a melhor sequência quando toda a programação em Pascal, a par de outras linguagens, interliga conhecimentos díspares mas que não podem ser dados ao mesmo tempo.

Lembrei-me desta mini-framework criada pelo @pwseo para criar menus com possibilidade de modificar o seu aspecto. Decidi então fazer aquilo que há muito andava para fazer: criar o rascunho daquela que seria uma classe que permite a criação destes menus. A minha mini-framework diferencia-se da do @pwseo pelos seguintes aspectos: Está implementada com OOP (Object Pascal); O rendering é feito através de uma property da classe, a qual possui uma sintaxe e funcionamento específicos; Permite organizar o menu por teclas; Tem um código bem mais complexo e muito menos elegante 😄 Os métodos públicos para manipular o menu: Create - cria uma instância, ou seja, um menu. Argumento opcional - define se é Sorted ou não (default = não). Não é definitivo, pode-se alterar com a propriedade sorted a qualquer momento. Destroy - destrói todos os recursos associados à instância. Add - adiciona um novo item ao menu. Recebe, por ordem, 1) o texto associado, 2) a tecla a premir, 3) o Procedure a executar. Show - mostra o menu no monitor. Se render não for uma String nula, o output terá rendering, caso contrário será simples. Argumento opcional: título. NB: não lida com erros associados a uma má definição do rendering! GetChoice - espera pela opção do utilizador e devolve a tecla (caracter) correspondente. Argumento opcional: define se executa logo a Procedure (default = sim). KEYS - propriedade read-only que possui uma colecção de todas as opções (teclas/caracteres) do menu. sorted - propriedade que define se o menu é mostrado organizado por teclas (caracteres). render - propriedade write-only que define o rendering do menu. Sintaxe: § -> define uma nova linha #TITLE -> indica que aqui se deve escrever o título #OPTION -> indica que aqui se devem escrever as opções. Assim que isto aparece, TODAS as opções serão escritas. Isto implica que não há separadores entre cada opção! @CENTER -> define que deve ser escrito centrado Um exemplo será dado mais à frente, e será explicado, com o output respectivo. Aqui fica a minha classe: (* === UNIT THOGA31.PAS === * * By: Igor Nunes, aka thoga31 @ Portugal-a-Programar * * Date: November 30th, 2013 * * Description: * * This unit contains a useful class which allows to create menus very easily with rendering *) {$mode objfpc} unit UFancyMenu; interface uses crt, sysutils, strutils; (* Some useful constants *) const sys : record // cannot be used to define other constants KEY_ENTER : char; KEY_ESC : char; NEWLINE : ShortString; end = (KEY_ENTER:#13; KEY_ESC:#27; NEWLINE:#13+#10); type TStrArr = array of string; // used for renderers TMenu = class(TObject) // Procedures and Functions described on their implementation private type TProc = procedure; TOption = record prompt : string; // Text to write key : char; // Key that must be pressed for this option action : TProc; // Procedure associated with this option end; TKeysSet = set of char; TOptList = array of TOption; var VMenu : TOptList; // contains all the options of the menu VMenuSorted : TOptList; // a sorted version of the menu, by keys VKeys : TKeysSet; // a set of all keys used in this menu VSorted : boolean; // informs if this menu must be shown sorted VRender : string; // defines the renderer of the menu VMaxLength : word; // helps to calculate the size of the menu with renderer procedure Sort; public constructor Create(mysorted : boolean = false); procedure Add(myprompt : string; mykey : char; myproc : TProc); procedure Show(title : string = ''); function GetChoice(performAction : boolean = true) : char; property KEYS : TKeysSet read VKeys; // Gets the set of keys property sorted : boolean read VSorted write VSorted; // Defines if the menu must be shown sorted by keys property render : string write VRender; // Defines the render of the menu - '' for no render. Errors by misuse not controlled! end; function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr; implementation function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr; (* Splits a string by a char, returning the substrings, without the char, in a dynamic array of strings. *) var i : integer; t : string = ''; begin SetLength(SplitAtChar, 0); for i := 1 to length(S) do begin if (S[i] = CH) or (i = length(S)) then begin SetLength(SplitAtChar, length(SplitAtChar)+1); SplitAtChar[high(SplitAtChar)] := t + IfThen(i = length(S), s[i], ''); t := ''; end else begin t := t + s[i]; end; end; end; constructor TMenu.Create(mysorted : boolean = false); (* Initialize the variants of the class *) begin inherited Create; SetLength(self.VMenu, 0); self.VKeys := []; self.VSorted := mysorted; self.VRender := ''; self.VMaxLength := 0; end; procedure TMenu.Sort; (* Sorts the menu by keys in a second variant, "VMenuSorted". *) var temp : TOption; i, j : integer; begin self.VMenuSorted := self.VMenu; for i := 0 to high(self.VMenuSorted)-1 do for j := i to high(self.VMenuSorted) do if self.VMenuSorted[i].key > self.VMenuSorted[j].key then begin temp := self.VMenuSorted[i]; self.VMenuSorted[i] := self.VMenuSorted[j]; self.VMenuSorted[j] := temp; end; end; procedure TMenu.Add(myprompt : string; mykey : char; myproc : TProc); (* Add a new item to the menu. *) begin SetLength(self.VMenu, length(self.VMenu)+1); with self.VMenu[high(self.VMenu)] do begin prompt := myprompt; if self.VMaxLength < length(myprompt) then self.VMaxLength := length(myprompt); key := mykey; Include(self.VKeys, mykey); action := myproc; end; end; procedure TMenu.Show(title : string = ''); (* Displays the menu with the renderer. *) var menu_to_show : TOptList; option : TOption; renderer : TStrArr; r : string; i : integer; maxlen : word; begin if self.VSorted then begin self.Sort; menu_to_show := self.VMenuSorted; end else menu_to_show := self.VMenu; if self.VRender <> '' then begin // we have renderer // Gets the renderers: renderer := SplitAtChar(self.VRender, '§'); // Recalculate the maximum length, given the renderer: maxlen := VMaxLength; if length(title) > maxlen then begin for r in renderer do if AnsiContainsText(r, '#TITLE') then begin inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))); break; end; end else begin for r in renderer do if AnsiContainsText(r, '#OPTION') then begin inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))); break; end; end; // displays the menu with the application of the renders: for r in renderer do begin if AnsiContainsText(r, '#TITLE') then writeln(AnsiReplaceText(AnsiReplaceText(r, '#TITLE', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))), PadRight(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))))), '@CENTER', '')) else if AnsiContainsText(r, '#OPTION') then for option in menu_to_show do writeln(AnsiReplaceText(AnsiReplaceText(r, '#OPTION', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))), PadRight(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))))), '@CENTER', '')) else begin write(r[1]); for i:=2 to maxlen-1 do write(r[2]); writeln(r[3]); end; end; end else begin // we have no renderer... simple output if title <> '' then writeln(title); for option in menu_to_show do writeln(option.prompt); end; end; function TMenu.GetChoice(performAction : boolean = true) : char; (* Waits for the user's option. *) var option : TOption; begin repeat GetChoice := upcase(ReadKey); until GetChoice in self.VKeys; if performAction then for option in self.VMenu do if GetChoice = option.key then begin if option.action <> nil then option.action; break; end; end; end. Exemplo de aplicação: {$mode objfpc} program apostas; uses crt, sysutils, strutils, thoga31; procedure Pause; (* Pauses the program until ENTER is pressed *) begin repeat until readkey = sys.KEY_ENTER; end; procedure Totoloto; begin clrscr; writeln('TOTOLOTO'); Pause; clrscr; end; procedure Euromillions; begin clrscr; writeln('EUROMILLIONS'); Pause; clrscr; end; const EXIT_OPTION = #27; var main_menu : TMenu; begin main_menu := TMenu.Create(); with main_menu do begin Add(' 1 > Totoloto', '1', @Totoloto); Add(' 2 > Euromillions', '2', @Euromillions); Add('ESC > Exit', EXIT_OPTION, nil); render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+'; end; repeat main_menu.Show('Choose an option:'); until main_menu.GetChoice = EXIT_OPTION; main_menu.destroy; end. Output do menu com rendering: +--------------------+ | Choose an option: | +--------------------+ | 1 > Totoloto | | 2 > Euromillions | | ESC > Exit | +--------------------+ Explicação do rendering: main_menu.render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+'; Será mais fácil ver isto separado por linhas (caracter §): +-+ | #TITLE@CENTER | +-+ | #OPTION | +-+ O método Show vai analisar cada linha do render e executa uma série de acções conforme o seu conteúdo. 1ª, 3ª e 5ª linhas, +-+: se não há #TITLE nem #OPTION, terá de ter obrigatoriamente 3 caracteres! Neste caso, o primeiro e o último são os caracteres das pontas, e o caracter do meio é repetido até ao comprimento máximo, definido pelo título e/ou pelo item do menu mais comprido. 2ª linha, | #TITLE@CENTER |: entre #TITLE e @CENTER não deverá haver espaços nem outros caracteres. Neste caso #TITLE@CENTER é substituído pelo título do menu e centrado conforme o comprimento máximo, descrito no ponto anterior. Defini esta sintaxe pois lê-se mesmo "title at center". 4ª linha, | #OPTION |: é substituído pelas opções todas, uma por linha. Não é possível criar separadores entre opções. Usem e modifiquem a classe para ficar melhor. O que acham? Reconheço que este não é dos meus melhores códigos, mas é um princípio 😉 Saudações pascalianas!

Estava nas minhas pesquisas sobre pascal e encontrei isto no site do free pascal Galeria de aplicações feitas em pascal e lazarus http://wiki.freepascal.org/Lazarus_Application_Gallery Aplicações, jogos, utilitários, etc feitos em pascal e lazarus http://wiki.freepascal.org/Projects_using_Lazarus http://wiki.freepascal.org/FPC_Applications/Projects_Gallery Se estiverem à procura de algum projecto em pascal, tem nesses sites de tudo. Ps: As pessoas que falam mal do pascal e/ou dizem que o pascal não serve para nada, deem uma vista de olhos nesses sites.

'CalcGraph', calculadora gráfica - Revista PROGRAMAR Ed. 36 (Agosto 2012) Ver Ficheiro Este ZIP inclui todos os códigos-fonte (*.pas), bem como os executáveis (*.exe) já compilados para Windows, de tudo o que o artigo Pascal - Construção de uma calculadora gráfica (Revista PROGRAMAR, 36ª Edição (Agosto 2012)) aborda: Unit 'CalcGraph'; Programa de teste da Unit 'CalcGraph'; Programa de experiência da Unit 'Graph' (FPC 2.6.0). Submetido por thoga31 Submetido em 17-08-2012 Categoria Revista PROGRAMAR