📄 viewsub.pas
字号:
unit viewsub;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, CheckLst,Db,ADODb,CLTools, ComCtrls, Grids,
ExtCtrls,jpeg, fcdbtreeview, DBGrids, fcTreeView, Gauges;
type
TFrm_ViewSub = class(TForm)
OpenDialog: TOpenDialog;
ADOFun: TADOQuery;
DataSource1: TDataSource;
ADOTable1: TADOTable;
ScrollBox1: TScrollBox;
Image1: TImage;
Panel1: TPanel;
BitBtn3: TBitBtn;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ADOQuery1: TADOQuery;
TreeView: TfcTreeView;
Splitter1: TSplitter;
Label1: TLabel;
StatusBar1: TStatusBar;
ADOUpDate: TADOQuery;
ADOTmp: TADOQuery;
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ADOQuery1AfterScroll(DataSet: TDataSet);
procedure TreeViewChange(TreeView: TfcCustomTreeView;
Node: TfcTreeNode);
procedure TreeViewToggleCheckbox(TreeView: TfcCustomTreeView;
Node: TfcTreeNode);
procedure MakeProc(InMaxValue, PanelIndex: Integer);
procedure IncProc(IncValue: Integer = 1);
procedure DeleProc();
private
{ Private declarations }
JPEGImage:TJPEGImage ;
Proc:TGauge;
procedure AllCheck(Node: TfcTreeNode);
procedure InitSub(ProjectName : String);
procedure AllImport(Node: TfcTreeNode);
procedure AllImportEx();
function DoUpDate(Node: TfcTreeNode):Integer;
public
{ Public declarations }
InNode: Array of TfcTreeNode;
tmpinputfile: string;
end;
var
Frm_ViewSub: TFrm_ViewSub;
implementation
uses main_, uExpSubFlow;
{$R *.DFM}
procedure TFrm_ViewSub.BitBtn3Click(Sender: TObject);
var
s1: string;
begin
if OpenDialog.Execute() then
begin
if not FileExists(OpenDialog.FileName) then
begin
ShowMessage(OpenDialog.FileName + ' 不存在!');
Exit;
end
else begin
s1 := ExtractFilePath(OpenDialog.FileName) + 'RayInput.000';
tmpinputfile := s1;
CopyFile(PChar(OpenDialog.FileName),PChar(s1),false);
InitSub(s1);
end;
end;
end;
procedure TFrm_ViewSub.InitSub(ProjectName : String);
var
CreateDate :TDateTime;
ModifyDate :TDateTime;
Writer :String;
ProjectOwner : String;
TopNode: TfcTreeNode;
begin
ADOTable1.Close();
ADOTable1.ConnectionString := main.MakeConnectionString(ProjectName);
ADOTable1.TableName := 'detail';
try
ADOTable1.Open();
except
ShowMessage('不能打开文件'+ProjectName);
Exit;
end;
with ADOTable1 do
begin
CreateDate := FieldByName('CreateDate').AsDateTime;
ModifyDate := FieldByName('ModifyDate').AsDateTime;
Writer := FieldByName('Writer').AsString;
ProjectOwner := FieldByName('Owner').AsString;
Close();
if ProjectOwner <> main.DetailOwner then
begin
clMsgBox('你要打开的项目需要“' + ProjectOwner + '”内核,' + #13 + #10 +
'当前Visual IVR Studio的内核是“' + Main.DetailOwner + '”' + #13 + #10 +
'【系统拒绝打开】');
Exit;
end;
Close();
end;
with ADOFun do
begin
Close();
ConnectionString :=main.MakeConnectionString(ProjectName);
end;
TreeView.Items.Clear();
with ADOQuery1 do
begin
Close();
ConnectionString :=main.MakeConnectionString(ProjectName);
SQL.Clear();
SQL.Add('SELECT * FROM FunctionList order by parentid ,id, functionid');
Open();
SetLength(InNode,RecordCount+1);
while not Eof do
begin
if FieldByName('ParentID').AsInteger = 0 then
TopNode := TreeView.Items.AddChild(nil,FieldByName('Function').AsString)
else
TopNode := TreeView.Items.AddChild(InNode[FieldByName('ParentID').AsInteger],FieldByName('Function').AsString);
InNode[FieldByName('FunctionID').AsInteger] := TopNode;
TopNode.CheckboxType := tvctCheckbox;
TopNode.Checked := false;
TopNode.StringData := IntToStr(RecNo);
TopNode.StringData2 := FieldByName('FunctionID').AsString;
Next();
end;
end;
TreeView.Selected := TreeView.Items[0];
TreeView.SetFocus();
end;
procedure TFrm_ViewSub.BitBtn2Click(Sender: TObject);
begin
Close();
end;
procedure TFrm_ViewSub.BitBtn1Click(Sender: TObject);
var
i: integer;
begin
if TreeView.Items.Count = 0 then
begin
exit;
end;
{
if main.NowID mod 10 <> 0 then
begin
main.NowID := main.NowID + 10 - main.NowID mod 10;
end;
}
i := DoUpDate(TreeView.Items.GetFirstNode);
main.Tag := 1;
Screen.Cursor := crHourGlass;
AllImportEx();
//AllImport(TreeView.Items.GetFirstNode);
Main.UpSubLink();
main.Tag := 0;
ADOFun.Close();
Screen.Cursor := crDefault;
ShowMessage('导入完毕!');
end;
procedure TFrm_ViewSub.FormCreate(Sender: TObject);
begin
JPEGImage:=TJPEGImage.Create;
ScrollBox1.Color := main.MainBox.Color ;
Label1.Caption := '';
end;
procedure TFrm_ViewSub.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
JPEGImage.free();
end;
procedure TFrm_ViewSub.ADOQuery1AfterScroll(DataSet: TDataSet);
var
PhotoField :TBlobField ;
stPhoto: TStream;
begin
PhotoField := ADOQuery1.FieldByName('FunImage') as TBlobField ;
stPhoto := ADOQuery1.CreateBlobStream(PhotoField, bmRead);
JPEGImage.LoadFromStream(stPhoto);
Image1.Picture.Assign(JPEGImage);
stPhoto.free;
ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width ;
ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;
Label1.Caption :='说明: '+ Trim(ADOQuery1.FieldByName('FunMemo').AsString) +' ' +'更新日期:'+ADOQuery1.FieldByName('Update').AsString;
end;
procedure TFrm_ViewSub.TreeViewChange(TreeView: TfcCustomTreeView;
Node: TfcTreeNode);
begin
ADOQuery1.RecNo := StrToInt(Node.StringData);
end;
procedure TFrm_ViewSub.TreeViewToggleCheckbox(TreeView: TfcCustomTreeView;
Node: TfcTreeNode);
begin
// AllCheck(Node);
end;
procedure TFrm_ViewSub.AllCheck(Node: TfcTreeNode);
var
tmpNode : TfcTreeNode;
begin
tmpNode := Node.GetFirstChild();
while tmpNode <> nil do
begin
if tmpNode.HasChildren then
AllCheck(tmpNode);
tmpNode.Checked := Node.Checked ;
tmpNode := Node.GetNextChild(tmpNode);
end;
end;
procedure TFrm_ViewSub.AllImport(Node: TfcTreeNode);
var
tmpNode : TfcTreeNode;
begin
tmpNode := TreeView.Items.GetFirstNode;
while tmpNode <> nil do
begin
if tmpNode.Checked then //是否被选中
begin
ADOQuery1.Filtered := false ;
ADOQuery1.Filter := ' FunctionID = '+ tmpNode.StringData2 ;
ADOQuery1.Filtered := true ;
main.ImportSubProcess(ADOQuery1,true);
main.MyAddBox(tmpNode.Text,false,true);
ADOFun.Close();
ADOFun.SQL.Clear();
ADOFun.SQL.Add('select * from view_function where FunctionID = ' + tmpNode.StringData2 + ' order by id ' );
ADOFun.Open();
MakeProc(ADOFun.RecordCount,1);
main.ImportSubProcess(ADOFun,false);
DeleProc();
end;
tmpNode := tmpNode.GetNext();
end;
end;
//生成StatusBar的进度条
procedure TFrm_ViewSub.MakeProc(InMaxValue, PanelIndex: Integer);
var
i: Integer;
begin
Proc := TGauge.Create(StatusBar1);
with Proc do
begin
Parent := StatusBar1;
Color := StatusBar1.Color;
BackColor := StatusBar1.Color;
ForeColor := clNavy;
MaxValue := InMaxValue;
BorderStyle := bsNone;
Kind := gkHorizontalBar;
Top := 4;
Height := StatusBar1.Height - 6;
Left := 4;
for i := 0 to PanelIndex - 1 do
Left := Left + StatusBar1.Panels[i].Width;
Width := StatusBar1.Panels[PanelIndex].Width - 6;
end;
end;
//StatusBar的进度条进度增加
procedure TFrm_ViewSub.IncProc(IncValue: Integer = 1);
begin
Proc.Progress := Proc.Progress + IncValue;
end;
//删除StatusBar的进度条
procedure TFrm_ViewSub.DeleProc;
begin
if Proc = nil then
Exit;
Proc.Free();
Proc := nil;
end;
function TFrm_ViewSub.DoUpDate(Node: TfcTreeNode):Integer;
var
FunID: integer;
IsOK: integer;
ExpSubFlow: TExpSubFlow;
tmpNode: TfcTreeNode;
begin
tmpNode := TreeView.Items.GetFirstNode;
IsOK := 0;
while tmpNode <> nil do
begin
if tmpNode.Checked then //是否被选中
begin
FunID := StrToInt(tmpNode.StringData2);
IsOK := 1;
break;
end;
tmpNode := tmpNode.GetNext();
end;
if (IsOK = 0) then
begin
Result := 0;
exit;
end;
ExpSubFlow := TExpSubFlow.Create(nil);
ExpSubFlow.Database := ADOTable1.ConnectionString;
ExpSubFlow.ExportSubFlow(main.NowID,FunID);
ExpSubFlow.Free();
Result := 1;
end;
procedure TFrm_ViewSub.AllImportEx();
var
s1: string;
funid: integer;
begin
main.ImportProject(ADOTable1.ConnectionString);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -