frm_main.~pas

站长您好

unit Frm_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, XPMenu, ImgList, Menus, ppBands, ppCache,
  ppClass, ppProd, ppReport, ppEndUsr, ppComm, ppRelatv, ppDB, ppDBPipe,
  DB, ADODB, Registry, QStdCtrls, ExcelXP, OleServer, StdCtrls, ActiveX, ComObj,
    AdvGrid,
  Buttons, EnterAsTab;
const
  AirCargoPath = '\Software\Cargo\AirCargo';
  RootKey = HKEY_LOCAL_MACHINE;

type
  TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    B1: TMenuItem;
    N2: TMenuItem;
    N23: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N22: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    N16: TMenuItem;
    N15: TMenuItem;
    bi: TMenuItem;
    N18: TMenuItem;
    N17: TMenuItem;
    N20: TMenuItem;
    Relogin: TMenuItem;
    ChangePass: TMenuItem;
    TTTT1: TMenuItem;
    SystemSet: TMenuItem;
    T1: TMenuItem;
    SQL1: TMenuItem;
    N1: TMenuItem;
    Window1: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowTileItem2: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    TTTT2: TMenuItem;
    CloseAll: TMenuItem;
    Help1: TMenuItem;
    HelpAboutItem: TMenuItem;
    Help: TMenuItem;
    TTTT3: TMenuItem;
    btnexit: TMenuItem;
    ImageList1: TImageList;
    XPMenu1: TXPMenu;
    ToolBar1: TToolBar;
    ToolButton22: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton21: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton5: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton2: TToolButton;
    ToolButton1: TToolButton;
    ToolButton7: TToolButton;
    N19: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    E1: TMenuItem;
    N28: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N38: TMenuItem;
    QryTemp: TADOQuery;
    UseDB: TADOConnection;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DataSource3: TDataSource;
    DataSource4: TDataSource;
    Query4: TADOQuery;
    Query3: TADOQuery;
    Query2: TADOQuery;
    Query1: TADOQuery;
    Data1: TppDBPipeline;
    Data2: TppDBPipeline;
    Data3: TppDBPipeline;
    Data4: TppDBPipeline;
    PpDesign: TppDesigner;
    ppReport1: TppReport;
    ppHeaderBand1: TppHeaderBand;
    ppDetailBand1: TppDetailBand;
    ppFooterBand1: TppFooterBand;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    N3: TMenuItem;
    N8: TMenuItem;
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure N28Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure N38Click(Sender: TObject);
  private
    { Private declarations }
  public
    LoginId: string; //登录ID号
    LoginName: string; //登录的用户名称 如Cherry
    LoginPass: string; //密码
    RightsString: string; //权限字符串
    RightsGrade: string;
    DateStart: string; //开始日期
    DataBaseType: string; //执行的数据库类型 是SqlServer 还是 Sql AnyWhere
    BackBmp: string;
    ViewStyle: Integer;
    ComBoBoxStr: string;
    ContextStr: string;

    {界面风格}
    BeXpView: Boolean;
    BeTBCaptionShow: Boolean;
    BeTBCaptionShowRight: Boolean;
    {报表默认路径}
    DefaultDirectory1, DefaultDirectory2: string;
    function ConnectServer(ODBC: string): Boolean; //连接服务器
    function DbConnect(ADOConnection: TADOConnection; Odbc, DbUsername,
      DbPassword: string): Boolean; //连接数据库
    function LoginDB(UserName, Pass: string): Boolean;
    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; //更新SQL语句生成
    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;
    procedure SelStr(var Sql: string; Value, value1: string); overload;
    //选择SQL语句生成
    procedure SelStr(var Sql: string; Value, value1, value2: string); overload;
    procedure SelStr(var Sql: string; Value: string; value1: integer; value2:
      string); overload;
    function FullStrYh(Str: string): string; //把单引号变为两个单引号
    function TestTextNumber(str: string; NumberType: string): Boolean;
    {检验一个字符串是否全是数字}
    function GetCode(Prefix: string): string; //得到自动编号
    procedure PrintListView(ListView: TListView); //打印
    procedure DelDbRecord(Lv: TListView; Table, KeyFields, LvColumnIndexs:
      string; LbCount: TLabel); //删除数据
    procedure AddData(var Lv: TListView; var Query: TAdoQuery);
    procedure SortLvData(var LV: TlistView; SortInt: Integer);
    procedure UseListCondition(Combobox: TCombobox; Table, Fields, CFields,
      OrderField, Condition: string);
    function Sql(Sql: string): string;
    //修改Sql语句(把Sql语句中的 1:去两头空格, 2:'->'')
    function RecordCount(Query: TAdoQuery): integer;
    //得到Query的记录条数,为解决当含有字段长度>255的字段时RecordCount(Query)=-1而制定的通用函数
    function DateToCode(DateStr: string): string;
    //日期格式转为日期代码格式(如: 2002-08-04到20020804)
    function GetStdDateStr(DateStr: string): string;
    //输入日期串输出标准格式日期串(yyyy-mm-dd)
    function IsObjectActive(className: string): boolean;
    //判断Excell.exe是否正在运行
    function SetComboBoxText(sstmp: string; com: Tcombobox): string;
    {得到描述_编辑时使用}
    function IncludeValue(Value: string): Boolean;
    function GetFieldText(CmbText: string; I: Integer = 1): string;
    function CheckComboBox(com: Tcombobox; ColCount: Integer = 2; BeCheck:
      Boolean = true): string; {检查合法性_form_exit}
    function ExecSQL(SQLstring: string): Boolean;
    function GetFieldName(TableName, FieldCName: string): string;
    //输入表名,中文字段名,得到字段名
    function GetFieldCName(TableName, FieldName: string): string;
    //输入表名,字段名得到中文字段名
    procedure Full_FilterCombobox(com: TComboBox; Query: string; zdcode, zdname:
      string); overload;
    procedure Full_FilterCombobox(com: TComboBox; Query: string; XSName:
      string);
      overload;
     procedure Full_FilterCombobox(com: TComboBox; Query: String; zdcode,
      zdname,zdother: string);overload;{填充ComBox_Form创建时使用}
    procedure AddColumn(var LV: TlistView; Name: string; Width: integer);
    {为GRID增加头}
    procedure RefeshOne(TVarArray: array of string; VarCount: integer; var Lv:
      TListView);
    procedure AddListView(TVarArray: array of string; VarCount: integer; var Lv:
      TListView);
    function CheckExistCount(FieldName, FieldValue, TableName: string): integer;
    function GetLastIdentify: Integer;
    procedure AddGridData(var Grid: TAdvStringGrid; QryStr: string; JgdgeCol:
      Integer = 0; IsAdd: Boolean = False);
    procedure DeleteGridRow(var Grid: TAdvStringGrid; ACol, ARow: Integer);
    function SetQuerySql(SqlStr: string; UserField: string; OperateDate:
      string): string;
    function GetSplitText(Str, Split: string; var StrArray: array of string):
      Integer;
    procedure full_ComboBox(com: TComboBox; tab: String; zdcode,
  zdname: string);
  function GetCustomerValue(CodeName,CodeValue,FieldName,TableName: String): Variant;
  function SetSearchStr(Str1, Str2: String): String;
    {其它公用方法}
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses Frm_LoginServer, Frm_login, Frm_List, Frm_Company,
  Frm_PlaneCompanyInfo, Frm_PortInfo, Frm_StationInfo, Frm_FareNameInfo,
  Frm_CurrencyInfo, Frm_CustomerInfo, Frm_BussinessMan, Frm_BaseData,
  Frm_FileNoGeneralRuleInfo, Frm_UserInfo, Frm_FileNoAssignUser,
  Frm_RightInfo, Frm_BussinessBillInfo, Frm_PlaneQuoteInfo,
  Frm_AllImportBillInfo, Frm_AllExportBillInfo, frm_goodsstat,
  Frm_MainFeeGrid, Frm_FareWh;

