main.pas

基于OOP设计的一套较好的ERP系统

unit main;

interface

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

type
  TMain_form = class(TForm)
    etiDb: TTable;
    etiDbProgressivo: TAutoIncField;
    etiDbArticolointerno: TStringField;
    etiDbArticolofornitore: TStringField;
    etiDbArticoloetichetta: TStringField;
    etiDbDescrizione: TStringField;
    etiDbPrezzoL: TCurrencyField;
    etiDbPrezzoE: TCurrencyField;
    etiDbPunti: TFloatField;
    etiDbDescrizione2: TStringField;
    Porta: TComPort;
    GroupBox2: TGroupBox;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label31: TLabel;
    DBComboBox1: TDBComboBox;
    DBComboBox2: TDBComboBox;
    DBComboBox3: TDBComboBox;
    DBComboBox4: TDBComboBox;
    DBComboBox5: TDBComboBox;
    dsEti: TDataSource;
    configDb: TTable;
    configDbParita: TStringField;
    configDbDatabits: TStringField;
    configDbStopbits: TStringField;
    configDbComandi: TMemoField;
    dsConfig: TDataSource;
    memocomandi: TDBMemo;
    Label1: TLabel;
    DBGrid1: TDBGrid;
    Prova: TButton;
    BitBtn1: TBitBtn;
    configDbPorta: TStringField;
    configDbBaudrate: TStringField;
    configDbImpostazioni: TMemoField;
    Label2: TLabel;
    memoimpostazioni: TDBMemo;
    quante: TRxSpinEdit;
    Label3: TLabel;
    TTSoggetti: TTable;
    TTArticoli: TTable;
    TTArtBase: TTable;
    PopupMenu1: TPopupMenu;
    Ritardoinmillisecondi1: TMenuItem;
    ProgressivoP1: TMenuItem;
    ArticoloInternoA1: TMenuItem;
    ArticoloFornitoreF1: TMenuItem;
    ArticoloetichettaBarcodeB1: TMenuItem;
    DescrizioneD1: TMenuItem;
    LireL1: TMenuItem;
    EuroE1: TMenuItem;
    Lireformattatol1: TMenuItem;
    Euroformattatoe1: TMenuItem;
    PunteggioP1: TMenuItem;
    Descrizione2FornitoredatanumerodocumentoN1: TMenuItem;
    FornitoreRagionesocialeS1: TMenuItem;
    FornitoreRagionesocialeS2: TMenuItem;
    configDbCTS: TBooleanField;
    configDbRTS: TBooleanField;
    configDbWAIT: TBooleanField;
    DBCheckBox1: TDBCheckBox;
    DBCheckBox2: TDBCheckBox;
    DBCheckBox3: TDBCheckBox;
    StatusBar: TStatusBar;
    DBNavigator1: TDBNavigator;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ProvaClick(Sender: TObject);
    procedure Ritardoinmillisecondi1Click(Sender: TObject);
    procedure ProgressivoP1Click(Sender: TObject);
    procedure ArticoloInternoA1Click(Sender: TObject);
    procedure ArticoloFornitoreF1Click(Sender: TObject);
    procedure ArticoloetichettaBarcodeB1Click(Sender: TObject);
    procedure DescrizioneD1Click(Sender: TObject);
    procedure LireL1Click(Sender: TObject);
    procedure EuroE1Click(Sender: TObject);
    procedure Lireformattatol1Click(Sender: TObject);
    procedure Euroformattatoe1Click(Sender: TObject);
    procedure PunteggioP1Click(Sender: TObject);
    procedure Descrizione2FornitoredatanumerodocumentoN1Click(
      Sender: TObject);
    procedure FornitoreRagionesocialeS1Click(Sender: TObject);
    procedure FornitoreRagionesocialeS2Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure Stampa(ee:integer);
    function ProcessaRiga(riga: string): string;
    procedure Invia(riga: string);
    procedure ScriviParallela(riga: string);
    procedure InviaParallela(riga: String);
    { Public declarations }
  end;

var
  Main_form: TMain_form;
  NomePorta: string;
  Portafile: textfile;

implementation

uses nomefile;

{$R *.DFM}

procedure TMain_form.FormCreate(Sender: TObject);
begin
  if configDb.IsEmpty then configDb.Insert ;
  
end;

procedure TMain_form.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if (configDb.State = dsEdit) or
    (configDb.State = dsInsert) then
    begin
     If MessageDlg('Salvare le modifiche ?',mtConfirmation,[mbYes,mbNo],0) = mrYes then
      configDb.Post
     else
      configDb.Cancel ;
    end ;
end;

procedure TMain_form.Stampa(ee:integer) ;
Var
  i, n: integer ;
  PortDb : String ;

    Function Parity(SParity:string): TParity ;
     begin
       //(paDefault, paNone, paOdd, paEven, paMark, paSpace);
      if SParity = 'Default' then result :=paDefault ;
      if SParity = 'None' then result :=paNone ;
      if SParity = 'Odd' then result :=paOdd ;
      if SParity = 'Even' then result :=paEven ;
      if SParity = 'Mark' then result :=paMark ;
      if SParity = 'Space' then result :=paSpace ;
     end ;

    Function DataBits(SDataBit:string): TdataBits ;
     begin
      if SDataBit = 'Default' then result := dbDefault ;
      if SDataBit = '4' then result := db4 ;
      if SDataBit = '5' then result := db5 ;
      if SDataBit = '6' then result := db6 ;
      if SDataBit = '7' then result := db7 ;
      if SDataBit = '8' then result := db8 ;
     end ;

    Function StopBits(SStopBit:string): TStopBits ;
     begin
      if SStopBit = 'Default' then result := sbDefault ;
      if SStopBit = '1' then result := sb1 ;
      if SStopBit = '1_5' then result := sb1_5 ;
      if SStopBit = '2' then result := sb2 ;
     end ;

    Function Baud(baudS:string) :TBaudRate ;
     begin
      if Bauds = 'Default' then result := brDefault ;
      if Bauds = '110' then result := br110 ;
      if Bauds = '300' then result := br300 ;
      if Bauds = '600' then result := br600 ;
      if Bauds = '1200' then result := br1200 ;
      if Bauds = '2400' then result := br2400 ;
      if Bauds = '4800' then result := br4800 ;
      if Bauds = '9600' then result := br9600 ;
      if Bauds = '10400' then result := br10400 ;
      if Bauds = '14400' then result := br14400 ;
      if Bauds = '19200' then result := br19200 ;
      if Bauds = '28800' then result := br28800 ;
      if Bauds = '38400' then result := br38400 ;
      if Bauds = '56000' then result := br56000 ;
      if Bauds = '57600' then result := br57600 ;
      if Bauds = '115200' then result := br115200 ;
      if Bauds = '128000' then result := br128000 ;
      if Bauds = '256000' then result := br256000 ;
     end ;

begin
 PortDb := configDbPorta.asString ;
 If PortDb[1] = 'C' then
  begin
     Try
      Porta.DeviceName := PortDb ;
      Porta.BaudRate := Baud(configDbBaudRate.AsString) ;
      Porta.DataBits := DataBits(configDbDataBits.asString) ;
      Porta.StopBits := Stopbits(configDbStopBits.asString) ;
      Porta.Parity := Parity(configDbParita.asString) ;
      If ConfigDbCTS.asBoolean and
         ConfigDbRTS.asBoolean then
         Porta.Options := [opOutputCTSFlow,opOutputDSRFlow] ;
      If not ConfigDbCTS.asBoolean and
         ConfigDbRTS.asBoolean then
         Porta.Options := [opOutputDSRFlow] ;
      If ConfigDbCTS.asBoolean and
         not ConfigDbRTS.asBoolean then
         Porta.Options := [opOutputCTSFlow] ;
      If not ConfigDbCTS.asBoolean and
         not ConfigDbRTS.asBoolean then
         Porta.Options := [] ;
      Porta.Open ;
     except
      ShowMessage('Problemi di gestione della porta') ;
      raise ;
      exit ;
     end ;
     for i := 0 to memoimpostazioni.Lines.Count -1 do
      Porta.WriteString(Processariga(memoimpostazioni.lines[i])) ;
     etiDb.First ;
     n := 0 ;
     While (not EtiDb.Eof) and ((n < ee) or (ee = 0)) do
      begin
       for i := 0 to memocomandi.lines.Count -1 do
         Invia(ProcessaRiga(memocomandi.lines[i])) ;
       inc(n) ;
       etiDb.Next ;
       for i := 0 to memoimpostazioni.Lines.Count -1 do
        Porta.WriteString(Processariga(memoimpostazioni.lines[i])) ;
      end ;
     Porta.Close ;
  end
 else
  begin
   Try
     If PortDb = 'LPT1' then
       NomePorta := 'LPT1:' ;
     If PortDb = 'LPT2' then
       NomePorta := 'LPT2:' ;
     If PortDB = '(FILE)' then
      begin
       nome_file.showmodal ;
       nome_file.close ;
       if nome_file.modalresult = mrcancel then exit ;
       NomePorta := nome_file.nome_file_edit.text ;
      end ;
     AssignFile(PortaFile,NomePorta) ;
     Rewrite(PortaFile) ;
     for i := 0 to memoimpostazioni.Lines.Count -1 do
       ScriviParallela(Processariga(memoimpostazioni.lines[i])) ;
     etiDb.First ;
     n := 0 ;
     While (not EtiDb.Eof) and ((n < ee) or (ee = 0)) do
      begin
       for i := 0 to memocomandi.lines.Count -1 do
         InviaParallela(ProcessaRiga(memocomandi.lines[i])) ;
       inc(n) ;
       etiDb.Next ;
       for i := 0 to memoimpostazioni.Lines.Count -1 do
        ScriviParallela(Processariga(memoimpostazioni.lines[i])) ;
      end ;
     CloseFile(PortaFile) ;
   except
    ShowMessage('Problemi sulla parallela !');
   end ;
  end ;
end;

function TMain_form.ProcessaRiga(riga: string): string;
Var
 RigaOut : string ;
 i : integer ;
 Rit : String ;
 Code : integer ;
 OraIniziale,OraFinale : TTime ;
 HourI, MinI, SecI, MSecI: Word;
 HourF, MinF, SecF, MSecF: Word;
 MilliSecondi,MilliSecF,MilliSecI : Longint ;
 Passato : boolean ;

begin
 (*
  Rxxxx = Ritardo in xxxx millisecondi
  p = Progressivo
  A = Articolo interno
  F = Articolo fornitore
  B = Articolo etichetta codice a barre
  D = Descrizione
  L = Lire
  E = Euro
  l = lire formattato
  e = euro formattato
  P = Punti
  N = Descrizione 2
  S = Ragione Sociale Fornitore (Intera)
  s = Ragione Sociale Fornitore (primi 7 caratteri)
  *)
 RigaOut := '' ;
 i := 1 ;
 While i <= Length(riga) do
  begin
   If Riga[i] = '.' then
    begin
     Inc(i) ;
     If Riga[i] = 'p' then
      RigaOut := rigaOut + etiDbProgressivo.AsString ;
     If Riga[i] = 'A' then
      RigaOut := rigaOut + etiDbArticoloInterno.AsString ;
     If Riga[i] = 'F' then
      RigaOut := rigaOut + etiDbArticoloFornitore.AsString ;
     If Riga[i] = 'B' then
      RigaOut := rigaOut + etiDbArticoloEtichetta.AsString ;
     If Riga[i] = 'D' then
      RigaOut := rigaOut + etiDbDescrizione.AsString ;
     If Riga[i] = '.' then
      RigaOut := RigaOut + '.' ;
     If Riga[i] = 'L' then
      RigaOut := rigaOut + etiDbPrezzoL.AsString ;
     If Riga[i] = 'l' then
      RigaOut := rigaOut + FormatFloat('#,###',etiDbPrezzoL.AsFloat) ;
     If Riga[i] = 'E' then
      RigaOut := rigaOut + etiDbPrezzoE.AsString ;
     If Riga[i] = 'e' then
      RigaOut := rigaOut + FormatFloat('#,##0.00',etiDbPrezzoE.AsFloat) ;
     If Riga[i] = 'P' then
      RigaOut := rigaOut + etiDbPunti.AsString ;
     If Riga[i] = 'N' then
      rigaOut := rigaOut + etiDbDescrizione2.AsString ;
     If Riga[i] = 's' then
      begin
       If TTArtBase.FindKey([etidbArticoloEtichetta.asString]) then
        if TTArticoli.FindKey([TTArtbase.FieldbyName('Articolo interno').asString]) then
         if TTSoggetti.Findkey([TTArticoli.FieldByName('Fornitore').asString]) then
          rigaOut := rigaOut + Copy(TTSoggetti.FieldByName('Ragione Sociale').asString,1,7)
      end ;
     If Riga[i] = 'R' then
      begin
       rit := Riga[i+1] + Riga[i+2] + Riga[i+3] + Riga[i+4] ;
       inc(i,4) ;
       Val(Rit,MilliSecondi,code) ;
       OraIniziale := Time ;
       DecodeTime(OraIniziale,HourI,MinI,SecI,MsecI) ;
       MillisecI := (HourI * 3600) + (MinI * 60) + (SecI * 1000) + MsecI;
       Passato := false ;
       While Not passato do
        begin
         OraFinale := Time ;
         DecodeTime(OraFinale,HourF,MinF,SecF,MsecF) ;
         MilliSecF := (HourF * 3600) + (MinF * 60) + (SecF*1000) + MsecF ;
         Passato := (MilliSecF-MilliSecI) > MilliSecondi ;
        end;
      end ;
     If Riga[i] = '#' then
      begin
       If Riga[i + 1] <> '#' then
        begin
         RigaOut := rigaOut + Chr(StrToInt(Riga[i+1] + Riga[i+2])) ;
         Inc(i,2) ;
        end
       else
        RigaOut := RigaOut + '#' ;
      end ;
    end
   else
    RigaOut := RigaOut + Riga[i] ;
   Inc(i) ;
  end ;
 Result := RigaOut ;
end;

procedure TMain_form.Invia(riga: string);
begin
 if ConfigDbWait.AsBoolean then
    While Porta.WritePending do StatusBar.SimpleText := 'Attesa...' ;
 StatusBar.SimpleText := 'Scrittura: ' + riga ;
 Porta.WriteString(riga+#13+#10) ;
end;

procedure TMain_form.ProvaClick(Sender: TObject);
var
   eee : integer ;
begin
 eee := trunc(quante.Value) ;
 Stampa(eee) ;
end;

procedure TMain_form.ScriviParallela(riga: string);
begin
 StatusBar.SimpleText := 'Scrittura: ' + riga ;
 Write(PortaFile,riga) ;
end;

procedure TMain_form.InviaParallela(riga: String);
begin
 ScriviParallela(riga+#13+#10) ;
end;

procedure TMain_form.Ritardoinmillisecondi1Click(Sender: TObject);
begin
 memocomandi.SelText := '.Rxxx' ;
end;

procedure TMain_form.ProgressivoP1Click(Sender: TObject);
begin
 memocomandi.SelText := '.p' ;
end;

procedure TMain_form.ArticoloInternoA1Click(Sender: TObject);
begin
 memocomandi.SelText := '.A' ;
end;

procedure TMain_form.ArticoloFornitoreF1Click(Sender: TObject);
begin
 memocomandi.SelText := '.F' ;
end;

procedure TMain_form.ArticoloetichettaBarcodeB1Click(Sender: TObject);
begin
 memocomandi.SelText := '.B' ;
end;

procedure TMain_form.DescrizioneD1Click(Sender: TObject);
begin
 memocomandi.SelText := '.D' ;
end;

procedure TMain_form.LireL1Click(Sender: TObject);
begin
 memocomandi.SelText := '.L' ;
end;

procedure TMain_form.EuroE1Click(Sender: TObject);
begin
 memocomandi.SelText := '.E' ;
end;

procedure TMain_form.Lireformattatol1Click(Sender: TObject);
begin
 memocomandi.SelText := '.l' ;
end;

procedure TMain_form.Euroformattatoe1Click(Sender: TObject);
begin
 memocomandi.SelText := '.e' ;
end;

procedure TMain_form.PunteggioP1Click(Sender: TObject);
begin
 memocomandi.SelText := '.P' ;
end;

procedure TMain_form.Descrizione2FornitoredatanumerodocumentoN1Click(
  Sender: TObject);
begin
 memocomandi.SelText := '.N';
end;

procedure TMain_form.FornitoreRagionesocialeS1Click(Sender: TObject);
begin
 memocomandi.SelText := '.s' ;
end;

procedure TMain_form.FornitoreRagionesocialeS2Click(Sender: TObject);
begin
 memocomandi.SelText := '.S' ;
end;

end.