Dicas 01:
Para fazer
protetor de tela com o Delphi
Para o pessoal que
queria saber...
A) No .Dpr ponha {$D
SCRNSAVE } depois do uses
B) No Form principal
nao ponha borda ou icone. No metodo Activate ponha left
e top como 0 e o
Windowstate como wsMaximize.
C) no form.Create ponha
application.OnMessage para um metodo que controle a
desativacao do screen
saver. Ponha tb o application.OnIdle para "rodar" o
dito cujo...
D) Tb no Form.Create
teste a linha de comando para /c ou /s. Estes
parametros dizem o que
e' para fazer (/c configura)
E) Compile e renomeie o
.exe p/ .scr, move para o diretorio do windows e...
Linkar um
OBJ ao executável
Primeiro voce deve
"linkar" o OBJ ao seu executavel.
No Delphi , isto eh
feito com a diretriz de
compilacao $L. Fica, na sua unit
principal, assim:
{$L MyOBject.OBJ}
Incluindo as chaves.
Logo depois, voce deve
declarar a funcao contida em MyObject.OBJ da forma
usual.
Voce precisara conhecer os parametros usados pela mesma, bem como o
tipo e a ordem em que
sao passados. Voce deve
incluir tambem a diretriz
PASCAL ou CDECL.
Sugiro tentar primeiro com PASCAL. Ficaria
assim (na
secao implementation:
function (Parametro1 :
TipoDoParametro1, Parametro2 : TipoDoParametro2):
TipoDoRetorno; pascal;
se nao der certo,
tente:
function (Parametro1 :
TipoDoParametro1, Parametro2 : TipoDoParametro2):
TipoDoRetorno; cdecl;
caso nao seja uma
funcao e sim uma procedure, tente
procedure (Parametro1 :
TipoDoParametro1, Parametro2 : TipoDoParametro2);
pascal;
ou
procedure (Parametro1 :
TipoDoParametro1, Parametro2 : TipoDoParametro2);
cdecl;
Se voce nao sabe quais
os parametros usados pela funcao/procedure, uma
solucao seria linkar o
seu OBJ num programa qualquer e disassembla-lo. Ai
pelo menos voce sabera
a quantidade e o tipo de cada parametro. De qualquer
forma, para saber para
que serve cada um, tera que ser na tentativa e
erro...a nao ser que
voce tambem tenha paciencia para analisar o codigo
disassemblado.
OBS:
Se o seu OBJ nao estiver num formato reconhecivel pelo LINK do Delphi
(um formato similar ao
COFF), voce pode tentar outros Linkers, e criar uma
dll.
Existem varios linkers gratuitos, que reconhecem varios formatos
(exemplos, sao lcclnk,
djlnk, walk2lnk e o proprio linker da
microsoft...tambem
gratuito).
Alterar
LOCAL SHARE via programação
Olha Junior no WIN 95
você pode alterar diretamente a chave do registro
que seta esta opção. Fica
em HKEY_LOCAL_MACHINE > Software > ... LOCAL SHARE "TRUE"
(Pesquise com o regedit).
Já no WIN 3.xxx eu também gostaria de saber. Não encontrei
referências de como
fazer esta aleração utilizando a API do BDE.
Verificando
se o Delphi está aberto
Proteja aquele
aplicativo ou objeto que vc desenvolveu com esta rotina que
identifica se o usuário
está com o Delphi aberto (disponibiliza) ou fechado
(trava a execucao).
Bom proveito !
Function TForm1.JanelaExiste(Classe,Janela:String)
:Boolean;
var
PClasse,PJanela : array[0..79]
of char;
begin
if Classe = '' then
PClasse[0] := #0
else
StrPCopy(PClasse,Classe);
if Janela = '' then
PJanela[0] := #0
else
StrPCopy(PJanela,Janela);
if FindWindow(PClasse,PJAnela) <> 0 then
result := true
else
Result := false;
end;
Function TForm1.DelphiCarregado : Boolean;
begin
Result :=
False;
if JanelaExiste('TPropertyInspector','Object
Inspector') then
result
:= True
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if DelphiCarregado then
showmessage('Delphi está ativo, bom menino!')
else
begin
Showmessage('Vc não poderá utilizar esta aplicação! Mau garoto!');
application.terminate;
end;
end;
Criando formulários
Qual a melhor maneira
de criar forms em tempo de execucao:
a) Application.CreateForm(TfmClientes, fmClientes);
Cria o Form; o proprietário é a
aplicação.
b) fmClientes := TForm.Create(self);
Cria o Form; o proprietário é ele
mesmo.
c) fmClientes := TForm.Create(Application);
Cria o Form; o proprietário é a
aplicação.
d) fmClientes := TForm.Create(nil);
Cria o Form; teoricamente sem proprietário; na prática é a aplicação.
e) fmClientes :=
TfmClientes.Create(self);
Cria o Form; o proprietário é ele mesmo.
f) fmClientes := TfmClientes.Create(Application);
Cria o Form; o proprietário é a
aplicação.
g) fmClientes :=
TfmClientes.Create(nil);
Cria o Form; teoricamente sem proprietário; na prática é a aplicação.
Poderiam me informar a
diferenca entre elas?
Quando você cria um Form dinamicamente:
1. se criar através de
CreateForm, que é um método de TApplication, você passa como parâmetro a
instância da classe e o nome do seu objeto (TfmClientes, fmClientes);
2. se criar através de
Create - método de TForm, entre outros - você passa como parâmetro o proprietário
do componente criado (no caso o Form).
2.1 se o proprietário for a aplicação, o Form só será destruído
quando você finalizar o aplicativo
ou se você
declarar Free ou Destroy no seu programa; (casos a, c, d, f, g);
2.2 se o proprietário for ele mesmo (self), o form terá que ser destruído
por você;
2.3 se você criar, por exemplo, Form2 e passar como proprietário Form1;
no momento em que
Form1 for
destruído, Form2 também o será.
Quanto à melhor maneira, depende de como você quer controlar a aplicação,
mas leve em conta que enquanto um objeto não é destruído, ele está na memória.
Criando alias via programação
Se for para Paradox ...
Session.AddStandardAlias('SeuAlias', edtPath.text, 'Paradox');
Session.SaveConfigFile;
Desabilitar
acesso a windows
Ai vai um codigo que
peguei no site da Borland que trava as teclas
(Ctrl+Alt+Del),(Alt+Tab), (Ctrl+Esc)
var
OldValue :
LongBool;
begin
{liga
a trava}
SystemParametersInfo(97, Word(True), @OldValue, 0);
{desliga a trava}
SystemParametersInfo(97, Word(False), @OldValue,
0);
end;
Splash
Screen
form2:=tform2.create(application);
form2.show;
form2.update;
.
.
.
form2.hide;
form2.free;
Application.Run;
Obs: apagar a primeira linha, 'Application.Initialize'.
Para saber somente o path da
aplicação
ExtractFilePath(
Application.ExeName )
Como saber se o aplicativo já foi aberto
Insira o código abaixo dentro do arquivo .DPR de sua aplicação
{$R *.RES}
begin
Application.Title := '';
Application.HelpFile := '';
if HPrevInst = 0 then
begin
F_Splash := TF_Splash.create(Application);
F_Splash.Show;
Application.CreateForm(TF_Menu, F_Menu);
Application.CreateForm(TF_Error, F_Error);
Application.CreateForm(TF_Form1, F_From1);
Application.CreateForm(TF_Form2, F_Form2j);
Application.Run;
end
else
messagedlg('O sistema já foi inicializado!',mtinformation,[mbok],0);
end.
Impressão com o TPrinter ( Via
gerenciador de impressão)
procedure
TForm1.BitBtn1Click(Sender: TObject);
var
Linha:integer;
Tamanho:integer;
Coluna:integer;
begin
Printer.Orientation := poLandscape;
Printer.BeginDoc;
Printer.Canvas.Pen.Width := 5;
Printer.Canvas.Font.Name := 'Times New Roman';
Printer.Canvas.Font.Size := 10;
Linha := 20;
Coluna:= 20;
Tamanho := Printer.Canvas.TextWidth('a');
Table1.First;
while not Table1.Eof do
begin
if Linha = 20 then
begin
Coluna := 20;
Printer.Canvas.TextOut(0,Linha,'Relação de Clientes');
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
Printer.Canvas.TextOut(Coluna,Linha,'Cod');
Coluna:= Coluna + (Tamanho * 5 );
Printer.Canvas.TextOut(Coluna,Linha,'Nome');
Coluna:= Coluna + (Tamanho * 30);
Printer.Canvas.TextOut(Coluna,Linha,'Endereço');
Coluna:= Coluna + (Tamanho * 30);
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
end;
Coluna := 20 ;
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘Codigo’).AsString);
Coluna:= Coluna + (Tamanho * 5 );
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘Nome’).AsString);
Coluna:= Coluna + (Tamanho * 30);
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘End’).AsString);
Coluna:= Coluna + (Tamanho * 30);
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
Table1.Next;
if Linha > Printer.PageHeight-20 then
Begin
Printer.NewPage;
Linha := 20;
end;
end;
Printer.EndDoc;
end;
Impressão direto para impressora
procedure TForm1.Button1Click(Sender: TObject);
var
F : TextFile;
i : integer;
begin
AssignFile(F,'LPT1');
Rewrite(F);
i := 0;
Writeln(F,'Teste de impressao - Linha 0');
Writeln(F,'Teste de impressao - Linha 1');
Writeln(F,#27#15+'Teste de Impressão - Linha 2');
Writeln(F,'Teste de impressao - Linha 3');
Writeln(F,#27#18+'Teste de Impressão - Linha 4');
Writeln(F,'Teste de impressao - Linha 5');
Writeln(F,#12); // Ejeta a página
CloseFile(F);
end;
Definir o tamanho do papel em
TPrinter
Esta procedure configura o tamanho do papel em Run-Time para ser utilizado com o objeto TPrinter; Esta procedure deve ser chamada antes de aplicar o método Printer.BeginDoc.
procedure TForm1.SetPrinterPage(Width, Height : LongInt);
var
Device :
array[0..255] of char;
Driver :
array[0..255] of char;
Port
: array[0..255] of char;
hDMode :
THandle;
PDMode :
PDEVMODE;
begin
Printer.GetPrinter(Device,
Driver, Port, hDMode);
If
hDMode <> 0 then
begin
pDMode := GlobalLock( hDMode );
If pDMode <> nil then
begin
pDMode^.dmPaperSize :=
DMPAPER_USER;
pDMode^.dmPaperWidth :=
Width;
pDMode^.dmPaperLength := Height;
pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;
GlobalUnlock( hDMode );
end;
end;
end;
Como
criar Forms em tempo de execução
Para você economizar memória, pode-se criar os forms de sua aplicação somente no momento da execução. Na criação do Form
você define se ele é MODAL ou NÃO MODAL. Para Isso observe os seguintes códigos:
MODAL - Mostra form em modo exclusivo
procedure
TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2,
Form2);{Carrega form na memória}
Form2.ShowModal;{Mostra form em modo exclusivo}
Form2.Free;
{Libera Memória}
end;
NÃO MODAL - Mostra form em modo não exclusivo
procedure
TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2,
Form2);{Carrega form na memória}
Form2.ShowModal;{Mostra form em modo exclusivo}
end;
No evento OnClose do Form2 coloque o seguinte código.
procedure
TForm2.FormClose (Sender: Tobject; var Action : TCloseAction);
begin
Action:=
caFree;
end;
Aliado a este código, deve deve alterar no delphi, no menu Options, opção Project. Mudando os forms a serem criados
dinamicamente da coluna Auto-Create Forms para Avaliable Forms.
Adaptando
para resoluções de video diferentes?
Sempre que procurei algo sobre esse tema, ia para no Tip da Borland #2861, que é a mesma informação do arquivo de help da
Loyd’s. Esse texto tambem aparece nos bancos de dados da Q&A. Eu suponho que essa seja a informação definitiva. Encontrei
uma informação que não foi mencionada aqui. Pela lista de correiros do Delphi-Talk havia mensagens de Brien King e Michael
Novak que discutiam esse assunto.
***
LOYD´S
TIPS:
Resolução de Vídeo:
Quando criamos formulários, ãs vezes é útil escrever um código para que a tela e todos os seus objetos sejam mostrados no
mesmo tamanho, não importando qual a resolução da tela. Aqui esta um código que mostra como isso é feito:
Implementation
const
ScreenWidth:
LongInt = 800; {I designed my form in 800x600 mode.}
ScreenHeight:
LongInt = 600;
{$R *.DFM}
procedure
TForm1.FormCreate (Sender: Tobject);
begin
scaled := true;
if (screen.width <> ScreenWidth) then
begin
height := longint(height) * longint(screen.height) DIV ScreenHeight;
width := longint(width) * longint(screen.width) DIV ScreenWidth;
scaleyBy(screen.width, ScreenWidth);
end;
end;
Agora, você vai querer checar, se o tamanho dos fontes(de letra) estão OK. Antes de trocar p tamanho do fonte, você precisará ter
certeza de que o objeto realmente tem a propriedade fonte pela checagem da RTTI. Isso pode ser feito assim:
USES
tyinfo; {Add this to your USES statement.}
var
i:integer;
begin
for i := componentCount - 1 downto 0 do
with components[i] do
begin
if GetPropInfo(ClassInfo, ´font´) <> nil then
font.size := (NewFormWidth DIV OldFormWidth) * font.size;
end;
end;
{Esta é a maneira longa de fazer a mesma coisa}
var
i:integer;
p:PPropInfo;
begin
for i := componentCount - 1 downto 0 do
with components [i] do
begin
p := GetPropInfo (ClassInfo, ´font´);
if assigned (p) then
font.size := (NewFormWidth DIV OldFormWidth) * font.size;
end;
end;
Atenção: Nem todos os objetos tem a propriedade FONT. Isso deve ser o suficiente para você começar.
Atenção: A seguir, algumas dicas para ter em mente quando representar aplicações Delphi (formulários) em diferentes resoluções
de Tela:
* Decida antecipadamente, na etapa de criação do formulário, se ele será escalável ou não. A vantagem de um não escalável é
que nada muda em tempo de execução. A desvantagem é equivalente (seu formulário pode ser muito pequeno ou grande para
alguns sistemas se nào for usada escala).
* Se você não for usar formulário escalável, configure o set scaled to False.
* Ou então, configure a propriedade scaled do formulário para True.
* Configure a propriedade AutoScroll para False. AutoScroll = True quer dizer "não mexa no tamanho do frame do formulário em
tempo de execução", o que não parece bom quando o conteúdo do formulário muda de tamanho.
* Configure a fonte do formulário para uma True Type escalável, como a Arial MS. San Serif é uma boa alternativa, mas lembre que
ainda é uma fonte bitmapped. Só a Arial dará uma fonte dentro de um pixel da altura desejada.ATENÇÃO: Se a fonte usada em
uma aplicação não estiver instalada no computador, o Windows selecionará uma fonte alternativa da mesma família para utilizar. O
tamanho dessa fonte pode não corresponder ao da fonte original, podendo causar problemas.
* Configure a propriedade position do formulário para uma opção diferente de poDesigned. poDesigneddeixa o formulário onde você
o deixou ( no design Time), o que sempre termina fora da margem, à esquerda da minha tela 1280 x 1024 - e completamente fora
da tela 640 x 480.
* Não amontoe controles no formulário - deixe pelo menos 4 pixels entre else, para que uma mudança de um pixel nas margens
(devido a apresentação em escala) não mostre controles sobrepostos.
* Para labels de uma linha alinhadas ã esquerda ou à direita, configure o AutoSize para True. Para outras formas de alinhamento
configure o AutoSize para False.
* Tenha certeza de que há espaço em branco suficiente num componente de labels para alterações no tamanho da fonte - um
espaço de 25% do comprimento da linha de caracteres mostrada é um pouco a mais do que se precisa, mas é mais seguro.
(Você vai precisar de um espaço equivalente a 30% de espansão para string labels se você pretende traduzir sua aplicação para
outra linguagem). Se o Autosize estiver em False, tenha certeza de que realmente configurou o tamanho do label corretamente.
Se o Autosize estiver em True, esteja certo de que há espaço suficiente para que o label se amplie.
* Em labels de múltiplas linhas ou de termos ocultos, deixe pelo menos uma linha em branco na base. Isso vai ser necessário
para incluir o que estiver sobrando quando o texto for oculto de maneira diferente, pela mudança do tamanho da fonte com a
escala. Não assuma isso porque está usando fontes grandes. Você não tem que deixar sobra de texto - as fontes (grandes) de
outros usuários podem ser maiores que as suas!
* Tenha cuidado quando abrir um projeto em IDEs com resoluções diferentes. Assim que o formulário for aberto, sua propriedade
Pixel per Inch será moditificada, e gravada para o DFM se você salvar o projeto. É melhor testar a aplicação rodando sozinho, e
editar o formulário em apenas uma resolução. Editar em várias resoluções e tamanhos de fonte provoca problemas de fluxo e
tamanho dos componentes.
*Falando em fluxo de componentes, não represente o formulário em escala muitas vezes, quando estiver sendo criado ou quando
tiver sendo executado. Cada escala introduz erros de roundoff que se acumulam muito rapidamente, uma vez que as coordenadas
são rigorosamente interias. Quando valores fracionários forem retirados das origens e tamanhos do controle com cada sucessiva
representação em escala, os conttroles parecerão deslizar para noroeste e ficar menores. Se você quer deixar seus usuários
representarem o formulários em escala quantas vezes quiserem, comece com um formulário recentemente criado para que erros
de escala não se acumulem.
* Definitivamente, não mexa na propriedade Pixel pre Inch do formulário.
* Em geral, não é necessário criar formulários em uma resolução específica, mas é essencial que você os revise em 640 x 480
com fontes pequenas e/ou grandes, e em alta resolução com fontes pequenas e/ou grandes antes de liberar suas aplicações. Isso
deverser parte de sua lista de conferência para testar a compatibilidade do sistema regularmente.
* Preste bastante atenção em todos os componentes que são basicamamente TMemo de uma linha - com oTDBLookupCombo. O
controle de edição (multi-linhas) do Windows sempre mostra apenas linhas inteiras de texto. Se o controle for muito curto para
sua fonte, um TMemo não mostrará coisa alguma, e um TEdit mostrará um pedaço do texto. É melhor fazer esses componentes
um pouco maiores do que deixá-los um pixel menores e não aparecer nada do texto.
* Tenha em mente que toda representação em escala é proporcional à diferença da altura da fonte entre o modo de execução e o
modo de desenho, NÃO à resolução ou ao tamanho do monitor. Lembre também que as origens dos seus controles serão
alteradas quando o formulário for representado em escala. Você não pode aumentar componentes muito bem sem também
movê-los um pouco, novamente.
Obtendo e modificando a posição do cursor em um TMemo
Modificando a posição:
ActiveControl:=Memo1;
MemoCursorTo(Memo1,2,3);
Obtendo a Posição:
GetMemoLineCol(Memo1,Linha,Coluna);
WinExec("command.com
/c programa.exe",sw_ShowNormal);
Como
posso rolar um form usando pgUP and pgDn.
Versão: Todas
Plataforma: Windows/Win32
Q. Como posso fazer funções de rolagem num componente TForm usando comandos
de teclado? Por exemplo, rolar pra cima e pra baixo quando pressionar PgUp
ou PgDown. Existe algum método simples de fazer isso???
R. O rolamento do form é completo fazendo-se uma modificação na posição das
propriedades VertScrollbar ou HorzScrollbar do form. Como mostrado no código a
seguir:
procedure
TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift:
TShiftState);
const
PageDelta = 10;
begin
With VertScrollbar do
if Key = VK_NEXT then
Position := Position + PageDelta
else if Key = VK_PRIOR then
Position := Position - PageDelta;
end;
Para reproduzir sons no formato WAV em um programa em Delphi é simples, o usuário deverá colocar na clásula
Uses o MMSystem. E no corpo do programa o comando:
SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);
Edite diretamente no DPR, e depois salve como Funcoes.dpr:
Library
Funcoes;
Uses
SysUtils,WinTypes,WinProcs;
{ Uma função que tira os espaços no início e no final de uma string }
Function
Trim(J:String):String; Export;
Begin
While
J[Length(J)]=#32 do Dec(J[0]);
If
Length(J)>1 then
While
(J[1]=' ') do
Begin
Delete(J,1,1);
If
Length(J)<=1 then J:='';
end;
Result:=J;
end;
Exports { Torna visivel para os programas }
Trim;
Begin
End.
Para usar num programa:
Unit
Unit1;
Interface
uses
SysUtils,
WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, Buttons;
type
TForm1 =
class(TForm)
procedure
FormCreate(Sender: TObject);
procedure
FormClick(Sender: TObject);
private
{
Private declarations }
public
{ Public
declarations }
end;
Var
Form1:
TForm1;
Implementation
{
Declara a funcao }
Function
Trim(J:String):String; External 'funcoes.dll';
{$R
*.DFM}
Procedure
TForm1.FormClick(Sender: TObject);
begin
Caption:=Trim(' Visite sempre o Delphi Club '); { Note os espacos }
end;
As vantagens de colocar as funções em DLL são:
1. O programa exigirá menos memória
2. Você poderá reaproveitar as funções
3. Em alguns casos pode-se atualizar apenas as dll para um upgrade
Para compactar (remover fisicamente todos registros apagados) de uma tabela Paradox deve-se utilizar o seguinte código
procedure
ParadoxPack(Table : TTable);
var
TBDesc : CRTblDesc;
hDb: hDbiDb;
TablePath: array[0..dbiMaxPathLen] of char;
begin
FillChar(TBDesc,Sizeof(TBDesc),0);
with TBDesc do begin
StrPCopy(szTblName,Table.TableName);
StrPCopy(szTblType,szParadox);
bPack := True;
end;
hDb := nil;
Check(DbiGetDirectory(Table.DBHandle, True, TablePath));
Table.Close;
Check(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite,
dbiOpenExcl,nil,0, nil, nil, hDb));
Check(DbiSetDirectory(hDb,
TablePath));
Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False));
Table.Open;
end;
unit
CPFeCGC;
interface
function
cpf(num: string): boolean;
function
cgc(num: string): boolean;
implementation
uses
SysUtils;
function
cpf(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
d1:=n9*2+n8*3+n7*4+n6*5+n5*6+n4*7+n3*8+n2*9+n1*10;
d1:=11-(d1
mod 11);
if
d1>=10 then d1:=0;
d2:=d1*2+n9*3+n8*4+n7*5+n6*6+n5*7+n4*8+n3*9+n2*10+n1*11;
d2:=11-(d2
mod 11);
if
d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[10]+num[11];
if
calculado=digitado then
cpf:=true
else
cpf:=false;
end;
function
cgc(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
n10:=StrToInt(num[10]);
n11:=StrToInt(num[11]);
n12:=StrToInt(num[12]);
d1:=n12*2+n11*3+n10*4+n9*5+n8*6+n7*7+n6*8+n5*9+n4*2+n3*3+n2*4+n1*5;
d1:=11-(d1
mod 11);
if
d1>=10 then d1:=0;
d2:=d1*2+n12*3+n11*4+n10*5+n9*6+n8*7+n7*8+n6*9+n5*2+n4*3+n3*4+n2*5+n1*6;
d2:=11-(d2
mod 11);
if
d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[13]+num[14];
if calculado=digitado then
cgc:=true
else
cgc:=false;
end;
end.
unit
Ext;
interface
function
extenso (valor: real): string;
implementation
uses
SysUtils, Dialogs;
function extenso (valor: real):
string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades:
array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco',
'Seis',
'Sete', 'Oito', 'Nove');
Dez:
array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze',
'Dezesseis', 'Dezessete', 'Dezoito',
'Dezenove');
Dezenas:
array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta',
'Cinquenta', 'Sessenta', 'Setenta',
'Oitenta', 'Noventa');
Centenas: array[1..9] of string = ('Cento', 'Duzentos',
'Trezentos',
'Quatrocentos', 'Quinhentos', 'Seiscentos',
'Setecentos', 'Oitocentos', 'Novecentos');
function
ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
if
Expressao
then Result:=CasoVerdadeiro
else Result:=CasoFalso;
end;
function
MiniExtenso (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:='';
Dezena:='';
Centena:='';
if
(trio[2]='1') and (trio[3]<>'0') then
begin
Unidade:=Dez[strtoint(trio[3])];
Dezena:='';
end
else
begin
if trio[2]<>'0' then Dezena:=Dezenas[strtoint(trio[2])];
if trio[3]<>'0' then Unidade:=Unidades[strtoint(trio[3])];
end;
if
(trio[1]='1') and (Unidade='') and (Dezena='')
then
Centena:='cem'
else
if
trio[1]<>'0'
then Centena:=Centenas[strtoint(trio[1])]
else Centena:='';
Result:=
Centena + ifs((Centena<>'') and ((Dezena<>'') or
(Unidade<>'')), ' e ', '')
+ Dezena +
ifs((Dezena<>'') and (Unidade<>''),' e ', '') + Unidade;
end;
begin
if
(valor>999999.99) or (valor<0) then
begin
msg:='O valor está fora do intervalo permitido.';
msg:=msg+'O número deve ser maior ou igual a zero e menor que
999.999,99.';
msg:=msg+' Se não for corrigido o número não será escrito por
extenso.';
showmessage(msg);
Result:='';
exit;
end;
if
valor=0 then
begin
Result:='';
Exit;
end;
Texto:=formatfloat('000000.00',valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso('0'+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>'' then
if
copy(texto,4,3)='000' then
Result:=Result+' Mil Reais'
else
Result:=Result+' Mil, ';
if
(((copy(texto,4,2)='00') and (Milhar<>'')
and (copy(texto,6,1)<>'0')) or (centavos=''))
and (Centena<>'') then Result:=Result+' e ';
if
(Milhar+Centena <>'') then Result:=Result+Centena;
if
(Milhar='') and (copy(texto,4,3)='001') then
Result:=Result+' Real'
else
if (copy(texto,4,3)<>'000') then Result:=Result+' Reais';
if
Centavos='' then
begin
Result:=Result+'.';
Exit;
end
else
begin
if Milhar+Centena='' then
Result:=Centavos
else
Result:=Result+', e '+Centavos;
if
(copy(texto,8,2)='01') and (Centavos<>'') then
Result:=Result+' Centavo.'
else
Result:=Result+' Centavos.';
end;
end;
end.