📄 unit1.pas
字号:
unit Unit1;
{$I EhLib.Inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF CIL}
Types, System.ComponentModel, Variants, System.Runtime.InteropServices,
{$ELSE}
{$ENDIF}
StdCtrls, DBCtrls, ExtCtrls, DBGridEh, ComCtrls, Db, DBTables,
Buttons, PrViewEh, PrnDbgeh, ToolWin, Menus, DBGridEhImpExp,
Mask, DBLookupEh, DBCtrlsEh, ImgList, EhLibBDE, PropStorageEh, GridsEh,
PropFilerEh;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
DBGridEh1: TDBGridEh;
Panel1: TPanel;
TabSheet2: TTabSheet;
DBGridEh2: TDBGridEh;
TabSheet3: TTabSheet;
DBGridEh3: TDBGridEh;
DBGridEh4: TDBGridEh;
DBNavigator2: TDBNavigator;
DBNavigator3: TDBNavigator;
TabSheet4: TTabSheet;
DBGridEh5: TDBGridEh;
TabSheet5: TTabSheet;
Panel3: TPanel;
cbClearSelection: TCheckBox;
cbShowIndicator: TCheckBox;
cbTitle: TCheckBox;
cbHighlightFocus: TCheckBox;
cbMultiselect: TCheckBox;
PreviewSetupPanel: TPanel;
bPrint: TButton;
bPrinterSetup: TButton;
bPrevPage: TButton;
bNextPage: TButton;
bStop: TButton;
bClosePreview: TButton;
PreviewBox1: TPreviewBox;
bInpPreview: TButton;
bPreview: TButton;
bOpenClose: TButton;
lPageinfo: TLabel;
cCustomPreview: TButton;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
dbgList1: TDBGridEh;
dbgList: TDBGridEh;
cbDragNDrop: TCheckBox;
cbDichromatic: TCheckBox;
bbCopy: TBitBtn;
cbInterAppDragNDrop: TCheckBox;
TabSheet6: TTabSheet;
DBEditEh1: TDBEditEh;
DBDateTimeEditEh1: TDBDateTimeEditEh;
DBNumberEditEh1: TDBNumberEditEh;
DBComboBoxEh1: TDBComboBoxEh;
DBLookupComboboxEh3: TDBLookupComboboxEh;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
DBGridEh6: TDBGridEh;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Bevel1: TBevel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
DBLookupComboboxEh4: TDBLookupComboboxEh;
Label20: TLabel;
DBDateTimeEditEh2: TDBDateTimeEditEh;
Label21: TLabel;
DBNumberEditEh2: TDBNumberEditEh;
Label22: TLabel;
DBEditEh2: TDBEditEh;
Label23: TLabel;
DBComboBoxEh2: TDBComboBoxEh;
DBNavigator1: TDBNavigator;
PrintDBGridEh1: TPrintDBGridEh;
PopupMenu1: TPopupMenu;
ppmCut: TMenuItem;
ppmCopy: TMenuItem;
ppmPaste: TMenuItem;
ppmDelete: TMenuItem;
ppmSelectAll: TMenuItem;
N1: TMenuItem;
ppmPreview: TMenuItem;
ppmSaveSelection: TMenuItem;
pmNoVisibleCols: TPopupMenu;
SaveDialog1: TSaveDialog;
DBCheckBoxEh1: TDBCheckBoxEh;
Label24: TLabel;
DBCheckBoxEh2: TDBCheckBoxEh;
PropStorageEh1: TPropStorageEh;
procedure bOpenCloseClick(Sender: TObject);
procedure Query1UpdateRecord(DataSet: TDataSet;
UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
procedure DBGridEh2DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
procedure DBGridEh2DrawFooterCell(Sender: TObject; DataCol,
Row: Integer; Column: TColumnEh; Rect: TRect; State: TGridDrawState);
procedure DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
AFont: TFont; var Background: TColor; State: TGridDrawState);
procedure DBGridEh2GetFooterParams(Sender: TObject; DataCol,
Row: Integer; Column: TColumnEh; AFont: TFont;
var Background: TColor; var Alignment: TAlignment;
State: TGridDrawState; var Text: String);
procedure DBGridEh1TitleBtnClick(Sender: TObject; ACol: Integer;
Column: TColumnEh);
procedure cbClearSelectionClick(Sender: TObject);
procedure cbShowIndicatorClick(Sender: TObject);
procedure cbTitleClick(Sender: TObject);
procedure cbHighlightFocusClick(Sender: TObject);
procedure cbMultiselectClick(Sender: TObject);
procedure DBGridEh1SortMarkingChanged(Sender: TObject);
procedure bPrintClick(Sender: TObject);
procedure bPrinterSetupClick(Sender: TObject);
procedure bPrevPageClick(Sender: TObject);
procedure bNextPageClick(Sender: TObject);
procedure bStopClick(Sender: TObject);
procedure bClosePreviewClick(Sender: TObject);
procedure bPreviewClick(Sender: TObject);
procedure bInpPreviewClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PreviewBox1PrinterPreviewChanged(Sender: TObject);
procedure cCustomPreviewClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure dbgListDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure dbgListDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure dbgListStartDrag(Sender: TObject;
var DragObject: TDragObject);
procedure dbgList1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure dbgList1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure cbDragNDropClick(Sender: TObject);
procedure cbDichromaticClick(Sender: TObject);
procedure dbgListGetCellParams(Sender: TObject; Column: TColumnEh;
AFont: TFont; var Background: TColor; State: TGridDrawState);
procedure bbCopyClick(Sender: TObject);
procedure DBGridEh1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cbInterAppDragNDropClick(Sender: TObject);
procedure DBGridEh2EditButtonClick(Sender: TObject);
procedure ppmCutClick(Sender: TObject);
procedure ppmCopyClick(Sender: TObject);
procedure ppmPasteClick(Sender: TObject);
procedure ppmDeleteClick(Sender: TObject);
procedure ppmSelectAllClick(Sender: TObject);
procedure ppmPreviewClick(Sender: TObject);
procedure ppmSaveSelectionClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DBGridEh1ColWidthsChanged(Sender: TObject);
procedure DBLookupComboboxEh1KeyValueChanged(Sender: TObject);
procedure DBLookupComboboxEh2KeyValueChanged(Sender: TObject);
procedure DBGridEh1Columns1DropDownBoxGetCellParams(Sender: TObject;
Column: TColumnEh; AFont: TFont; var Background: TColor;
State: TGridDrawState);
procedure DBComboBoxEh1GetItemImageIndex(Sender: TObject;
ItemIndex: Integer; var ImageIndex: Integer);
private
{ Private declarations }
DBGridEhPreviewIndicatorMenuItem: TDBGridEhMenuItem;
public
FilterControlList: TStringList;
procedure InplacePreviewSetupDialog(Sender: TObject);
procedure ColumnMenuItem(Sender: TObject);
function GridSelectionAsText(AGrid:TDBGridEh):String;
procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
procedure UpdateQuery1Filter;
procedure BuildIndicatorTitleMenu(Grid: TCustomDBGridEh; var PopupMenu: TPopupMenu);
procedure MenuEditClick(Sender: TObject);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses CustPrev, clipbrd, Unit2, DM1;
{$R *.DFM}
{$IFDEF CIL}
function DataSetCompareBookmarks(DataSet: TDataSet; Bookmark1, Bookmark2: TBookmarkStr): Integer;
var
I1, I2: IntPtr;
begin
try
I1 := Marshal.StringToHGlobalAnsi(Bookmark1);
I2 := Marshal.StringToHGlobalAnsi(Bookmark1);
Result := DataSet.CompareBookmarks(TBookmark(I1), TBookmark(I2));
finally
Marshal.FreeHGlobal(I1);
if Assigned(I2) then
Marshal.FreeHGlobal(I2);
end;
end;
{$ELSE}
function DataSetCompareBookmarks(DataSet: TDataSet; Bookmark1, Bookmark2: TBookmarkStr): Integer;
begin
Result := DataSet.CompareBookmarks(TBookmark(Bookmark1), TBookmark(Bookmark2));
end;
{$ENDIF}
procedure TForm1.bOpenCloseClick(Sender: TObject);
begin
if (DataModule1.Query1.Active = False) then begin
DataModule1.Query1.Active := True;
bOpenClose.Caption := 'Close';
end else begin
DataModule1.Query1.Active := False;
bOpenClose.Caption := 'Open';
end;
end;
procedure TForm1.Query1UpdateRecord(DataSet: TDataSet;
UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
//
end;
procedure TForm1.DBGridEh2DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumnEh;
State: TGridDrawState);
begin
if (Rect.Top = DBGridEh2.CellRect(DBGridEh2.Col,DBGridEh2.Row).Top) and (not (gdFocused in State) or not DBGridEh2.Focused) then
DBGridEh2.Canvas.Brush.Color := clAqua;
DBGridEh2.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
procedure TForm1.DBGridEh2DrawFooterCell(Sender: TObject; DataCol,
Row: Integer; Column: TColumnEh; Rect: TRect; State: TGridDrawState);
begin
DBGridEh2.DefaultDrawFooterCell(Rect,DataCol,Row,Column,State);
end;
procedure TForm1.DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
if DataModule1.Query1.FieldByName('IQty').Text = '17' then
AFont.Style := AFont.Style + [fsBold];
end;
procedure TForm1.DBGridEh2GetFooterParams(Sender: TObject; DataCol,
Row: Integer; Column: TColumnEh; AFont: TFont; var Background: TColor;
var Alignment: TAlignment; State: TGridDrawState; var Text: String);
begin
if (Column.Field.FieldName = 'PDescription') then Text := 'Qty = ' + Text
else if (Column.Field.FieldName = 'VName') then Text := Text + ' records';
end;
procedure TForm1.DBGridEh1TitleBtnClick(Sender: TObject; ACol: Integer;
Column: TColumnEh);
begin
{ case Column.Title.SortMarker of
smNoneEh: Column.Title.SortMarker := smDownEh;
smDownEh: Column.Title.SortMarker := smUpEh;
smUpEh: Column.Title.SortMarker := smNoneEh;
end;}
end;
procedure TForm1.cbClearSelectionClick(Sender: TObject);
begin
if cbClearSelection.Checked then
dbgList.OptionsEh := dbgList.OptionsEh + [dghClearSelection]
else
dbgList.OptionsEh := dbgList.OptionsEh - [dghClearSelection];
end;
procedure TForm1.cbShowIndicatorClick(Sender: TObject);
begin
if cbShowIndicator.Checked then
dbgList.Options := dbgList.Options + [dgIndicator]
else
dbgList.Options := dbgList.Options - [dgIndicator];
end;
procedure TForm1.cbTitleClick(Sender: TObject);
begin
if cbTitle.Checked then
dbgList.Options := dbgList.Options + [dgTitles]
else
dbgList.Options := dbgList.Options - [dgTitles];
end;
procedure TForm1.cbHighlightFocusClick(Sender: TObject);
begin
if cbHighlightFocus.Checked then
dbgList.OptionsEh := dbgList.OptionsEh + [dghHighlightFocus]
else
dbgList.OptionsEh := dbgList.OptionsEh - [dghHighlightFocus];
end;
procedure TForm1.cbMultiselectClick(Sender: TObject);
begin
if cbMultiselect.Checked then
dbgList.Options := dbgList.Options + [dgMultiselect]
else
dbgList.Options := dbgList.Options - [dgMultiselect];
end;
procedure TForm1.DBGridEh1SortMarkingChanged(Sender: TObject);
var i :Integer;
s:String;
function DeleteStr(str:String; sunstr:String): String;
var i:Integer;
begin
i := Pos(sunstr,str);
if i <> 0 then Delete(str,i,Length(sunstr));
Result := str;
end;
begin
s := '';
for i := 0 to DBGridEh1.SortMarkedColumns.Count-1 do
if DBGridEh1.SortMarkedColumns[i].Title.SortMarker = smUpEh then
s := s + DBGridEh1.SortMarkedColumns[i].FieldName + ' DESC , '
else
s := s + DBGridEh1.SortMarkedColumns[i].FieldName + ', ';
if s <> '' then s := ' ORDER BY ' + Copy(s,1,Length(s)-2);
s := DeleteStr(s,'1');
DataModule1.Query1.SQL.Strings[DataModule1.Query1.SQL.Count-2] := s;
DataModule1.Query1.Close;
DataModule1.Query1.Open;
end;
procedure TForm1.bPreviewClick(Sender: TObject);
begin
PrintDBGridEh1.DBGridEh := DBGridEh1;
PrintDBGridEh1.SetSubstitutes(['%[Today]',DateToStr(Now)]);
PrintDBGridEh1.Preview;
end;
procedure TForm1.bInpPreviewClick(Sender: TObject);
begin
DBGridEh1.Visible := False;
Panel1.Visible := False;
PreviewBox1.Visible := True;
PreviewSetupPanel.Visible := True;
PreviewBox1.Printer.PrinterSetupOwner := DBGridEh1;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -