main_unit.pas

这是我照着书做的一个销售管理系统,内容不难,很简单,但是对于我这个菜鸟来说已经很不错了

unit main_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ToolWin, ComCtrls, ExtCtrls, ImgList, DB, DBTables,inifiles,
  ADODB;

type
  TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    N17: TMenuItem;
    N33: TMenuItem;
    N20: TMenuItem;
    N23: TMenuItem;
    N32: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N24: TMenuItem;
    ImageList1: TImageList;
    ToolButton9: TToolButton;
    N25: TMenuItem;
    ADOConnection1: TADOConnection;
    QryTool: TADOQuery;
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N14Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
     SysIni:TIniFile;
    { Private declarations }
  public
     procedure AddListView(TVarArray: array of string; VarCount: integer;var Lv: TListView);
     function  CheckExistCount(FieldName, FieldValue,TableName: string): integer;
     procedure RefeshOne(TVarArray: array of string; VarCount: integer;var Lv: TListView);
     procedure AddData(var Lv: TListView; var Query: TAdoQuery);
     Procedure InsStr(Var Sql:string;Value1:string);overload;//SQL 生成
     Procedure InsStr(Var Sql:string;Value1,Value2:string);overload;
     Procedure InsStr(Var Sql:string;Value1:integer;Value2:string);overload;
     Procedure InsStr(Var Sql:string;Value1:real;Value2:string);overload;

     Procedure UpStr(Var Sql:string;Value:string);overload;
     Procedure UpStr(Var Sql:string;Value,Value1,Value2:string);overload;
     Procedure UpStr(Var Sql:string;Value:string;value1:integer;Value2:string);overload;
     Procedure UpStr(Var Sql:string;Value:string;value1:real;Value2:string);overload;
     function  ExecSQL(SQLstring: string): Boolean;
     function  FullStrYh(Str: String): String;
     function RecordCount(Query: TAdoQuery): integer;
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses khzl_unit, gyshzl_unit, spfl_unit, spzl_unit, dw_unit, sfkfs_unit,
  jh_unit, jhth_unit, xsh_unit, khth_unit, yg_unit, jh_find_unit, dhjm_unit,
  jh_th_unit, xtcsh_unit, UserSet_Unit, jbzl_print_unit, kc_unit, fx_unit,
  xshd_find_unit, Login_Unit,data_unit;

{$R *.dfm}
function TFrmMain.FullStrYh(Str: String): String;
var
  I:integer;
  Stemp:String;
  SValue1:String;
  Value1:String;
