unit_main.pas

DELPHI的报表控件

      TmpNode := TreeView1.Items.AddChildObjectFirst(Node,StrList.Strings[0],0);
//      TreeViewEn1.Items.AddChildObjectFirst(TmpNode,'Tables',0);
      Low := 1;
    end else Low := 0;
    ProgressBar1.Visible := True;
    ProgressBar1.Max := StrList.Count-Low;
    For i:= Low to StrList.Count-1 do
    begin
      TmpNode := TreeView1.Items.AddChildObject(Node,StrList.Strings[i],0);
      ProgressBar1.StepIt;
//      TreeViewEn1.Items.AddChildObjectFirst(TmpNode,'Tables',0);
    end;
    ProgressBar1.Visible := False;
    TreeView1.Items.EndUpdate;
  end;
end;

procedure TFormMain.TreeView1CustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if cdsSelected in State then
  begin
    if (TreeView1.Tag=-1) then
      TreeView1.Canvas.Font.Color := clYellow
    else begin
      TreeView1.Canvas.Font.Style := [fsBold];
      TreeView1.Canvas.Font.Color := clAqua;
    end;
  end;
  if (Node.Level=1) and (integer(Node.Data)=1) then begin
    if not(cdsSelected in State) then TreeView1.Canvas.Font.Color := clNavy;
    TreeView1.Canvas.Font.Style := [fsBold];
  end;
end;

procedure TFormMain.TreeView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P : TPoint;
begin
  if (mbRight=Button) then
  begin
    TmpNode := TreeView1.GetNodeAt(X,Y);
    if (TmpNode <> nil) and (TreeView1.Selected <> TmpNode) then TreeView1.Selected := TmpNode;
    if (TmpNode <> nil) and ((TmpNode.Level>0) or (TmpNode.Level<4))
    then begin
      P := TreeView1.ClientToScreen(Point(x,y));
      PopupMenu2.Popup(P.X,P.Y);
    end;
  end;
end;

procedure TFormMain.Open1Click(Sender: TObject);
begin
  TreeView1.Selected.Expand(False);
end;

procedure TFormMain.Close1Click(Sender: TObject);
var
  TD :TDataBase;
begin
  with TreeView1.Selected do
  if Integer(Data)=1 then
  begin
    Collapse(False);
    Item[0].DeleteChildren;
    TD := Session.FindDatabase(Text);
    if (TD <> nil) then TD.Connected := False;
    Data := 0;
    Item[0].Data := 0;
  end;
end;

procedure TFormMain.ShapeEx1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RichEdit1.Lines.Add(inttostr(ShapeEx1.VertScrollBar.Range));
end;

procedure TFormMain.TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
var
  i:integer;
  TD : TDataBase;
begin
  case Node.Level of
  1: begin
       if Integer(Node.Data)=1 then
       begin
         if Session.GetAliasDriverName(Node.Text)<>'STANDARD'
           then begin
             TD := Session.FindDatabase(Node.Text);
             if TD<>nil then TD.Connected := False;
           end;
       end;
     end;
    2: ;
  end;


end;

procedure TFormMain.PopupMenu2Popup(Sender: TObject);
begin
with TreeView1.Selected do
begin
  case Level of
  1 : begin
        if Data = Pointer(0)
          then begin Open1.Enabled := True; Close1.Enabled := False; end
          else begin Open1.Enabled := False; Close1.Enabled := True; end;
      end;
  2 : begin
        Open1.Enabled := not Expanded;
        Close1.Enabled := Expanded;
      end;
  else begin
    Open1.Enabled := False;
    Close1.Enabled := False;
  end;
  end;
  Rename1.Enabled := (Level=1) and (Data=Pointer(0)) or (Level=3);  
  Apply1.Enabled := (TreeView1.Tag <> -1) and (Level=1);
  Cancerl1.Enabled := Apply1.Enabled;
  Refresh1.Enabled := Close1.Enabled;
  Delete1.Enabled := (Level=1) and (Data=Pointer(0)) or (Level=3);
  New1.Enabled := TreeView.Tag = -1;
end;
end;

procedure TFormMain.Rename1Click(Sender: TObject);
var
//  P : TPoint;
  Htm : HTreeItem;
  NewName,ExtName : String;
  TD :TDataBase;
begin
  case TreeView1.Selected.Level of
  1: begin
       Htm := TreeView_GetSelection(TreeView1.Handle);
       TreeView1.Perform(TVM_EDITLABEL,0,Integer(Htm));  // TVM_SORTCHILDREN
     end;
  3: if (TreeView1.Selected.Parent.Index=0) then begin
       NewName := TreeView1.Selected.Text;
       ExtName := ExtractFileExt(NewName);
       if InputQuery2('Sae As NewTable','New TableName',NewName) then
       if Session.GetAliasDriverName(TreeView1.Selected.Parent.Parent.Text)<>'STANDARD' THEN
       begin
         Table1.Close;
         Session.GetTableNames(TreeView1.Selected.Parent.Parent.Text,'',True,False,TmpStrList);
         NewName := ExtractFileName(NewName);
         if TmpStrList.IndexOf(NewName+'.'+ExtName)>=0 then
         begin
           ShowMessage(NewName);
           ShowMessage('已经存在相同名字的表名，请重新指定新表名。')
         end
         else begin
           Table1.RenameTable(NewName);
           TreeView1.Selected.Text := NewName+'.'+ExtName;
         end;
       end
       ELSE Begin
         TD := Session.FindDatabase(TreeView1.Selected.Parent.Parent.Text);
         if TD<>nil then begin
           TD.Execute('select * from '+TreeView1.Selected.Text+' into '+NewName);
           TD.Execute('Drop table '+TreeView1.Selected.Text);
           TreeView1.Selected.Text := NewName+'.'+ExtName;
         end;
       end;
     end;
  end;
end;

Function TFormMain.IsOnlyOne(Tar : String):Boolean;
begin
  Session.GetAliasNames(TmpStrList);
  Result := TmpStrList.IndexOf(Tar)=-1;
  if not Result then
  begin
    ShowMessage('不能与已存在的别名相同');
//    PostMessage(Handle,CN_MYTEXTUNDO,0,0);
  end;
end;

procedure TFormMain.TreeView1Edited(Sender: TObject; Node: TTreeNode;
  var S: String);
begin
  if IsOnlyOne(S) then begin
    Node.Text := S;
    if S <> NodeText then
    begin
      TreeView1.Tag := 2;
      SortChildren;
    end;
  end
  else PostMessage(Handle,CN_MYTEXTUNDO,0,0);
end;

procedure TFormMain.TreeView1Editing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := (Node.Level=1) AND (Node.Data = Pointer(0));
  if AllowEdit and (TreeView1.Tag = -1) then NodeText := Node.Text;
end;

procedure TFormMain.BtnPrintClick(Sender: TObject);
begin
  if (PageControl1.ActivePage=TabSheet2) and (DBGridPrn1.FieldCount>0) then
  begin
    DBGridPrn1.LoadFromStream(BBStream);
    DBGridPrn1.Preview;
    DBGridPrn1.SaveToStream(BBStream);
  end
  else if (PageControl1.ActivePage=TabSheet3) and (DBGridPrn2.FieldCount>0) then
  begin
    DBGridPrn2.LoadFromStream(BBStream);
    DBGridPrn2.Preview;
    DBGridPrn2.SaveToStream(BBStream);
  end else ShowMessage('没有数据!'); 
end;

procedure TFormMain.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
  AllowChange := TreeView1.Tag = -1;
  //  if AllowChange then OldAliasNode := GetAliasNode(TreeView1.Selected);
end;

procedure TFormMain.Apply1Click(Sender: TObject);
var
  DriveName : String;
  i:integer;
begin
//  Session.GetAliasParams(NodeText,TmpStrList);
  if TreeView1.Tag = -1 then Exit;
  TmpStrList.Clear;
  For i:=1 to ShapeEx1.ActiveArea.RowCount-1 do
    TmpStrList.Add(ShapeEx1.ActiveArea.Items[i,0]+'='+ShapeEx1.ActiveArea.Items[i,1]);
  if TreeView1.Tag = 1 then
    Session.ModifyAlias(TreeView1.Selected.Text,TmpStrList)
  else begin
    DriveName := Session.GetAliasDriverName(NodeText);
    Session.DeleteAlias(NodeText);
    Session.AddAlias(TreeView1.Selected.Text,DriveName,TmpStrList);
  end;
  TreeView1.Tag := -1;
  Session.SaveConfigFile;
  TreeView1.Repaint;
end;

procedure TFormMain.SaveAs1Click(Sender: TObject);
var
  NewAlias,DriveName,NewTableName,ExtName : String;
  IsSqlBased : Boolean;
//  Fs :  TFieldDefs;
//  Idxf : TIndexDefs;
begin
  case TreeView1.Selected.Level of
  1: begin
       NewAlias := TreeView1.Selected.Text;
       if InputQuery2('Save Name As','New Alias Name',NewAlias)
         and IsOnlyOne(NewAlias) then
       begin
         DriveName := Session.GetAliasDriverName(TreeView1.Selected.Text);
         Session.GetAliasParams(TreeView1.Selected.Text,TmpStrList);
         Session.AddAlias(NewAlias,DriveName,TmpStrList);
         if TreeView1.Selected.Index = TreeView1.Selected.Parent.Count -1 then
           TmpNode := TreeView1.Items.AddObject(TreeView1.Selected,NewAlias,Pointer(0))
         else TmpNode := TreeView1.Items.InsertObject(TreeView1.Selected.Parent.Item[TreeView1.Selected.Index+1],NewAlias,Pointer(0));
         TreeView1.Items.AddChildObjectFirst(TmpNode,'Tables',Pointer(0));
         SortChildren;
       end;
     end;
  3: begin
       NewTableName := TreeView1.Selected.Text;
       IsSqlBased := Session.FindDatabase(TreeView1.Selected.Parent.Parent.Text).IsSQLBased;
       if Not IsSqlBased then
       begin
         NewTableName := ExtractFileName(NewTableName);
         ExtName := '.'+ExtractFileExt(TreeView1.Selected.Text);
       end;
       if InputQuery2('Save Name As','New Table Name',NewTableName) then
       begin
         Session.GetTableNames(TreeView1.Selected.Parent.Parent.Text,'',not IsSqlBased,False,TmpStrList);
         if not IsSqlBased then
           if not ('.'+ExtractFileExt(NewTableName)=ExtName) then
             NewTableName := NewTableName+ExtName;
         if TmpStrList.IndexOf(NewTableName)>=0 then
         begin
           ShowMessage('已经存在相同名字的表名，请重新指定新表名。')
         end
         else begin
           Table1.IndexDefs.Update;
           Table2.DatabaseName := Table1.DatabaseName;
           Table2.TableName := NewTableName;
           Table2.FieldDefs.Assign(Table1.FieldDefs);
           Table2.IndexDefs.Assign(Table1.IndexDefs);
           Table2.CreateTable;
           Table2.BatchMove(Table1,batAppend);
           TreeView1.Items.AddObject(TreeView1.Selected,NewTableName,0);
           SortChildren;
         end;
         {RichEdit1.Lines.Add('insert into '+NewTableName+' Select * from '+TreeView1.Selected.Text);
         Button1Click(nil);
         RichEdit1.Clear;}

{         if ShapeEx1.Items[0,1]='STANDARD' then
         begin
//           if ExtractFileExt(NewTableName)<>ExtractFileExt(TreeView1.Selected.Text)
  //           then NewTableName := ExtractFileName(NewTableName)+ExtractFileExt(TreeView1.Selected.Text);
//           NewTableName := ExtractFileName(NewTableName);
           FileCopy2(ShapeEx1.items[3,1]+'\'+TreeView1.Selected.Text,ShapeEx1.items[3,1]+'\');
           TreeView1.Items.AddObject(TreeView1.Selected,ShapeEx1.items[3,1]+'\'+NewTableName,0);
         end
         else begin
           RichEdit1.Lines.Add('Select * from '+TreeView1.Selected.Text+' into '+NewTableName);
           Button1Click(nil);
           RichEdit1.Clear;
           TreeView1.Items.AddObject(TreeView1.Selected,ShapeEx1.items[3,1]+'\'+NewTableName,0);
         end;}
       end;
    end;
  end;
end;

procedure FileCopy2(Sou,Tar:String);
var
  SHFileOpStruct: TSHFileOpStruct;
  FromDir: PChar;
  ToDir: PChar;
begin
  GetMem(FromDir, Length(Sou)+2);
  try
    GetMem(ToDir, Length(Tar)+2);
    try
      ZeroMemory(FromDir,Length(Sou)+2);
      ZeroMemory(ToDir,Length(Tar)+2);
      StrCopy(FromDir, PChar(Sou));
      StrCopy(ToDir, PChar(Tar));
      with SHFileOpStruct do
      begin
        Wnd    := Application.Handle;   // Assign the window handle
        wFunc  := FO_COPY;  // Specify a file copy
        pFrom  := FromDir;
        pTo    := ToDir;
        fFlags := FOF_NOCONFIRMATION or FOF_SILENT or FOF_RENAMEONCOLLISION;
        fAnyOperationsAborted := False;
        hNameMappings := nil;
        lpszProgressTitle := nil;
        if SHFileOperation(SHFileOpStruct) <> 0 then
          RaiseLastWin32Error;
      end;
    finally
      FreeMem(ToDir, Length(Sou)+2);
    end;
  finally
    FreeMem(FromDir, Length(Tar)+2);
  end;
end;

procedure TFormMain.Delete1Click(Sender: TObject);
var