⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 Ehlib 4.14 full source for bds2006
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    end;
  end;
end;

procedure TForm1.dbgListDragDrop(Sender, Source: TObject; X, Y: Integer);
var i,j:Integer;
begin
  if Source = dbgList1 then begin
    dbgList.DataSource.DataSet.DisableControls;
    dbgList1.DataSource.DataSet.DisableControls;
    dbgList.SaveBookmark;
    if dbgList1.Selection.SelectionType = gstRecordBookmarks then
      for i := 0 to dbgList1.SelectedRows.Count-1 do
      begin
        dbgList1.DataSource.DataSet.Bookmark := dbgList1.SelectedRows[I];
        dbgList.DataSource.DataSet.Append;
        dbgList.DataSource.DataSet.Edit;
        for j := 0 to dbgList.DataSource.DataSet.FieldCount-1 do
          dbgList.DataSource.DataSet.Fields[j].Value := dbgList1.DataSource.DataSet.Fields[j].Value;
        dbgList.DataSource.DataSet.Post;
      end
    else if dbgList1.Selection.SelectionType = gstAll then begin
      dbgList1.DataSource.DataSet.First;
      while  dbgList1.DataSource.DataSet.EOF = False do begin
        dbgList.DataSource.DataSet.Append;
        dbgList.DataSource.DataSet.Edit;
        for j := 0 to dbgList.DataSource.DataSet.FieldCount-1 do
          dbgList.DataSource.DataSet.Fields[j].Value := dbgList1.DataSource.DataSet.Fields[j].Value;
        dbgList.DataSource.DataSet.Post;
        dbgList1.DataSource.DataSet.Delete;
      end;
      dbgList1.Selection.Clear;
    end;
    dbgList.RestoreBookmark;
    dbgList1.SelectedRows.Delete;
    dbgList1.DataSource.DataSet.Refresh;
    dbgList1.DataSource.DataSet.EnableControls;
    dbgList.DataSource.DataSet.EnableControls;
  end;
end;

procedure TForm1.dbgListDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source = dbgList1 then Accept := True else Accept := False;
end;

procedure TForm1.dbgListStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
{
              ABOUT DRAG & DROP DATA BETWEEN APPLICATIONS.
  Standard drag and drop capacity don't support interapplication interaction.
  To ensure drag and drop from one application to over need use over tools.
  One of such tools is DRAG & DROP COMPONENT SUITE VERSION by Angus Johnson &
  Anders Melander.
  This is a set of components that implements Dragging & Dropping of data
  between applications.
  These components implement the COM interfaces - IDataObject, IDropSource and
  IDropTarget which are the backbone of Windows drag-and-drop.
  The homesite for the Drag and Drop Component Suite is http://www.melander.dk.
  To make use this component download it, install DRAG & DROP COMPONENT SUITE
  VERSION to Delphi , drop TDropTextSource on this Form, do visible
  cbInterAppDragNDrop checkbox and uncomment below text.
  It give you capacity to drag grid info in such applications as Excel or Word
}

//  if not cbInterAppDragNDrop.Checked then Exit;
//  CancelDrag;
//  DropTextSource1.Text := GridSelectionAsText(dbgList);
//  DropTextSource1.Execute;

end;

procedure TForm1.dbgList1DragDrop(Sender, Source: TObject; X, Y: Integer);
var i,j:Integer;
begin
  if Source = dbgList then begin
    dbgList1.DataSource.DataSet.DisableControls;
    dbgList.DataSource.DataSet.DisableControls;
    dbgList1.SaveBookmark;
    if dbgList.Selection.SelectionType = gstRecordBookmarks then
      for i := 0 to dbgList.SelectedRows.Count-1 do
      begin
        dbgList.DataSource.DataSet.Bookmark := dbgList.SelectedRows[I];
        dbgList1.DataSource.DataSet.Append;
        dbgList1.DataSource.DataSet.Edit;
        for j := 0 to dbgList1.DataSource.DataSet.FieldCount-1 do
          dbgList1.DataSource.DataSet.Fields[j].Value := dbgList.DataSource.DataSet.Fields[j].Value;
        dbgList1.DataSource.DataSet.Post;
      end
    else if dbgList.Selection.SelectionType = gstAll then begin
      dbgList.DataSource.DataSet.First;
      while  dbgList.DataSource.DataSet.EOF = False do begin
        dbgList1.DataSource.DataSet.Append;
        dbgList1.DataSource.DataSet.Edit;
        for j := 0 to dbgList1.DataSource.DataSet.FieldCount-1 do
          dbgList1.DataSource.DataSet.Fields[j].Value := dbgList.DataSource.DataSet.Fields[j].Value;
        dbgList1.DataSource.DataSet.Post;
        dbgList.DataSource.DataSet.Delete;
      end;
      dbgList.Selection.Clear;
    end;
    dbgList1.RestoreBookmark;
    dbgList.SelectedRows.Delete;
    dbgList.DataSource.DataSet.Refresh;
    dbgList.DataSource.DataSet.EnableControls;
    dbgList1.DataSource.DataSet.EnableControls;
  end;