begin
  SValue1:='';
  Value1:=str;
  i:=pos('''',Value1);
  while i>0 do
    begin
      Stemp:=copy(Value1,1,i-1);
      SValue1:=SValue1+Stemp+'''''';
      Delete(value1,1,i);
      i:=pos('''',Value1);
    end;
  SValue1:=SValue1+Value1;
  Value1:=SValue1;
  Result:=Value1;
end;

function TFrmMain.RecordCount(Query: TAdoQuery): integer;
var i:integer; TpQuery:TAdoQuery;
begin
  QryTool.Close;
  QryTool.SQL.Text:=Query.SQL.Text;
  QryTool.Open;
  QryTool.First;
  i:=0;
  While QryTool.Eof=false do
  begin
    i:=i+1;
    QryTool.Next;
  end;
  Result:=i;
  QryTool.Close;
end;


procedure TFrmMain.InsStr(var Sql: string; Value1, Value2: string);
begin
 Value1:=FullStrYh(Value1);
 if Uppercase(value1)='NULL' then
     Sql:=Sql+' NULL'+Value2
  else
    Sql:=Sql+''''+Value1+''''+Value2;
  if Value2='' then Sql:=Sql+')';
end;

procedure TFrmMain.InsStr(var Sql: string; Value1: integer; Value2: string);
begin
    Sql:=Sql+' '+IntTostr(Value1)+' '+Value2;
    if Value2='' then Sql:=Sql+')';
end;
procedure TFrmMain.InsStr(var Sql: string; Value1: real; Value2: string);
begin
    Sql:=Sql+' '+floatTostr(Value1)+' '+Value2;
    if Value2='' then Sql:=Sql+')';
end;
procedure TFrmMain.InsStr(var Sql: string; Value1: string);
begin
  if Sql='' then Sql:=Sql+'Insert Into '+Value1+' Values ( '
  else Sql:=Sql+' '+Value1;

end;

procedure TFrmMain.UpStr(var Sql: string; Value, Value1, Value2: string);
begin
  Value1:=FullStrYh(Value1);
  if (Value2='') or (Value2=',') then
    begin
      if uppercase(value1)='NULL' then
        Sql:=Sql+' '+Value+' =null'+Value2
      else
        Sql:=Sql+' '+Value+' ='''+Value1+''' '+Value2
    end
  else
    if Value2='w' then Sql:=Sql+' Where '+Value+''''+value1+''''
    else Sql:=Sql+' '+Value2+' '+Value+''''+value1+'''';
end;


procedure TFrmMain.UpStr(var Sql: string; Value: string);
begin
  if Length(Sql)=0 then Sql:='Update '+Value+' Set'
  else Sql:=Sql+' '+Value;
end;

procedure TFrmMain.UpStr(var Sql: string; Value: string; value1: integer;
  Value2: string);
begin
  if (Value2='') or (Value2=',') then Sql:=Sql+' '+Value+' = '+intTostr(value1)+' '+Value2
  else
    if Value2='w' then Sql:=Sql+' Where '+Value+IntTostr(value1)
    else Sql:=Sql+' '+Value2+' '+Value+IntTOstr(value1);
end;

procedure TFrmMain.UpStr(var Sql: string; Value: string; value1: real;
  Value2: string);
begin
  if (Value2='') or (Value2=',') then Sql:=Sql+' '+Value+' = '+floatTostr(value1)+' '+Value2
  else
    if Value2='w' then Sql:=Sql+' Where '+Value+floatTostr(value1)
    else Sql:=Sql+' '+Value2+' '+Value+floatTOstr(value1);
end;

function TFrmMain.ExecSQL(SQLstring: string): Boolean;
begin
  try
    QryTool.SQL.Text := SQLstring;
    QryTool.SQL.SaveToFile('C:\ErrQuery.txt');
    QryTool.ExecSQL;
    Result := True;
  except
    Result := False;
    raise;
  end;

end;


procedure  TFrmMain.AddListView(TVarArray: array of string; VarCount: integer;
  var Lv: TListView);
Var
   MyItems:TlistItem;
   i:integer;
begin
   myitems:=lv.Items.Add;
   myitems.Caption :=Tvararray[0];
   for i:=1 to varcount do
     begin
        myitems.SubItems.Add(tvararray[i]);
     end;
   myitems.Selected :=true;
   myitems.MakeVisible(true);
end;

function TFrmMain.CheckExistCount(FieldName, FieldValue,
  TableName: string): integer;
begin
  with QryTool do
  begin
    If Active then close;
    sql.text := 'select ' + FieldName + ' from ' + tablename + ' where ' +
      fieldname + '=''' + fieldvalue + '''';
    open;
  end;

  Result := QryTool.RecordCount;
end;



procedure TFrmMain.RefeshOne(TVarArray: array of string; VarCount: integer;
  var Lv: TListView);
Var
   i:integer;
begin
   LV.Selected.caption:=tvararray[0];
   for i:=1 to varcount do
     begin
        lv.Selected.SubItems.Strings[i-1]:=TvarArray[i];
     end;
end;

procedure TFrmMain.AddData(var Lv: TListView; var Query: TAdoQuery);
var QueryCount:integer; Counter:integer; LItem: TListItem; FieldCount:integer; FieldCounter:integer;
begin
  if Query.Active then
  begin
    QueryCount:=RecordCount(Query);
    Query.First;
    FieldCount:=Query.FieldCount;
    if FieldCount=1 then
    begin
      for Counter:=1 to QueryCount do
      begin
        LItem:=LV.Items.Add;
        LITem.Caption:=Query.Fields[0].asstring;
        litem.Update;
        Query.Next;
      end;
    end
    else
    begin
      for Counter:=1 to QueryCount do
      begin
        LItem:=LV.Items.Add;
        LITem.Caption:=Query.Fields[0].asstring;
        for FieldCounter:=1 to FieldCount-1 do
        begin
          LITem.SubItems.Add(Query.Fields[FieldCounter].asstring);
        end;
        litem.Update;
        Query.Next;
      end;
    end;
  end;
end;

procedure TFrmMain.N7Click(Sender: TObject);
begin
if application.MessageBox('确实要退出吗?','退出',4)=6 then
application.Terminate;
end;

procedure TFrmMain.N8Click(Sender: TObject);
begin
khzl_form:=Tkhzl_form.Create(application);
khzl_form.Show;
end;

procedure TFrmMain.N10Click(Sender: TObject);
begin
gyshzl_form:=Tgyshzl_form.Create(application);
gyshzl_form.Show;
end;

procedure TFrmMain.N12Click(Sender: TObject);
begin
spfl_form:=Tspfl_form.create(application);
spfl_form.show;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if application.MessageBox('确实要退出吗?','退出',4)=6 then
application.Terminate;

end;

procedure TFrmMain.N14Click(Sender: TObject);
begin
spzl_form:=Tspzl_form.create(application);
spzl_form.show;
end;

procedure TFrmMain.N13Click(Sender: TObject);
begin
dw_form:=Tdw_form.create(application);
dw_form.show;
end;

procedure TFrmMain.N16Click(Sender: TObject);
begin
sfkfs_form:=Tsfkfs_form.create(application);
sfkfs_form.show;

end;

procedure TFrmMain.N18Click(Sender: TObject);
begin
jh_form:=Tjh_form.create(application);
jh_form.show;

end;

procedure TFrmMain.N19Click(Sender: TObject);
begin
jh_th_form:=Tjh_th_form.Create(application);
jh_th_form.Show ;

end;

procedure TFrmMain.N21Click(Sender: TObject);
begin
xsh_form:=Txsh_form.create(application);
xsh_form.show;

end;

procedure TFrmMain.N22Click(Sender: TObject);
begin
khth_form:=Tkhth_form.Create(application);
khth_form.Show ;

end;

procedure TFrmMain.N9Click(Sender: TObject);
begin
yg_form:=Tyg_form.create(application);
yg_form.show;
end;

procedure TFrmMain.N17Click(Sender: TObject);
begin
jh_find_form:=Tjh_find_form.create(application);
jh_find_form.show;
end;

procedure TFrmMain.ToolButton8Click(Sender: TObject);
begin
if application.MessageBox('确实要退出吗?','退出',4)=6 then
application.Terminate;

end;

procedure TFrmMain.ToolButton9Click(Sender: TObject);
begin
dhjm_form:=Tdhjm_form.create(application);
dhjm_form.show;
end;

procedure TFrmMain.N20Click(Sender: TObject);
begin
xtcsh_form:=Txtcsh_form.create(application);
xtcsh_form.show;
end;

procedure TFrmMain.N25Click(Sender: TObject);
begin
userset_form:=Tuserset_form.create(application);
userset_form.show;
end;

procedure TFrmMain.N23Click(Sender: TObject);
begin
jbzl_print_form:=Tjbzl_print_form.create(application);
jbzl_print_form.show;
end;

procedure TFrmMain.N24Click(Sender: TObject);
begin
kc_form:=Tkc_form.create(application);
kc_form.show;

end;

procedure TFrmMain.ToolButton6Click(Sender: TObject);
begin
fx_form:=Tfx_form.create(application);
fx_form.show;

end;

procedure TFrmMain.N33Click(Sender: TObject);
begin
xshd_find_form:=Txshd_find_form.create(application);
xshd_find_form.show;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  AdoConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+extractfilepath(application.exename)+'mdb\jxc.mdb;Persist Security Info=False';
end;

end.