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

📄 xufunctionmoduleform.pas

📁 Delphi函数工厂。。。。。。。。。。。。。
💻 PAS
字号:
unit xuFunctionModuleForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uCustomModuleForm, StdCtrls, DB, ADODB, ExtCtrls, Grids,
  DBGrids, ComCtrls, ImgList, DBCtrls, Mask;

type
  TFunctionDialog = class;
  TFunctionModuleForm = class(TCustomModuleForm)
    Panel1: TPanel;
    Panel2: TPanel;
    DBGrid1: TDBGrid;
    Panel3: TPanel;
    ImageList1: TImageList;
    daoqdelphifun: TADOQuery;
    DataSource1: TDataSource;
    daoqdelphifunDSDesigner: TWideStringField;
    daoqdelphifunDSDesigner2: TWideStringField;
    daoqdelphifunDSDesigner3: TWideStringField;
    daoqdelphifunDSDesigner4: TMemoField;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label2: TLabel;
    DBMemo1: TDBMemo;
    Label3: TLabel;
    DBMemo2: TDBMemo;
    Panel4: TPanel;
    GroupBox3: TGroupBox;
    Panel5: TPanel;
    tvShow: TTreeView;
    DBMemo3: TDBMemo;
    GroupBox1: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    edtname: TEdit;
    edtExplain: TEdit;
    DBNavigator1: TDBNavigator;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure edtExplainChange(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure tvShowClick(Sender: TObject);
    procedure edtnameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edtnameChange(Sender: TObject);
    procedure daoqdelphifunBeforePost(DataSet: TDataSet);
    procedure daoqdelphifunBeforeEdit(DataSet: TDataSet);
    procedure daoqdelphifunBeforeInsert(DataSet: TDataSet);
    procedure daoqdelphifunBeforeDelete(DataSet: TDataSet);
    procedure daoqdelphifunAfterDelete(DataSet: TDataSet);

  private
    { Private declarations }
    treenode: array[0..27] of ttreenode;
    FunctionDialog: TFunctionDialog;
    t, tempnode: ttreenode;
    FEditTreeText: string;
    isAdd: boolean;
    procedure loaddata;
    procedure RefreshTree;
    procedure DoSQL(const field, value: string; isnear: boolean);
  public
    { Public declarations }
  end;

  TFunctionDialog = class(TCustomModuleDialog)
  private
    FModuleForm: TFunctionModuleForm;
    FPageIndex: Integer;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;

  published
    property PageIndex: Integer read FPageIndex write FPageIndex
      default 0;
  end;
var
  FunctionModuleForm: TFunctionModuleForm;

implementation
{$R *.dfm}

resourcestring
  SDefultFuntionDialogTitle = 'Delphi常用函数说明与示例';
{ TMessageBoxDialog}

constructor TFunctionDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TFunctionModuleForm.Create(Self);
  FModuleForm.FunctionDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultFuntionDialogTitle;
  FWindowForm := FModuleForm;
  FPageIndex := 0;
end;

destructor TFunctionDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TFunctionDialog.Execute: Boolean;
begin
  inherited Execute;
  Result := FModuleForm.ShowModal = mrOK;
end;

procedure TFunctionModuleForm.loaddata;
var
  temptreenode: ttreenode;
  I: integer;
  tstr: string;
begin
  daoqdelphifun.Active := false;
  treenode[0] := tvShow.Items.AddFirst(nil, '所有函数');
  treenode[0].ImageIndex := 4;
  treenode[0].SelectedIndex := 4;
  for I := 1 to 27 do
  begin
    if I = 27 then
      treenode[I] := tvShow.Items.AddChild(treenode[0], '其它')
    else
      treenode[I] := tvShow.Items.AddChild(treenode[0], char(64 + I));
    treenode[I].ImageIndex := 1;
    treenode[I].SelectedIndex := 2;
  end;
  daoqdelphifun.Open;
  daoqdelphifun.First;
  while (not daoqdelphifun.Eof) do
  begin
    tstr := daoqdelphifun.FieldByName('函数名').asstring;
    if ByteType(tstr, 1) = mbSingleByte then
      temptreenode := tvShow.Items.AddChild(treenode[byte(UpCase(tstr[1])) - 64], tstr)
    else temptreenode := tvShow.Items.AddChild(treenode[27], tstr);
    temptreenode.ImageIndex := 3;
    daoqdelphifun.Next;
  end;
  treenode[0].Expanded := true;
  daoqdelphifun.First;
  DBGrid1.DataSource := DataSource1;
  DBEdit1.DataSource := DataSource1;
  DBMemo1.DataSource := DataSource1;
  DBMemo2.DataSource := DataSource1;
  DBMemo3.DataSource := DataSource1;
  daoqdelphifun.Active := true;
end;

procedure TFunctionModuleForm.FormCreate(Sender: TObject);
var
  FileName: string;
begin
  inherited;
  FileName := ExtractFilePath(Application.ExeName) + 'delphi.dll';
  if FileExists(FileName) then
  begin
    if daoqdelphifun.Active = True then daoqdelphifun.Active := False;
    daoqdelphifun.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';Persist Security Info=False;jet OLEDB:Database Password=VB6STKIT.DLLsoftpb;';
    loaddata();
    treenode[1].Expanded := true;
    treenode[1].ImageIndex := 2;
    t := treenode[1];
  end
  else
    messagebox(handle, '数据库文件没找到!', 'Delphi函数工厂', 48);
end;


procedure TFunctionModuleForm.DoSQL(const field, value: string; isnear: boolean);
begin
  daoqdelphifun.Close;
  daoqdelphifun.SQL.Clear;
  daoqdelphifun.SQL.Add('select * from delphifun');
  if isnear then
    daoqdelphifun.SQL.Add('where ' + field + ' like "%' + value + '%"')
  else
    daoqdelphifun.SQL.Add('where ' + field + ' like "' + value + '%"');
  daoqdelphifun.Open;
end;

procedure TFunctionModuleForm.RefreshTree;
var I: integer;
begin
  if trim(DBEdit1.Text) <> '' then
  begin
    for I := 1 to 27 do
      if treenode[I].Expanded then
        treenode[I].Expanded := false;
    if ByteType(trim(DBEdit1.Text), 1) = mbSingleByte then
      t := treenode[byte(UpCase(DBEdit1.Text[1])) - 64]
    else t := treenode[27];
    if not t.Expanded then
      t.Expanded := true;
    tempnode := t.getFirstChild;
    repeat
      if DBEdit1.text = tempnode.Text then
      begin
        tempnode.Selected := true;
        exit;
      end;
      tempnode := tempnode.GetNext;
    until tempnode = t.GetLastChild;
    if t.GetLastChild.Text = DBEdit1.text then
      t.GetLastChild.Selected := true;

  end;
end;

procedure TFunctionModuleForm.edtExplainChange(Sender: TObject);
begin
  inherited;
  DoSQL('功能', edtExplain.Text, true);
  RefreshTree;
end;

procedure TFunctionModuleForm.DBGrid1CellClick(Column: TColumn);
begin
  inherited;
  RefreshTree;
end;

procedure TFunctionModuleForm.tvShowClick(Sender: TObject);
var I: integer;
begin
  inherited;
  DoSQL('函数名', tvShow.Selected.Text, false);
  if treenode[0].Selected then
  begin
    daoqdelphifun.Close;
    daoqdelphifun.SQL.Clear;
    daoqdelphifun.SQL.Add('select * from delphifun');
    daoqdelphifun.open;
  end;
  treenode[0].Expanded := true;
  for I := 1 to 26 do
    if treenode[I].Expanded then
      treenode[I].ImageIndex := 2
    else
      treenode[I].ImageIndex := 1;
end;

procedure TFunctionModuleForm.edtnameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  inherited;
  if key = 13 then
  begin
    DoSQL('函数名', edtname.Text, true);
    RefreshTree;
  end;
end;

procedure TFunctionModuleForm.edtnameChange(Sender: TObject);
begin
  inherited;
  DoSQL('函数名', edtname.Text, false);
  RefreshTree;
end;

procedure TFunctionModuleForm.daoqdelphifunBeforePost(DataSet: TDataSet);
var
  temptreenode: ttreenode;
begin
  inherited;
  if trim(DBEdit1.Text)=''then
  begin
  MessageBox(Handle, PChar('注意:函数名是必须要填写的!'), PChar('提示'),
  MB_ICONINFORMATION or MB_OK);
  abort;
  end
  else
  begin
  if isAdd then
  begin
    if ByteType(dbedit1.Text, 1) = mbSingleByte then
      temptreenode := tvShow.Items.AddChild(treenode[byte(UpCase(dbedit1.Text[1])) - 64], dbedit1.Text)
    else temptreenode := tvShow.Items.AddChild(treenode[27], dbedit1.Text);
    temptreenode.ImageIndex := 3;
    RefreshTree;
    isAdd := false
  end
  else
    if FEditTreeText <> dbedit1.Text then
      tvShow.Selected.Text := dbedit1.Text;
end;
end;
procedure TFunctionModuleForm.daoqdelphifunBeforeEdit(DataSet: TDataSet);
begin
  inherited;
  FEditTreeText := dbedit1.Text;
end;

procedure TFunctionModuleForm.daoqdelphifunBeforeInsert(DataSet: TDataSet);
begin
  inherited;
  dbedit1.SetFocus;
  isAdd := true;
end;

procedure TFunctionModuleForm.daoqdelphifunBeforeDelete(DataSet: TDataSet);
begin
  inherited;
  RefreshTree;
  if tvShow.Selected.Text = dbedit1.Text then
    tvShow.Items.Delete(tvShow.Selected);
end;

procedure TFunctionModuleForm.daoqdelphifunAfterDelete(DataSet: TDataSet);
begin
  inherited;
  DoSQL('函数名', tvShow.Selected.Text, false);
end;

end.

⌨️ 快捷键说明

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