end;

procedure TForm1.dbgList1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source = dbgList then Accept := True else Accept := False;
end;

procedure TForm1.cbDragNDropClick(Sender: TObject);
begin
  if cbDragNDrop.Checked then begin
    dbgList.DragMode := dmAutomatic;
    dbgList1.Visible := True and not cbInterAppDragNDrop.Checked;
  end
  else begin
    dbgList.DragMode := dmManual;
    dbgList1.Visible := False;
  end;
end;

procedure TForm1.cbDichromaticClick(Sender: TObject);
begin
  dbgList.Invalidate;
end;

procedure TForm1.dbgListGetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if cbDichromatic.Checked then
    if dbgList.SumList.RecNo mod 2 = 1 then
      Background := $00FFC4C4
    else
      Background := $00FFDDDD;
end;

procedure TForm1.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
  // Under Delphi 4 and upper better to user Actions to determine
  // enablitity buttons and menus
  bbCopy.Enabled := DBGridEh1.Selection.SelectionType <> gstNon;
  if ActiveControl is TDBGridEh then
  with TDBGridEh(ActiveControl) do
    begin
      ppmCut.Enabled := CheckCutAction and (geaCutEh in EditActions);
      ppmCopy.Enabled := CheckCopyAction and (geaCopyEh in EditActions);
      ppmPaste.Enabled := CheckPasteAction and (geaPasteEh in EditActions);
      ppmDelete.Enabled := CheckDeleteAction and (geaDeleteEh in EditActions);
      ppmSelectAll.Enabled := CheckSelectAllAction and (geaSelectAllEh in EditActions);
      ppmSaveSelection.Enabled := CheckCopyAction and (geaCopyEh in EditActions);
      ppmPreview.Enabled := True;
    end;
end;

procedure TForm1.bbCopyClick(Sender: TObject);
begin
  // old style Clipboard.AsText := GridSelectionAsText(DBGridEh1);
  DBGridEh_DoCopyAction(DBGridEh1,False);
end;

procedure TForm1.DBGridEh1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_INSERT) and ([ssCtrl] = Shift) then
    Clipboard.AsText := GridSelectionAsText(DBGridEh1);
end;

procedure TForm1.cbInterAppDragNDropClick(Sender: TObject);
begin
  dbgList1.Visible := True and not cbInterAppDragNDrop.Checked;
end;

procedure TForm1.DBGridEh2EditButtonClick(Sender: TObject);
var vn,vs:String;
begin
  vn := DataModule1.Query1.FieldByName('VNo').AsString;
  if Form2.Execute(DBGridEh2.InplaceEditor,vn,vs) then
  begin
    DataModule1.Query1.Edit;
    DataModule1.Query1.FieldByName('VNo').AsString := vn;
    DataModule1.Query1.FieldByName('VName').AsString := vs;
    DataModule1.Query1.Post;
  end;
end;

procedure TForm1.ppmCutClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
    with TDBGridEh(ActiveControl) do
      if CheckCutAction and (geaCutEh in EditActions) then
        DBGridEh_DoCutAction(TDBGridEh(ActiveControl),False);
end;

procedure TForm1.ppmCopyClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
    with TDBGridEh(ActiveControl) do
      if CheckCopyAction and (geaCopyEh in EditActions) then
        DBGridEh_DoCopyAction(TDBGridEh(ActiveControl),False);
end;

procedure TForm1.ppmPasteClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
    with TDBGridEh(ActiveControl) do
      if CheckPasteAction and (geaPasteEh in EditActions) then
        DBGridEh_DoPasteAction(TDBGridEh(ActiveControl),False);
end;

procedure TForm1.ppmDeleteClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
    with TDBGridEh(ActiveControl) do
      if CheckDeleteAction and (geaDeleteEh in EditActions) then
        DBGridEh_DoDeleteAction(TDBGridEh(ActiveControl),False);
end;

procedure TForm1.ppmSelectAllClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
    with TDBGridEh(ActiveControl) do
      if CheckSelectAllAction and (geaSelectAllEh in EditActions) then
        Selection.SelectAll;
end;

procedure TForm1.ppmPreviewClick(Sender: TObject);
begin
  if (ActiveControl is TDBGridEh) then
  begin
    PrintDBGridEh1.DBGridEh := TDBGridEh(ActiveControl);
    PrintDBGridEh1.SetSubstitutes(['%[Today]',DateToStr(Now)]);
    PrintDBGridEh1.Preview;
  end;
end;

procedure TForm1.ppmSaveSelectionClick(Sender: TObject);
var ExpClass:TDBGridEhExportClass;
    Ext:String;
begin
  SaveDialog1.FileName := 'file1';
  if (ActiveControl is TDBGridEh) then
    if SaveDialog1.Execute then
    begin
      case SaveDialog1.FilterIndex of
        1: begin ExpClass := TDBGridEhExportAsText; Ext := 'txt'; end;
        2: begin ExpClass := TDBGridEhExportAsCSV; Ext := 'csv'; end;
        3: begin ExpClass := TDBGridEhExportAsHTML; Ext := 'htm'; end;
        4: begin ExpClass := TDBGridEhExportAsRTF; Ext := 'rtf'; end;
        5: begin ExpClass := TDBGridEhExportAsXLS; Ext := 'xls'; end;
      else
        ExpClass := nil; Ext := '';
      end;
      if ExpClass <> nil then
      begin
        if UpperCase(Copy(SaveDialog1.FileName,Length(SaveDialog1.FileName)-2,3)) <>
           UpperCase(Ext) then
          SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;
        SaveDBGridEhToExportFile(ExpClass,TDBGridEh(ActiveControl),
             SaveDialog1.FileName,False);
      end;
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FilterControlList.Free;
end;

procedure TForm1.DBGridEh1ColWidthsChanged(Sender: TObject);
var Indent,i,k:Integer;
    control:TControl;
begin
    if not Assigned(FilterControlList) then Exit;
    Indent := IndicatorWidth+2;
    for i := 0 to DBGridEh1.Columns.Count-1 do
    begin
      k := FilterControlList.IndexOf(DBGridEh1.Columns.Items[i].FieldName);
      if (k <> -1) then
      begin
        control := (TControl(FilterControlList.Objects[k]));
        control.Left := Indent+1;
        control.Width := DBGridEh1.Columns.Items[i].Width-1;
      end;
      Indent := Indent+DBGridEh1.Columns.Items[i].Width+1;
    end;
end;

procedure TForm1.DBLookupComboboxEh1KeyValueChanged(Sender: TObject);
begin
  UpdateQuery1Filter;
end;

procedure TForm1.DBLookupComboboxEh2KeyValueChanged(Sender: TObject);
begin
  UpdateQuery1Filter;
end;

procedure TForm1.UpdateQuery1Filter;
var s:String;
begin
  s := '';
{  if DBLookupComboboxEh1.KeyValue <> Null then
    s := 'VNo = ' + VarToStr(DBLookupComboboxEh1.KeyValue);
  if DBLookupComboboxEh2.KeyValue <> Null then
    if s <> '' then
      s := s + ' And  PDescription = ''' + VarToStr(DBLookupComboboxEh2.KeyValue) + ''''
    else
      s := 'PDescription = ''' + VarToStr(DBLookupComboboxEh2.KeyValue) + '''';}
  DataModule1.Query1.Filter := s;
end;

procedure TForm1.DBGridEh1Columns1DropDownBoxGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
 if DataModule1.qrVendors.FieldValues['State'] = 'CA' then
    AFont.Color := clRed;
end;

var
  IniPropStorageMan: TIniPropStorageManEh;

procedure TForm1.DBComboBoxEh1GetItemImageIndex(Sender: TObject;
  ItemIndex: Integer; var ImageIndex: Integer);
begin
  ImageIndex := -1;
  case ItemIndex of
   2: ImageIndex := 1;
   5: ImageIndex := 3;
   6: ImageIndex := 0;
   4: ImageIndex := 2;
  end;
end;

initialization
  IniPropStorageMan := TIniPropStorageManEh.Create(nil);
  IniPropStorageMan.IniFileName := ExtractFileDir(ParamStr(0)) + '\Demo1.Ini';
  SetDefaultPropStorageManager(IniPropStorageMan);
  DBGridEhDefaultStyle.FilterEditCloseUpApplyFilter := True;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -