unit_main.pas

来自「DELPHI的报表控件」· PAS 代码 · 共 1,445 行 · 第 1/4 页

  FileName : String;
begin
  Table1.Close;
  Query1.Close;
  case TreeView1.Selected.Level of
  1: begin
       Session.DeleteAlias(TreeView1.Selected.Text);
       Session.SaveConfigFile;
     end;
  3: begin
       Table1.DatabaseName := TreeView1.Selected.Parent.Parent.Text;
       Table1.TableName := TreeView1.Selected.Text;
//       RichEdit1.Lines.Add(TreeView1.Selected.Text);
       Table1.DeleteTable;
     end;
{       if ShapeEx1.Items[0,1]='STANDARD' then
       begin
         FileName := ShapeEx1.items[3,1]+'\'+TreeView1.Selected.Text;
         SetFileAttributes(PChar(FileName),0);
         DeleteFile(FileName);
       end
       else begin
         RichEdit1.Lines.Add('Drop Table '+TreeView1.Selected.Text);
         Button1Click(nil);
         RichEdit1.Clear;
       end;
     end;}
  end;
  TreeView1.Selected.Delete;
end;

procedure TFormMain.SortChildren();
var
  Htm : HTreeItem;
begin
  Htm := TreeView_GetSelection(TreeView1.Handle);
  Htm := TreeView_GetParent(TreeView1.Handle,htm);
  TreeView1.Perform(TVM_SORTCHILDREN,0,Integer(Htm));
end;

procedure TFormMain.Refresh1Click(Sender: TObject);
var
  NeedSysTable : Boolean;
begin
  case TreeView1.Selected.Level of
  1 : begin
        Close1Click(nil);
        Open1Click(nil);
      end;
  2 : case TreeView1.Selected.Index of
      0: begin
           TmpNode := TreeView1.Selected;
           TreeView1.Selected.DeleteChildren;
           NeedSysTable := Session.GetAliasDriverName(TmpNode.Parent.Text)='STANDARD';
           Session.GetTableNames(TmpNode.Parent.Text,'',NeedSysTable,False,TmpStrList);
           if TmpStrList.Count>0 then
           begin
             TmpStrList.Sort;
             AddSubStrings(TmpNode,TmpStrList);
             TmpNode.Expand(False);
           end;
         end;
         else ;
       end;
    {    TmpNode := TreeView1.Selected;
        Close1Click(nil);
        Open1Click(nil);
        TreeView1.Selected := TmpNode;
        TmpNode.Expand(False);}
  end;
end;

procedure TFormMain.Panel7Resize(Sender: TObject);
begin
//  DBNavigator1.Left := Panel7.ClientWidth - 318;
//  BtnPrint.Left := Panel7.ClientWidth - 35;
end;

procedure TFormMain.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then Exit;
  case PageControl1.ActivePage.PageIndex of
    1: begin
         if DBNavigator1.DataSource <> DataSource1
           then DBNavigator1.DataSource := DataSource1;
         DBNavigator1.Enabled := (TreeView1.Selected.Level=3);  // and PageControl1.ActivePage.TabVisible;
         if DBNavigator1.Enabled then DBNavigator1.Refresh;
       end;
    2: begin
         if DBNavigator1.DataSource <> DataSource2
           then DBNavigator1.DataSource := DataSource2;
         DBNavigator1.Enabled := True; //PageControl1.ActivePage.TabVisible;
         if DBNavigator1.Enabled then DBNavigator1.Refresh;
       end
    else DBNavigator1.Enabled := False;
  end;
end;

procedure TFormMain.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P : TPoint;
begin
  P := RichEdit1.ClientToScreen(Point(X,Y));
  if Sender=RichEdit1 then PopupMenu1.Tag := 0 else PopupMenu1.Tag := 1;
  PopupMenu1.Popup(P.X,P.Y);
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  TreeView1.Selected := TreeView1.Items[0];
  TreeView1.Selected.Expand(False);
//  WindowState := wsMaximized;
end;

procedure TFormMain.SpeedButton1Click(Sender: TObject);
begin
  Aboutbox.ShowModal;
end;

procedure TFormMain.New1Click(Sender: TObject);
var
  DriverType, NewAlias : string;
  List : TStrings;
  I : integer;
begin
  List := TStringList.Create;
  Session.GetDriverNames(TmpStrList);
  if InputQuery3('Create New AliasName','New DriverType',DriverType,TmpStrList) then
  begin
    Session.GetDriverParams(DriverType,TmpStrList);
    i := 1;
    Session.GetAliasNames(List);
    while List.IndexOf(DriverType+IntToStr(i))>= 0 do Inc(i);
    NewAlias :=DriverType+IntToStr(i);
    NodeText := NewAlias;
    List.Free;
    Session.AddAlias(NewAlias,DriverType,TmpStrList);
    if TreeView1.Items[0].HasChildren then
      TmpNode := TreeView1.Items.AddChildObject(TreeView1.Items[0],NewAlias,Pointer(0))
    else TmpNode := TreeView1.Items.AddChildObjectFirst(TreeView1.Items[0],NewAlias,Pointer(0));
    TreeView1.Items.AddChildObjectFirst(TmpNode,'Tables',0);
    TreeView1.Selected := TmpNode;
    TreeView1.Tag := 0;
  end;
{    ShapeEx1.ColCount := TmpStrList.Count;
    For i := 0 to TmpStrList.Count-1 do
    begin
      ShapeEx1.Clear;
      ShapeEx1.Items[i,0]:=TmpStrList[i];
     end;
  end;   }
end;

{procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
  case TreeView1.Selected.Level of
  3: if (TreeView1.Selected.Parent.Text='Tables') and Table1.Active then
     begin
       TreeView1.Items.AddChildFirst( TreeView1.Selected,'Fields');
       TreeView1.Items.AddChild(TreeView1.Selected,'Indexes');
       TreeView1.Selected.Expand(False);
     end;
  end;
end;}

procedure TFormMain.CNMYTEXTUNDO(var Message: TMessage);
begin
  TreeView1.Selected.Text := NodeText;
end;

procedure TFormMain.Filter1Click(Sender: TObject);
var
  FilterStr : String;
begin
  FilterStr := DBGridPrn1.SelectedField.DisplayName+'=';
  if InputQuery2('Set Filter','Enter Filter String',FilterStr) then
  begin
    Table1.Close;
    Table1.Filter := FilterStr;
    Table1.Filtered := True;
    try
      Table1.Open;
    except
      Table1.Close;
      Table1.Filtered := False;
      Table1.Filter := '';
      Table1.Open;
      raise;  
    end;
  end;
end;

procedure TFormMain.N10Click(Sender: TObject);
begin
  Clipboard.AsText := DBGridPrn1.SelectedField.DisplayText;
end;

procedure TFormMain.PopupMenu3Popup(Sender: TObject);
begin
  N10.Enabled := DBGridPrn1.SelectedIndex>=0;
end;

procedure TFormMain.TreeView1Expanded(Sender: TObject; Node: TTreeNode);
begin
  if (Node.Level=1) and (PageControl1.ActivePage=TabSheet1) then ShapeEx1.ShowBtnType:=sbtNone;
end;

procedure TFormMain.Cancerl1Click(Sender: TObject);
begin
  TreeView1.Selected.Text := NodeText;
  TreeView1.Tag := -1;
  TreeView1Change(self,TreeView1.Selected);
end;

procedure TFormMain.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
{  case PageControl1.ActivePage.PageIndex of
    1: if Table1.Active then Table1.Close;
    2: if Query1.Active then Query1.Close;
  end;}
end;

function TFormMain.GetAliasNode(Node:TTreeNode): TTreeNode;
var
  i  : integer;
begin
  if (Node=nil) or (Node.Level=0) then Result := nil
  else begin
    while Node.Level>1 do Node := Node.Parent;
    Result := Node;
  end;
end;

procedure TFormMain.SpeedButton5Click(Sender: TObject);
var
  Form_DBGridPrnEditor: TForm_DBGridPrnEditor;
begin
  try
    Form_DBGridPrnEditor:= TForm_DBGridPrnEditor.Create(nil);
    Form_DBGridPrnEditor.DBGridPrn := DBGridPrn1;
    if Form_DBGridPrnEditor.ShowModal=mrOK then
    begin
      DBGridPrn2.Assign(DBGridPrn1);
      DBGridPrn1.SaveToStream(BBStream);
    end;  
  finally
    Form_DBGridPrnEditor.Free;
  end;
end;

procedure TFormMain.ShapeEx1Changing(Sender: TObject; Cell: TCellUnitEx;
  var AllowChange: Boolean);
begin
  if Cell.GridArea<>nil then
  case TreeView1.Selected.Level of
  1: begin
       AllowChange := (Cell.Col=1) and (Cell.Row>0);
       if (not AllowChange) and (Cell.Row>0) then ShapeEx1.SelectedCell(ShapeEx1.CellUnitEx(Cell.Row,1,ShapeEx1.ActiveArea),True);
     end;
  4: begin
       AllowChange := Cell.Row>0;
     end;
  end;
end;

procedure TFormMain.ShapeEx1EditingCell(Sender: TObject; Cell: TCellUnitEx;
  var AllowEditing: Boolean);
begin
//  with TGridArea(Cell.GridArea),Cell do
  AllowEditing := (Cell.Col=1) and (Cell.Row>0) and (TreeView1.Selected.Level=1)
    and (TreeView1.Selected.Data=Pointer(0)) and (ShapeEx1.ShowBtnType<>sbtList);
end;

procedure TFormMain.ShapeEx1DrawingCell(Sender: TObject; ACanvas: TCanvas;
  Cell: TCellUnitEx; ACellState: TCellStates; ARect: TRect; Text: String;
  var DefaultDraw: Boolean);
begin
  if not(csFocused in ACellState) then
  case TreeView1.Selected.Level of
  1: if (Cell.Col=0) then begin
       ACanvas.Font.Color := clNavy;
       ACanvas.Font.Style := [fsBold];
     end
     else if Cell.Row=0 then ACanvas.Font.Style := [fsBold];
  4: if (Cell.Row=0) then begin
       ACanvas.Brush.Color := clBtnFace;
       ACanvas.Font.Color := clNavy;
       ACanvas.Font.Style := [fsBold];
     end
     else if (Cell.Col=0) then begin
       ACanvas.Font.Color := clTeal;
       ACanvas.Font.Style := [fsBold];
     end;
  end;

end;

procedure TFormMain.ShapeEx1EditedCell(Sender: TObject; Cell: TCellUnitEx;
  AType: TEditingCellType);
begin
  if TreeView1.Tag = -1 then
  begin
    TreeView1.Tag := 1;
    NodeText := TreeView1.Selected.Text;
  end;

end;

procedure TFormMain.ShapeEx1BeforeShowBtn(Sender: TObject;
  Cell: TCellUnitEx; var AShowBtnType: TShowBtnType; ACaption: String;
  ABitmap: TBitmap);
begin
  if (TreeView1.Selected.Level<>1) or (TreeView1.Selected.Data<>Pointer(0)) then
  begin
    ShapeEx1.ShowBtnType := sbtNone;
    Exit;
  end;
  with ShapeEx1,ActiveArea do begin
  case TreeView1.Selected.Level of
  1: if Items[0,1]='STANDARD' then
     case Selection.One.Row of
     1: begin
          AShowBtnType :=sbtList;
          ListSel.Items.Clear;
          ListSel.Items.Add('PARADOX');
          ListSel.Items.Add('DBASE');
          ListSel.Items.Add('FOXPRO');
          ListSel.Items.Add('ASCIIDRV');
        end;
     2: begin
          AShowBtnType :=sbtList;
          ListSel.Items.Clear;
          ListSel.Items.Add('TRUE');
          ListSel.Items.Add('FALSE');
        end;
     3: begin
          AShowBtnType :=sbtDirDlg;
        end;
     END
     else begin
       if strpos(PChar(ShapeEx1.ActiveArea.items[Selection.One.Row,0]),'DATABASE NAME')<>NIL
         then AShowBtnType:=sbtFileDlg
         else if (items[Selection.One.Row,1]='TRUE') OR (items[Selection.One.Row,1]='FALSE')
           then BEGIN
             AShowBtnType:=sbtList;
             ListSel.Items.Clear;
             ListSel.Items.Add('TRUE');
             ListSel.Items.Add('FALSE');
           END
         else AShowBtnType := sbtNone;
     end;
  end;
  end;
end;

end.