{$R *.dfm}

procedure TFrmMain.Full_FilterCombobox(com: TComboBox; Query, zdcode, zdname,
  zdother: string);
var
  zcrbh:string;
begin
  try
    QryTemp.close;
    with QryTemp do
       begin
          sql.text:=query;
          Open;
          first;
          com.Items.Clear;
          while (not eof) do
             begin
                zcrbh:=fieldbyname(zdcode).asstring+' & '+fieldbyname(zdname).asstring+' & '+fieldbyname(zdother).asstring;
                com.items.Add(zcrbh);
                next;
             end;
          Close;
      end;
   except
      if  QryTemp.Active then  QryTemp.close;
   end;
end;

procedure TFrmMain.full_ComboBox(com: TComboBox; tab: String; zdcode,
  zdname: string);
var
   zcrbh:string;
begin
  try
    with QryTemp do
       begin
          Open;
          first;
          com.Items.Clear;
          while (not eof) do
             begin
                zcrbh:=fieldbyname(zdcode).asstring+' & '+fieldbyname(zdname).asstring;
                com.items.Add(zcrbh);
                next;
             end;
          Close;
      end;
   except
     if QryTemp.Active then QryTemp.close;
   end;
end;

{拆分字符串}

function TFrmMain.GetSplitText(Str, Split: string;
  var StrArray: array of string): Integer;
var
  J, IPos: Integer;
  StrLen: integer;
begin

  J := 0;
  strlen := length(str);
  Ipos := pos(split, str);

  if ipos = 0 then
    strarray[0] := str
  else
  begin
    while ipos <> 0 do
    begin
      strarray[j] := COPY(str, 1, ipos - 1);
      j := j + 1;
      str := COPY(str, ipos + 1, strlen - ipos);
      strlen := length(str);
      Ipos := pos(split, str);
    end;
    strarray[j] := Str;
  end;
  J := J + 1;
  Result := J;
end;

procedure TFrmMain.DeleteGridRow(var Grid: TAdvStringGrid; ACol: Integer; ARow:
  Integer);
var
  I, J: Integer;
begin
  with Grid do
  begin
    if (ARow = 1) and (RowCount = 2) then
    begin
      for J := 0 to ACol - 1 do
        cells[J, 1] := '';
    end
    else
    begin
      for I := ARow to RowCount - 1 do
        for J := 0 to ACol - 1 do
          cells[J, I] := cells[J, I + 1];
      RowCount := RowCount - 1;
    end;

  end;
end;

procedure TFrmMain.AddGridData(var Grid: TAdvStringGrid; QryStr: string;
  JgdgeCol: Integer; IsAdd: Boolean);
var
  QueryCount: integer;
  Counter: integer;
  FieldCount: integer;
  FieldCounter: integer;
  CurrentRowCount: Integer;
begin
  QryTemp.Close;
  QryTemp.SQL.text := QryStr;
  QryTemp.Open;
  QueryCount := RecordCount(QryTemp);

  if IsAdd then
  begin
    if (Grid.RowCount = 2) and (Grid.Cells[JgdgeCol, 1] = '') then
    begin
      CurrentRowCount := 1;
      Grid.RowCount := QueryCount + 1;
    end
    else
    begin
      CurrentRowCount := Grid.RowCount;
      Grid.RowCount := CurrentRowCount + QueryCount;
    end;
  end
  else
  begin
    Grid.ClearNormalCells;
    Grid.RowCount := 1;
    Grid.RowCount := QueryCount + 1;
  end;

  if Grid.RowCount < 2 then
    Grid.RowCount := 2;

  Grid.FixedRows := 1;

  QryTemp.First;
  FieldCount := QryTemp.FieldCount;

  if IsAdd then
  begin
    for Counter := 1 to QueryCount do
    begin
      for FieldCounter := 0 to FieldCount - 1 do
        Grid.Rows[CurrentRowCount + Counter - 1].Strings[FieldCounter] :=
          QryTemp.Fields[FieldCounter].asstring;
      QryTemp.Next;
    end;
  end
  else
  begin
    for Counter := 1 to QueryCount do
    begin
      for FieldCounter := 0 to FieldCount - 1 do
        Grid.Rows[Counter].Strings[FieldCounter] :=
          QryTemp.Fields[FieldCounter].asstring;
      QryTemp.Next;
    end;
  end;
end;

procedure TFrmMain.Full_FilterCombobox(com: TComboBox; Query, XSName: string);
var
  zcrbh: string;
begin
  try
    QryTemp.close;
    with QryTemp do