ufunctionbasemoduleform.pas

Delphi函数工厂。。。。。。。。。。。。。

begin
  inherited;
  if button in [nbFirst, nbPrior, nbNext, nbLast] then
    ShowData;
  if button in [nbInsert, nbEdit] then
  begin
    if not pnlInfo.Visible then
      btnShowHideClick(nil);
    if button = nbInsert then
    begin
      FIsAdd := true;
      dbeDate.Text := datetostr(date());
      dbcbType.SetFocus;
    end;
  end;
end;

procedure TFunctionbaseModuleForm.ADOQuery1BeforeDelete(DataSet: TDataSet);
begin
  inherited;
  ShowData;
  if tvShowData.Selected.Text = dbeName.Text then
    tvShowData.Selected.Delete;
end;

function GetHzPy(const AHzStr: string): string;
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: integer;
begin
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + char(byte('A') + j);
          break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;

procedure TFunctionbaseModuleForm.ADOQuery1BeforePost(DataSet: TDataSet);
var
  temp, selectnode, tempchild: ttreenode;
  str: string;
  index: integer;
  procedure NewNode;
  begin
    if MessageBox(Handle, PChar('数据库中没有这个类型,是否要添加?'), PChar('询问'),
      MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = IDYES then
    begin
      FAllType.Sorted := false;
      FAllType.Add(dbcbType.Text);
      try
        FillItem;
      except
      end;
      temp := FNodes.Add(FRootNode.GetLastChild, str);
      temp.ImageIndex := 1;
      temp.SelectedIndex := 2;
      tempchild := tvShowData.Items.AddChild(temp, dbeName.Text);
      tempchild.ImageIndex := 3;
      tempChild.Selected := true;
    end;
  end;
begin
  inherited;
  if (trim(dbcbType.Text) = '') or (trim(dbeName.Text) = '') or (trim(dbmContent.Text) = '') then
  begin
    MessageBox(Handle, PChar('注意:函数类型和函数名是必须要填写的!'), PChar('提示'),
      MB_ICONINFORMATION or MB_OK);
    abort;
  end
  else
  begin
    ADOQuery1.FieldByName('PYname').AsString := GetHzPy(dbeName.Text);
    if trim(dbeAuthor.Text) <> '' then
      ADOQuery1.FieldByName('PYauthor').AsString := GetHzPy(dbeAuthor.Text);
    if trim(dbeExplain.Text) <> '' then
      ADOQuery1.FieldByName('PYexplain').AsString := GetHzPy(dbeExplain.Text);
    if FModifyFlag = true then
    begin
      selectnode := tvShowData.Selected;
      str := dbcbType.Text;
      index := FAllType.IndexOf(str);
      if FIsAdd then
      begin
        if index = -1 then
          NewNode
        else
        begin
          tempchild := tvShowData.Items.AddChild(FRootNode.Item[FAllType.IndexOf(str)], dbeName.Text);
          tempchild.ImageIndex := 3;
          tempChild.Selected := true;
        end;
        FIsAdd := false;
      end
      else
      begin
        if index = -1 then
        begin
          NewNode;
          selectnode.Delete;
        end
        else
        begin
          selectnode.Delete;
          tempchild := tvShowData.Items.AddChild(FRootNode.Item[FAllType.IndexOf(str)], dbeName.Text);
          tempchild.ImageIndex := 3;
        end;
      end;
      FModifyFlag := false;
    end;
  end;
end;

procedure TFunctionbaseModuleForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  FAllType.Free;
end;

procedure TFunctionbaseModuleForm.btnCopyCodeClick(Sender: TObject);
begin
  inherited;
  dbmContent.SelectAll;
  dbmContent.CopyToClipboard;
end;

procedure TFunctionbaseModuleForm.WMSetContent(var t: TWmCopyData);
begin
  ADOQuery1.Edit;
  ADOQuery1.FieldByName('内容').AsString:=strpas(t.CopyDataStruct^.lpData);
end;

procedure TFunctionbaseModuleForm.Button1Click(Sender: TObject);
begin
  inherited;
  PasFileEditForm.show;
  PasFileEditForm.mmContent.Lines.Assign(dbmContent.Lines);
  PasFileEditForm.FIsTransfer := true;
end;

procedure TFunctionbaseModuleForm.dbcbTypeChange(Sender: TObject);
begin
  inherited;
  FModifyFlag := true;
end;

procedure TFunctionbaseModuleForm.dbeNameChange(Sender: TObject);
begin
  inherited;
  FModifyFlag := true;
end;

procedure TFunctionbaseModuleForm.cbTypeChange(Sender: TObject);
begin
  inherited;
  with ADOQuery1 do
  begin
    Close;
    sql.Clear;
    sql.Add('select * from function');
    sql.Add('where true');
    if cbType.Text <> '' then
      sql.Add('and 类型 like "%' + cbType.Text + '%"');
    if trim(edtName.Text) <> '' then
      sql.Add('and 名称 like "%' + edtName.Text + '%"');
    if trim(cbUses.Text) <> '' then
      sql.Add('and Uses like "%' + cbUses.Text + '%"');
    if trim(edtExplain.Text) <> '' then
      sql.Add('and 说明 like "%' + edtExplain.Text + '%"');
    if trim(edtAnthor.Text) <> '' then
      sql.Add('and 作者 like "%' + edtAnthor.Text + '%"');
    if trim(edtDate.Text) <> '' then
      sql.Add('and 日期 like "%' + edtDate.Text + '%"');
    if cbFavorite.Checked then
      sql.Add('and 收藏 = true');
    if cbSearchByPY.Checked then
    begin
      if trim(edtName.Text) <> '' then
        sql.Add('OR PYname like "%' + edtName.Text + '%"');
      if trim(edtExplain.Text) <> '' then
        sql.Add('OR PYexplain like "%' + edtExplain.Text + '%"');
      if trim(edtAnthor.Text) <> '' then
        sql.Add('OR PYauthor like "%' + edtAnthor.Text + '%"');
    end;
    sql.Add('ORDER by 类型');
    open;
  end;

end;

procedure TFunctionbaseModuleForm.btnDoSqlClick(Sender: TObject);
begin
  inherited;
  try
    with ADOQuery1 do
    begin
      Close;
      sql.Clear;
      SQL.Text := mmSql.Text;
      open;
    end;
  except
  end;
end;

procedure TFunctionbaseModuleForm.btnClearClick(Sender: TObject);
begin
  inherited;
  cbType.Text := '';
  cbUses.Text := '';
  edtName.Text := '';
  edtAnthor.Text := '';
  edtExplain.Text := '';
  edtDate.Text := '';
end;

procedure TFunctionbaseModuleForm.ADOQuery1AfterPost(DataSet: TDataSet);
begin
  inherited;
  ShowData;
end;

procedure TFunctionbaseModuleForm.btnShowHideClick(Sender: TObject);
begin
  inherited;
  if pnlInfo.Visible then
    btnShowHide.Caption := '>>'
  else
    btnShowHide.Caption := '<<';
  pnlInfo.Visible := not pnlInfo.Visible;
end;

procedure TFunctionbaseModuleForm.tvShowDataDragOver(Sender,
  Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  targetnode, sourcenode: TTreenode;
begin
  inherited;
  targetnode := tvShowData.getnodeat(x, y);
  sourcenode := tvShowData.selected;
  if (Source = Sender) and (targetnode <> nil)
    and (sourcenode.Parent <> FRootNode)
    and (targetnode <> FRootNode)
    and (targetnode.Parent = FRootNode)
    and (targetnode <> sourcenode.parent)
    then
    Accept := true
  else Accept := false;
end;

procedure TFunctionbaseModuleForm.tvShowDataDragDrop(Sender,
  Source: TObject; X, Y: Integer);
var
  targetnode,sourcenode, newnode: TTreenode;
begin
  inherited;
  targetnode := tvShowData.getnodeat(x, y);
  sourcenode := tvShowData.selected;
  try
    ADOQuery1.Edit;
    ADOQuery1.FieldByName('类型').AsString:= targetnode.Text;
    dbcbType.Text := targetnode.Text;
    ADOQuery1.Post;
  except
  end;
end;

procedure TFunctionbaseModuleForm.ADOQuery1AfterInsert(DataSet: TDataSet);
begin
  inherited;
  inc(FRecordCount);
ShowRecordCount(FRecordCount);
end;

procedure TFunctionbaseModuleForm.ADOQuery1AfterDelete(DataSet: TDataSet);
begin
  inherited;
  dec(FRecordCount);
ShowRecordCount(FRecordCount);
end;

procedure TFunctionbaseModuleForm.pmContentRightClickPopup(
  Sender: TObject);
begin
  inherited;
C1.Enabled:=dbmContent.SelText<>'';
P1.Enabled:=dbmContent.CanPaste;
C2.Enabled:=dbmContent.SelText<>'';
end;

procedure TFunctionbaseModuleForm.C1Click(Sender: TObject);
begin
  inherited;
dbmContent.CopyToClipboard;
end;

procedure TFunctionbaseModuleForm.P1Click(Sender: TObject);
begin
  inherited;
dbmContent.PasteFromClipboard;
end;

procedure TFunctionbaseModuleForm.C2Click(Sender: TObject);
begin
  inherited;
dbmContent.CutToClipboard;
end;

procedure TFunctionbaseModuleForm.A1Click(Sender: TObject);
begin
  inherited;
dbmContent.SelectAll;
end;

procedure TFunctionbaseModuleForm.dbcbUsesDblClick(Sender: TObject);
begin
  inherited;
  ClipBoard.SetTextBuf(PChar(dbcbUses.Text));
end;

end.