📄 main.pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ToolWin, ComCtrls, Menus, ExtCtrls, StdCtrls,word_use
, Word2000, ShellCtrls, Grids, DBGrids, OleCtrls, SHDocVw, OleCtnrs,
FileCtrl, DB, DBTables,IniFiles,TlHelp32,ShellAPI;
type
Tfrmtkaid = class(TForm)
CoolBar1: TCoolBar;
button_link: TSpeedButton;
button_out: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
Panel4: TPanel;
Splitter2: TSplitter;
Panel5: TPanel;
StatusBar1: TStatusBar;
Panel6: TPanel;
Splitter3: TSplitter;
Panel7: TPanel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
CoolBar2: TCoolBar;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Label1: TLabel;
SaveDialog1: TSaveDialog;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
TreeView1: TTreeView;
ShellComboBox1: TShellComboBox;
ShellListView1: TShellListView;
Tbl_tk: TTable;
Memo1: TMemo;
Memo2: TMemo;
N8: TMenuItem;
SpeedButton1: TSpeedButton;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
SpeedButton2: TSpeedButton;
N16: TMenuItem;
procedure SpeedButton5Click(Sender: TObject);
procedure button_linkClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ReadWordField();
procedure WriteIntoMemo();
procedure FormCreate(Sender: TObject);
procedure DBGrid1CellClick(Column: TColumn);
procedure button_outClick(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure AddChildNode(Id :integer ; sql_str :string ; FatherNode :TTreeNode);
procedure BuildTree(sql_str :string);
procedure TreeView1Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
Function CheckTempFile() :boolean ;
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N16Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmtkaid : Tfrmtkaid;
Edit_Id : integer; {正在编辑状态的记录号}
Edit_field : string; {正在编辑状态的记录类型}
implementation
uses tk_set, about, repair;
{$R *.dfm}
{退出按钮动作代码}
procedure Tfrmtkaid.SpeedButton5Click(Sender: TObject);
begin
if MessageDlg('要退出题库管理助手吗 ?',mtConfirmation,mbOKCancel,0) = mrOK then
close;
end;
//******************<连接>按钮代码********************************
// 功能：连接到题库数据库
// 控件：tbl_tk,shelllistview
// 要点： 1、解决输入密码问题 Session.AddPassword('jIGGAe');
// 2、解决quick中可编辑 Query.RequestLive:=true;
//****************************************************************
procedure Tfrmtkaid.button_linkClick(Sender: TObject);
var
db_name : string;
begin
if not assigned(shelllistview1.Selected) then
begin
ShowMessage('需要选择数据库文件');
exit;
end
else
begin
db_name:=shelllistview1.SelectedFolder.PathName;
if Uppercase(ExtractFileExt(db_name)) <>'.DB' then
begin
ShowMessage('所选文件不是题库数据文件');
exit;
end
else
begin
label1.Caption:='正在读入题库数据文件...';
label1.Refresh;
with tbl_tk do
begin
Close;
DatabaseName:=ExtractFilePath(db_name);
TableType := ttParadox;
TableName:=db_name;
try
Session.AddPassword('jIGGAe'); {解决输入密码问题}
Open;
except
raise exception.Create('无法连接，所选文件不是题库数据文件');
Close;
exit;
end;
ReadWordField();
WriteIntoMemo();
label1.Caption:='';
StatusBar1.Panels.Items[1].Text:='当前连接的数据库是 '+ExtractFileName(db_name);
end;
end;
end;
end;
{从数据库BLOB字段中读取WORD文件,保存为C盘临时文件}
procedure Tfrmtkaid.ReadWordField();
var
wordField_st : TField;
wordField_da : TField;
begin
wordField_st:=TBlobField(tbl_tk.FieldByName('Shiti'));
if not wordField_st.IsNull then
begin
try
TBlobField(wordField_st).SaveToFile('C:\~Shiti.DOC');
except
ShowMessage('数据文件读取错误');
exit;
end;
end;
wordField_da:=TBlobField(tbl_tk.FieldByName('Daan'));
if not wordField_da.IsNull then
begin
try
TBlobField(wordField_da).SaveToFile('C:\~Daan.DOC');
except
ShowMessage('数据文件读取错误');
end;
end;
end;
{程序退出的一些清理工作}
procedure Tfrmtkaid.FormClose(Sender: TObject; var Action: TCloseAction);
var
hword : Thandle;
begin
if tbl_tk.Active = true then
tbl_tk.Close;
HWord:=FindWindow(NIL,'~tk_editing - Microsoft Word');
if not (hWord = 0) then
SendMessage(HWord,WM_CLOSE,0,0);
HWord:=FindWindow(NIL,'~Shiti - Microsoft Word');
if not (hWord = 0) then
SendMessage(HWord,WM_CLOSE,0,0);
HWord:=FindWindow(NIL,'~Daan - Microsoft Word');
if not (hWord = 0) then
SendMessage(HWord,WM_CLOSE,0,0);
HWord:=FindWindow(NIL,'Microsoft Word'); { 退出内存中的WORD }
if hWord <> 0 then
SendMessage(HWord,WM_CLOSE,0,0);
if FileExists('c:\~tk_editing.doc') then
DeleteFile('c:\~tk_editing.doc');
if FileExists('c:\~Shiti.doc') then
DeleteFile('c:\~Shiti.doc');
if FileExists('c:\~Daan.doc') then
DeleteFile('c:\~Daan.doc');
if FileExists('c:\~shiti_temp.doc') then
DeleteFile('c:\~shiti_temp.doc');
if FileExists('c:\~daan_temp.doc') then
DeleteFile('c:\~daan_temp.doc');
end;
{将临时文件中的文本写的MEMO中}
procedure Tfrmtkaid.WriteIntoMemo();
var
Wordapp : OleVariant;
worddoc1 : OleVariant;
worddoc2 : OleVariant;
begin
Wordapp := OpenWordApp();
if not Wordapp.visible = true then {避免WORD产生的冲突}
Wordapp.visible := false;
worddoc1 := openWordDoc(Wordapp,'c:\~Shiti.doc');
worddoc1.Range.Select;
memo1.Text:=Wordapp.Selection.text;
memo1.Refresh;
worddoc1.close(wdSaveChanges);
worddoc2 := openWordDoc(Wordapp,'c:\~Daan.doc');
worddoc2.Range.Select;
memo2.Text:=Wordapp.Selection.text;
memo2.Refresh;
worddoc2.close(wdSaveChanges);
end;
{一些初始化设置}
procedure Tfrmtkaid.FormCreate(Sender: TObject);
var
myinifile:TIniFile;
sql_str :string;
db_path :string;
begin
Edit_Id := 0;
Edit_field := '';
if not FileExists(ExtractFilePath(Application.ExeName)+'tkaid.ini') then
begin
myinifile:=Tinifile.create(ExtractFilePath(Application.ExeName)+'tkaid.ini');
myinifile.WriteString('关于本软件','软件名称','题库管理助手');
myinifile.WriteString('关于本软件','作者','耿卫国');
myinifile.WriteString('DATABASE','db_path','c:\Program Files\JZN\Tk97DLJNJDNEW\workdb');
myinifile.WriteString('OUT_SET','Style','');
myinifile.WriteString('TK_SET','Action','');
myinifile.WriteString('TK_SET','Count','');
myinifile.WriteString('TK_SET','Range','');
myinifile.Free;
end
else
begin
myinifile:=Tinifile.create(ExtractFilePath(Application.ExeName)+'tkaid.ini');
db_path:= myinifile.ReadString('database','db_path','c:\');
try
ShellComboBox1.Path := db_path;
except
ShowMessage('目录不存在，需重新设定');
end;
myinifile.Free;
end;
if FileExists(db_path+'\mulu.db') then
begin
sql_str:='select * from "'+db_path+'\mulu.db"';
BuildTree( sql_str );
end;
end;
{点击浏览试题和答案}
procedure Tfrmtkaid.DBGrid1CellClick(Column: TColumn);
begin
if CheckTempFile() then
begin
ReadWordField();
WriteIntoMemo();
end
else
ShowMessage('这项操作需要关闭临时文件 ~Shiti.doc, ~Daan.doc,~tk_editing.doc');
end;
{将数据文件中的BLOB字段输出到一个WORD文件中}
procedure Tfrmtkaid.button_outClick(Sender: TObject);
var
Wordapp : OleVariant;
newdoc : OleVariant;
i : integer;
id : string;
myinifile : TIniFile;
Style : integer;
begin
if not tbl_tk.Active then
begin
showmessage('未连接数据库，或数据文件读取错误');
exit;
end;
if MessageDlg('确定要将这个打开的题库导入到一个WORD文件吗',
mtConfirmation,mbOKCancel,0) = mrCancel then
exit;
if not CheckTempFile() then
ShowMessage('这项操作需要关闭临时文件 ~Shiti.doc, ~Daan.doc,~tk_editing.doc')
else
begin
myinifile:=Tinifile.create(ExtractFilePath(Application.ExeName)+'tkaid.ini');
Style:= StrToInt( myinifile.ReadString('OUT_SET','STYLE','2'));
myinifile.Free;
Wordapp := OpenWordApp();
if not Wordapp.Visible = true then
Wordapp.Visible := false;
newdoc := NewWordDoc(Wordapp);
with tbl_tk do
begin
first;
edit;
for i:= 1 to RecordCount do
begin
ReadWordField();
id := IntTOStr(FieldByName('Id').AsInteger);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -