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

📄 unit1.pas

📁 最新的 DBGRIDEH4.0
💻 PAS
📖 第 1 页 / 共 3 页
字号:
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 + -