Exemplos

se você tiver algum exemplo ou dica e quizer me enviar, ou se algum exemplo deste
não der certo, me mande um e-mail para que eu possa corrigir, porque alguns exemplos aqui citados não são de minha autoria, portanto não posso garantir a qualidade dos mesmos.

Topo

Topo

var
  Form1: TForm1;

implementation
{$R *.DFM}

// Evento OnClick do componente BitBtn
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Table1.First;
  While not Table1.Eof do
    begin
      if DBGrid1.SelectedRows.IndexOf(Table1.BookMark) >= 0 then
      ShowMessage(‘Registro selecionado’);
      Table1.Next;
    end;
end;

Topo

A variável TwoDigitYearCenturyWindow indica quantos anos a partir do ano corrente ainda vai ser contado como do mesmo século, isto é, 1900.
Por exemplo, o número 2 indica que a partir do ano corrente toda data com 2 anos de diferença será contada como do ano 2000.
Ano corrente = 98
TwoDigitYearCenturyWindow := 2;
95 será igual a 2095

Topo

Topo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
BitMap : TBitMap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Begin
  BitMap := TBitMap.Create;
  BitMap.LoadFromFile(‘c:\windows\floresta.bmp’);
end;

procedure TForm1.FormPaint(Sender: TObject);
var X, Y, W, H: LongInt;
begin
    with Bitmap do
      begin
        W := Width;
        H := Height;
      end;
    Y := 0;
    while Y < Height do
      begin
        X := 0;
        while X < Width do
          begin
            Canvas.Draw(X, Y, Bitmap);
            Inc(X, W);
          end;
        Inc(Y, H);
      end;
end;

end.

Topo

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, Db, DBTables, BDE, DBCtrls, Menus, ComCtrls,
Buttons ;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
Table1: TTable;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var Form1: TForm1;

type
  ChangeRec = packed record
  szName: DBINAME;
  iType: Word;
  iSubType: Word;
  iLength: Word;
  iPrecision: Byte;
end;

var MyChangeRec: ChangeRec;

procedure AddField(Table: TTable; NewField: ChangeRec);

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
    MyChangeRec.szName := ‘NovoCampo’;
    MyChangeRec.iType := fldPDXCHAR;
    MyChangeRec.iSubType:=0;
    MyChangeRec.iLength := 45;
    MyChangeRec.iPrecision := 0;

    Table1.Close;
    Table1.Exclusive := True;
    Table1.Open;
    AddField(Table1, MyChangeRec);
    Table1.Close;
    Table1.Exclusive := False;
    Table1.Open;
end;

procedure AddField(Table: TTable; NewField: ChangeRec);
var Props: CURProps;
    hDb: hDBIDb;
    TableDesc: CRTblDesc;
    pFlds: pFLDDesc;
    pOp: pCROpType;
    B: byte;
begin
  if Table.Active = False then
     raise EDatabaseError.Create(‘A tabela precisa estar aberta’);
  if Table.Exclusive = False then
     raise EDatabaseError.Create(‘A tabela precisa estar aberta em modo        
     Exclusivo’);
  Check(DbiSetProp(hDBIObj(Table.Handle), curxltMODE, integer(xltNONE)));
  Check(DbiGetCursorProps(Table.Handle, Props));
  pFlds := AllocMem((Table.FieldCount + 1) * sizeof(FLDDesc));
  FillChar(pFlds^, (Table.FieldCount + 1) * sizeof(FLDDesc), 0);
  Check(DbiGetFieldDescs(Table.handle, pFlds));

  for B := 1 to Table.FieldCount do
    begin
      pFlds^.iFldNum := B;
      Inc(pFlds, 1);
    end;
  try
    StrCopy(pFlds^.szName, NewField.szName);
    pFlds^.iFldType := NewField.iType;
    pFlds^.iSubType := NewField.iSubType;
    pFlds^.iUnits1 := NewField.iLength;
    pFlds^.iUnits2 := NewField.iPrecision;
    pFlds^.iFldNum := Table.FieldCount + 1;
  finally
    Dec(pFlds, Table.FieldCount);
  end;

  pOp := AllocMem((Table.FieldCount + 1) * sizeof(CROpType));
  Inc(pOp, Table.FieldCount);
  pOp^ := crADD;
  Dec(pOp, Table.FieldCount);
  // Blank out the structure...
  FillChar(TableDesc, sizeof(TableDesc), 0);
  // Get the database handle from the table’s cursor handle...
  Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
  // Put the table name in the table descriptor...
  StrPCopy(TableDesc.szTblName, Table.TableName);
  // Put the table type in the table descriptor...
  StrPCopy(TableDesc.szTblType, Props.szTableType);
  // Close the table so the restructure can complete...
  TableDesc.iFldCount := Table.FieldCount + 1;
  Tabledesc.pfldDesc := pFlds;
  TableDesc.pecrFldOp := pOp;
  Table.Close;
  // Call DbiDoRestructure...
  try
    Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
  finally
    FreeMem(pFlds);
    FreeMem(pOp);
    Table.Open;
  end;
end;
end.

Topo

// Evento OnClick do componente Table
procedure TForm1.Button1Click(Sender: TObject);
var hwndHandle : THANDLE;
    hMenuHandle : HMENU;
begin
  hwndHandle := FindWindow(nil, 'Sem título - Bloco de Notas');
  if (hwndHandle <> 0) then
     begin
       hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
       if (hMenuHandle <> 0) then
          DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
     end;
end;

Topo

procedure TForm1.Button1Click(Sender: TObject);
var Buffer : array [0..255] of char;
begin
  GetShortPathName('C:\Arquivos de programas\Borland\Common Files\BDE\
                     Bde32.hlp',@Buffer,sizeof(Buffer));
  Memo1.Lines.Add(Buffer);
end;

Topo

procedure TForm1.Button1Click(Sender: TObject);
begin
  TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
end;

Topo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Grids;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.Rows[1].Strings[0] := 'Esta Linha';
  StringGrid1.Cols[1].Strings[0] := 'Esta Coluna';
end;

// Esta função pesquisa a coluna
function GetGridColumnByName(Grid : TStringGrid;ColName:string):integer;
var i : integer;
begin
  for i := 0 to Grid.ColCount - 1 do
  if Grid.Rows[0].Strings[i] = ColName then
     begin
       Result := i;
       exit;
     end;
  Result := -1;
end;

// Esta função pesquisa a linha
function GetGridRowByName(Grid:TStringGrid;RowName: string):integer;
var i : integer;
begin
  for i := 0 to Grid.RowCount - 1 do
  if Grid.Cols[0].Strings[i] = RowName then
     begin
       Result := i;
       exit;
     end;
  Result := -1;
end;

// Evento OnClick do componente BitBtn
procedure TForm1.BitBtn1Click(Sender: TObject);
var Column,Row : integer;
begin
  Column := GetGridColumnByName(StringGrid1, 'Esta Coluna');
  if Column = -1 then
     ShowMessage('Coluna não encontrada')
  else ShowMessage('Coluna encontrada ' + IntToStr(Column));
  Row := GetGridRowByName(StringGrid1, 'Esta Linha');
  if Row = -1 then
     ShowMessage('Linha não encontrada')
  else ShowMessage('Linha encontrada ' + IntToStr(Row));
end;

Topo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, MPlayer;

type
TForm1 = class(TForm)
Button1: TButton;
MediaPlayer1: TMediaPlayer;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses mmsystem; // Deve-se declarar a unit mmsystem;
{$R *.DFM}

// Evento OnClick do componente Button
procedure TForm1.Button1Click(Sender: TObject);
begin
  MediaPlayer1.Filename := 'C:\0\teste.mpg';
  MediaPlayer1.Open;
  MediaPlayer1.Display := Panel1;
  MediaPlayer1.DisplayRect := Panel1.ClientRect;
  MediaPlayer1.Play;
end;

Topo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyShowHint(var HintStr: string;
var CanShow: Boolean;
var HintInfo: THintInfo);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Função que irá alterar a fonte do Hint
procedure TForm1.MyShowHint(var HintStr: string;
var CanShow: Boolean;
    HintInfo: THintInfo);
    i : integer;
begin
  for i := 0 to Application.ComponentCount - 1 do
  if Application.Components[i] is THintWindow then
    with THintWindow(Application.Components[i]).Canvas do
      begin
        Font.Name := 'Arial';
        Font.Size := 18;
        Font.Style := [fsBold];
        HintInfo.HintColor := clWhite;
      end;
end;

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Ativa a função que irá alterar o formato do Hint
  Application.OnShowHint := MyShowHint;
end;

Topo

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids;

type
TForm1 = class(TForm)
  StringGrid1: TStringGrid;
  procedure FormCreate(Sender: TObject);
  procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  Col,Row : integer; // Declarar esta variável
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.Hint := '0 0';
  StringGrid1.ShowHint := True;
end;

// Evento OnMouseMove do componente StringGrid
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var r,c : integer;
begin
  StringGrid1.MouseToCell(X, Y, C, R);
  if ((Row <> r) or (Col <> c)) then
     begin
       Row := r; Col := c;
       Application.CancelHint;
       StringGrid1.Hint := 'Linha: '+IntToStr(r)+#32+'Coluna: '+IntToStr(c);
     end;
end;

Topo

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
  // Retornar a cor
  Caption := ColorToString(Image1.Canvas.Pixels[X,Y]);
  // Retornar o número da cor
  Caption := Caption+' - '+IntToStr(ColorToRGB(Image1.Canvas.Pixels[X,Y]));
end;

Topo

implementation
uses UrlMon;

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
  HlinkNavigateString(nil,’http://www.oocities.org’);
end;

Topo

procedure TForm1.Button1Click(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETDESKWALLPAPER,0,
       PChar(‘C:\windows\Arenito.bmp’),SPIF_SENDWININICHANGE);
end;

Topo

procedure TForm1.SpeedButton1Click(Sender: TObject);
var TheWindow: HWND;
    Lingua: array[0..255] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, Lingua, 255);
  { Verifica se o Windows é Português ou Brasileiro }
  if Lingua <> ‘Português (Brasileiro)’ then
     TheWindow:=FindWindow(nil,’Calculadora’)
  else
     if Lingua <> ‘English (United States)’ then
        TheWindow:=FindWindow(nil,’Calculator’)

  { Procura a janela da calculadora }
  if TheWindow <> 0 then
     begin
       // Chama calculadora se já estiver carregada
       SetForegroundWindow(TheWindow);
       ShowWindow(TheWindow, SW_RESTORE);
     end
  else
     // Carrega calculadora se estiver fechada
     ShellExecute(Handle, ‘Open’, ‘Calc.exe’, nil, ‘c:\windows’, sw_show);
end;
end.

Topo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, Db, DBTables, BDE;

type
TForm1 = class(TForm)
Button1: TButton;
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure AddMasterPassword(Table: TTable; pswd: string);
procedure RemoveMasterPassword(Table: TTable);

var
Form1: TForm1;

implementation

{$R *.DFM}

// Adiciona a senha ao Banco de Dados
procedure TForm1.Button1Click(Sender: TObject);
begin
  Table1.Close;
  Table1.Exclusive := True;
  Table1.Open;
  AddMasterPassword(Table1,Edit1.Text);
  Table1.Close;
  Table1.Exclusive := False;
  Table1.Open;
end;

// Remove a senha ao Banco de Dados
procedure TForm1.Button2Click(Sender: TObject);
begin
  Table1.Close;
  Table1.Exclusive := True;
  Table1.Open;
  RemoveMasterPassword(Table1);
  Table1.Close;
  Table1.Exclusive := False;
  Table1.Open;
end;

// Esta função adiciona a senha ao banco de dados

procedure AddMasterPassword(Table: TTable; pswd: string);
const RESTRUCTURE_TRUE = WordBool(1);
var TblDesc: CRTblDesc;
   hDb: hDBIDb;
begin
  if not Table.Active or not Table.Exclusive then
     raise EDatabaseError.Create(‘Table must be opened in exclusive ‘ +
        ‘mode to add passwords’);
  FillChar(TblDesc, SizeOf(CRTblDesc), #0);
  with TblDesc do
  begin
    StrPCopy(szTblName, Table.TableName);
    StrCopy(szTblType, szPARADOX);
    StrPCopy(szPassword, pswd);
    bProtected := RESTRUCTURE_TRUE;
  end;

  Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
  Table.Close;
  Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
  Session.AddPassword(pswd);
  Table.Open;
end;

// Esta função remove a senha ao banco de dados
procedure RemoveMasterPassword(Table: TTable);
const RESTRUCTURE_FALSE = WordBool(0);
var TblDesc: CRTblDesc;
    hDb: hDBIDb;
begin
  if (Table.Active = False) or (Table.Exclusive = False) then
     raise EDatabaseError.Create(‘Table must be opened in exclusive mode to       add passwords’);
  FillChar(TblDesc, SizeOf(CRTblDesc), 0);
  with TblDesc do
  begin
    StrPCopy(szTblName, Table.TableName);
    StrCopy(szTblType, szPARADOX);
    bProtected := RESTRUCTURE_FALSE;
  end;
  Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
  Table.Close;
  Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, FALSE));
  Table.Open;
end;
end.

Topo

Topo

Crie um arquivo Paradox com a seguinte estrutura:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBTables, ExtCtrls, MPlayer, DBCtrls, Grids, DBGrids;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Panel1: TPanel;
OpenDialog1: TOpenDialog;
Table1Codigo: TAutoIncField;
Table1Nome: TStringField;
Table1Avi: TBlobField;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var Form1: TForm1;
  FileName : string;
  MediaPlayer1 : TMediaPlayer;

implementation

{$R *.DFM}

{Esta função cria um arquivo temporário para o sistema}

function GetTemporaryFileName : string;
  {$IFNDEF WIN32}
  const MAX_PATH = 144;
  {$ENDIF}
var
  {$IFDEF WIN32}
  lpPathBuffer : PChar;
  {$ENDIF}
  lpbuffer : PChar;
begin
  {Get the file name buffer}
  GetMem(lpBuffer, MAX_PATH);
  {$IFDEF WIN32}
  {Get the temp path buffer}
  GetMem(lpPathBuffer, MAX_PATH); {Get the temp path}
  GetTempPath(MAX_PATH, lpPathBuffer); {Get the temp file name}
  GetTempFileName(lpPathBuffer,’tmp’,0,lpBuffer);
  FreeMem(lpPathBuffer, MAX_PATH);
  {$ELSE} {Get the temp file name}
  GetTempFileName(GetTempDrive(‘C’),’tmp’,0,lpBuffer);
  {$ENDIF} {Create a pascal string containg}
  {the temp file name and return it}
  result := StrPas(lpBuffer);
  {Free the file name buffer}
  FreeMem(lpBuffer, MAX_PATH);
end;

{Grava AVI ou Wav no arquivo PARADOX}

procedure TForm1.Button1Click(Sender: TObject);
var FileStream: TFileStream; {para ler o arquivo avi}
    BlobStream: TBlobStream; {para salvar no campo blob}
begin
  Application.ProcessMessages;
  Button1.Enabled := false;
  Button2.Enabled := false;

  if OpenDialog1.Execute then
     FileStream := TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
  Table1.Append;
  Table1Nome.Value := OpenDialog1.FileName;
  BlobStream := TBlobStream.Create(Table1AVI, bmReadWrite);
  BlobStream.Seek(0, soFromBeginning);
  BlobStream.Truncate;
  BlobStream.CopyFrom(FileStream, FileStream.Size);
  FileStream.Free;
  BlobStream.Free;
  Table1.Post;
  Button1.Enabled := true;
  Button2.Enabled := true;
