📄 unit1.pas
字号:
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 + -