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

📄 dittou.pas

📁 InfoPower_Studio 2007 v5.0.1.3 banben
💻 PAS
字号:
unit dittou;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, wwclearbuttongroup, wwradiogroup, Db, DBTables,
  Wwtable, Wwdatsrc, ExtCtrls, Grids, Wwdbigrd, Wwdbgrid, ComCtrls,
  wwriched, wwSpeedButton, wwDBNavigator, wwclearpanel, Menus;

type
  TDittoForm = class(TForm)
    Panel1: TPanel;
    Bevel1: TBevel;
    wwDataSource1: TwwDataSource;
    wwTable1: TwwTable;
    Panel2: TPanel;
    Panel3: TPanel;
    Bevel2: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    wwRadioGroup2: TwwRadioGroup;
    CheckListBox1: TCheckListBox;
    Label1: TLabel;
    Panel5: TPanel;
    wwDBRichEdit1: TwwDBRichEdit;
    Image1: TImage;
    Panel6: TPanel;
    wwDBGrid1: TwwDBGrid;
    Panel7: TPanel;
    wwDBNavigator1: TwwDBNavigator;
    wwDBNavigator1First: TwwNavButton;
    wwDBNavigator1PriorPage: TwwNavButton;
    wwDBNavigator1Prior: TwwNavButton;
    wwDBNavigator1Next: TwwNavButton;
    wwDBNavigator1NextPage: TwwNavButton;
    wwDBNavigator1Last: TwwNavButton;
    wwDBNavigator1Insert: TwwNavButton;
    wwDBNavigator1Delete: TwwNavButton;
    wwDBNavigator1Edit: TwwNavButton;
    wwDBNavigator1Post: TwwNavButton;
    wwDBNavigator1Cancel: TwwNavButton;
    wwDBNavigator1Refresh: TwwNavButton;
    wwDBNavigator1SaveBookmark: TwwNavButton;
    wwDBNavigator1RestoreBookmark: TwwNavButton;
    Image2: TImage;
    MainMenu1: TMainMenu;
    procedure CheckListBox1ClickCheck(Sender: TObject);
    procedure CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure wwDBGrid1Ditto(Sender: TObject; DataSet: TDataSet;
      Field: TField; var DittoValue: String; var AllowDitto: Boolean);
    procedure FormShow(Sender: TObject);
    procedure wwRadioGroup2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DittoForm: TDittoForm;

implementation

{$R *.DFM}

procedure TDittoForm.CheckListBox1ClickCheck(Sender: TObject);
begin
   (Sender as TCheckListBox).checked[0] := False;
end;

type tc=Class(TCheckListBox);

procedure TDittoForm.CheckListBox1DrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  cb: TCheckListbox;
begin
  cb:= control as TCheckListbox;
  If (index = 0) and not (odSelected In State) Then
    cb.canvas.font.color := clGray;
  cb.Canvas.TextRect( Rect, rect.left, rect.top+1, cb.Items[index] );
end;

procedure TDittoForm.wwDBGrid1Ditto(Sender: TObject; DataSet: TDataSet;
  Field: TField; var DittoValue: String; var AllowDitto: Boolean);
begin
  // Customer No is a primary key so it doesn't make sense to copy it.
  if Field.FieldName='Customer No' then AllowDitto := False;

  with CheckListBox1 do
  if Items.IndexOf(Field.FieldName) = -1 then AllowDitto := False
  else begin
      if not Checked[Items.IndexOf(Field.FieldName)] then
         AllowDitto := False;
  end;
end;

procedure TDittoForm.FormShow(Sender: TObject);
var i:integer;
begin
  for i:= 1 to CheckListBox1.Items.count-1 do
    CheckListBox1.Checked[i]:=True;

  wwdbgrid1.DittoAttributes.ShortCutDittoField := TextToShortCut('Ctrl+D');
  wwdbgrid1.DittoAttributes.ShortCutDittoRecord := TextToShortCut('Ctrl+R');
  wwdbgrid1.DittoAttributes.DittoDirection := wwDittoNext;
end;

procedure TDittoForm.wwRadioGroup2Change(Sender: TObject);
begin
 case wwRadioGroup2.ItemIndex of
   0: wwdbgrid1.DittoAttributes.DittoDirection := wwDittoPrior;
   1: wwdbgrid1.DittoAttributes.DittoDirection := wwDittoNext;
   2: wwdbgrid1.DittoAttributes.DittoDirection := wwDittoPriorOrNext;
 end;
end;

end.

⌨️ 快捷键说明

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