end;

{Reproduz o que está gravado no campo Blob}

procedure TForm1.Button2Click(Sender: TObject);
var FileStream: TFileStream; {a temp file}
    BlobStream: TBlobStream; {the AVI Blob}
begin
  BlobStream := TBlobStream.Create(Table1AVI, bmRead);
  if BlobStream.Size = 0 then
     begin
       BlobStream.Free;
       Exit;
     end;
  MediaPlayer1.Close; {Reset the file name}
  MediaPlayer1.FileName := ‘’; {Refresh the play window}
  MediaPlayer1.Display := Panel1;
  Panel1.Refresh;
  if FileName <> ‘’ then
     DeleteFile(FileName); {Get a temp file name}
  FileName := GetTemporaryFileName; {Create a temp file stream}
  FileStream := TFileStream.Create(FileName,fmCreate or fmOpenWrite);
  FileStream.CopyFrom(BlobStream, BlobStream.Size); {Free the streams}
  FileStream.Free; BlobStream.Free;
  MediaPlayer1.FileName := filename;
  MediaPlayer1.DeviceType := dtAviVideo;
  MediaPlayer1.Open;
  MediaPlayer1.Play;
end;

// Evento OnDestroy do Form

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MediaPlayer1.Close;
  MediaPlayer1.FileName := ‘’;
  if FileName <> ‘’ then
    DeleteFile(FileName);
end;

// Evento OnShow do Form
procedure TForm1.FormShow(Sender: TObject);
begin
  MediaPlayer1 := TMediaPlayer.Create(self);
  with MediaPlayer1 do
    begin
      Parent := self ;
      Visible := False;
    end;
  Table1.Open;
end;

// Evento OnClose do Form
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Table1.Close;
end;

end.

Topo

Topo

Topo

Se você usa o campo autoincrement com parte da chave primária 
(a razão mais comun de se usar esse tipo de campo), e, se você usar 
esse campo autoincrement como chave estrangeira de outra tabela, você 
pode ter problemas! Se a tabela com autoincrement for recronstruída 
(REBUILD), por qualquer motivo, ela criará uma nova contagem. Isso 
causará perda de relacionamento com outra tabela! Por essa razão, você 
deve manter uma contagem manual de numero seqüêncial para fazer parte 
de uma chave primária. Isso tira o maior benefício do campo auto-
increment fazendo com que ele perca seu maior uso prático.

Topo

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;

Topo

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,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,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.

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

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;

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Topo

Obs.: Não é necessário compilar a biblioteca pois as mensagens serão atualizadas conforme forem recompilados os projetos gerados no Delphi 3.

Topo

Topo

Topo

Topo

Topo

Topo

e para carregar a figura use:

Botao.Glyph.LoadFromResourceName(HInstance, 'Nome do BitMap');

Topo

Topo

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = Chr(13)) Then
     Begin
       Perform(wm_NextDlgCtl,0,0);
       Key := #0;
     End;
end;

Topo

Topo

// e quando apertar o botao imprimir, o evento pega qual a impressora
// que você escolheu atravéz do ComboBox e Imprimi.
procedure TForm1.btImprimirClick(Sender: TObject);
var I:Integer;
    Arquivo : TextFile;
begin
  AssignFile(Arquivo,ComboBox1.Value);
  Rewrite(Arquivo);
  WriteLn(Arquivo, 'TESTE DE IMPRESSAO - 1'); 
  WriteLn(Arquivo, 'TESTE DE IMPRESSAO - 2'); 
  WriteLn(Arquivo, 'TESTE DE IMPRESSAO - 3'); 
  WriteLn(Arquivo, 'TESTE DE IMPRESSAO - 4'); 
  CloseFile(Arquivo);
end;

Topo

Topo

O BDE precisa de pelo menos um Driver de Banco de Dados para funcionar.
Pegue o programa p_registro.zip para registrar
este disco no Registro do Windows

Topo