⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usel_base.pas

📁 相关的销售服务管理行业的一个软件
💻 PAS
字号:
unit USel_Base;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls, Db, ADODB, Grids, DBGrids,
  Menus, EHGrids, DBGridEh, UDataVar;

type
  TfrmSel_Base = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Tv: TTreeView;
    ADOQry: TADOQuery;
    PmTree: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    DBGridEh1: TDBGridEh;
    DataSource1: TDataSource;
    QrySel: TADOQuery;
    procedure FormShow(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure TvKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure TvClick(Sender: TObject);
    procedure DBGridEh1CellClick(Column: TColumnEh);
    procedure DBGridEh1KeyPress(Sender: TObject; var Key: Char);
    procedure FormHide(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    SB:TSelBack;
    { Public declarations }
  end;

var
  frmSel_Base: TfrmSel_Base;
  SB:TSelBack=sbNone;
implementation

uses U_DM;

{$R *.DFM}


procedure TfrmSel_Base.FormShow(Sender: TObject);
var
  TmpNode:TTreeNode;
  CodeLength,LengthPre:integer;
  Code,TCode,TName:String;
  i:integer;
  PData:PChar;
begin
  QrySel.Close;
  Tv.Items.Clear;
  ADOQry.Close;
  ADOQry.Open;
  LengthPre:=0;
  TmpNode:=TTreeNode.Create(nil);
  with ADOQry do
  begin
    While not ADOQry.Eof do
    begin
      Code:=FieldByName('Code').AsString;
      TCode:=FieldByName('TCode').AsString;
      TName:=FieldByName('Name').AsString;
      CodeLength:=length(TCode);
      Getmem(PData,CodeLength+1);
      StrPlCopy(PData,TCode,CodeLength);

      if CodeLength=4 then
      begin
        TmpNode:=Tv.Items.AddObject(nil,Code+'-'+TName,PData);
        LengthPre:=CodeLength;
      end else
      begin
        if CodeLength>LengthPre then
        begin
          TmpNode:=Tv.Items.AddChildObject(TmpNode,Code+'-'+TName,PData);
          LengthPre:=CodeLength;
        end else
        begin
          if CodeLength=LengthPre then
          begin
            TmpNode:=Tv.Items.AddObject(TmpNode,Code+'-'+TName,PData);
            LengthPre:=CodeLength;
          end else
          begin         //往上走
            for i:=1 to (LengthPre-CodeLength) div 4 do
            begin
              TmpNode:=TmpNode.Parent;
            end;
            TmpNode:=Tv.Items.AddObject(TmpNode,Code+'-'+TName,PData);
            LengthPre:=CodeLength;
          end;
        end;
      end;
      ADOQry.Next;
    end;
    ADOQry.First;
  end;
  QrySel.Open;
//  frmMain.SelFormCount:=frmMain.SelFormCount+1;
//  QrySel.Filtered:=false;
//  QrySel.First;
//  ADOQry.First;
  Tv.SetFocus;
  TvClick(Sender);
end;

procedure TfrmSel_Base.N1Click(Sender: TObject);
begin
  Tv.FullExpand;
end;

procedure TfrmSel_Base.N2Click(Sender: TObject);
begin
  Tv.FullCollapse;
end;

procedure TfrmSel_Base.TvKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=38) or  (key=40  )then
    TvClick(Sender);
end;

procedure TfrmSel_Base.TvClick(Sender: TObject);
var
  SelTCode,TCode:string;
begin
  try
    SelTCode:=copy(string(tv.Selected.Data),0,(tv.Selected.Level+1)*4);
    ADOQry.Locate('TCode',SelTCode,[loCaseInsensitive]);
    if (Tv.Selected<>nil) and (QrySel.Active) then
    begin
      TCode:=Copy(String(Tv.Selected.Data),0,(Tv.Selected.Level+1)*4);
      QrySel.Filtered:=False;
      QrySel.Filter:='TCode like '+''''+TCode+'%'+'''';
      QrySel.Filtered:=True;
    end;
  except
    //危险!新增第一条纪录时回莫名其妙报错!
  end;
end;

procedure TfrmSel_Base.DBGridEh1CellClick(Column: TColumnEh);
begin
  Hide;
end;

procedure TfrmSel_Base.DBGridEh1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
    Hide;
end;

procedure TfrmSel_Base.FormHide(Sender: TObject);
begin
if SB<>sbClose then
  SB:=sbHide;
end;

procedure TfrmSel_Base.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  SB:=sbClose;
end;

procedure TfrmSel_Base.FormCreate(Sender: TObject);
begin
QrySel.Close;
QrySel.Open;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -