?? caselist.pas
字號:
unit CaseList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, ActnList, ImgList, Grids, DBGridEh, ComCtrls, ToolWin,
MDIChild,DBGridEhImpExp, StdCtrls, ExtCtrls;
type
TCaseListFrm = class(TMDIChild)
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton5: TToolButton;
BRefresh: TToolButton;
BOut: TToolButton;
ToolButton3: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton4: TToolButton;
BQuit: TToolButton;
BillGrid: TDBGridEh;
UseList: TImageList;
ActionList1: TActionList;
BtnRefresh: TAction;
BtnTakeOut: TAction;
BtnQuit: TAction;
BtnFind: TAction;
BtnCase: TAction;
BtnNew: TAction;
SaveXLS: TSaveDialog;
Bills: TADOQuery;
_Bills: TDataSource;
ActDel: TAction;
ToolButton6: TToolButton;
Panel1: TPanel;
Label1: TLabel;
ActPay: TAction;
ToolButton7: TToolButton;
SetPay: TADOQuery;
procedure FormCreate(Sender: TObject);
procedure BtnRefreshExecute(Sender: TObject);
procedure BtnNewExecute(Sender: TObject);
procedure BtnQuitExecute(Sender: TObject);
procedure BtnCaseExecute(Sender: TObject);
procedure BtnTakeOutExecute(Sender: TObject);
procedure ActDelExecute(Sender: TObject);
procedure BillGridGetCellParams(Sender: TObject; Column: TColumnEh;
AFont: TFont; var Background: TColor; State: TGridDrawState);
procedure ActPayExecute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
CaseListFrm: TCaseListFrm;
implementation
{$R *.dfm}
Uses FCase,Link;
procedure TCaseListFrm.FormCreate(Sender: TObject);
begin
Bills.Active:=True
end;
procedure TCaseListFrm.BtnRefreshExecute(Sender: TObject);
begin
If Not Bills.Active Then
Bills.Active:=True
Else
Bills.Requery
end;
procedure TCaseListFrm.BtnNewExecute(Sender: TObject);
Var Frm:TCaseFrm;
begin
Frm:=TCaseFrm.Create(Self,0);
Frm.ShowModal
end;
procedure TCaseListFrm.BtnQuitExecute(Sender: TObject);
begin
Close
end;
procedure TCaseListFrm.BtnCaseExecute(Sender: TObject);
Var Frm:TCaseFrm;
InterID:Integer;
begin
If (not Bills.Active) OR (Bills.IsEmpty) OR (VarIsNull(Bills.FieldByName('FInterID').Value)) Then Exit;
InterID:=Bills.FieldByName('FInterID').Value;
Frm:=TCaseFrm.Create(Self,InterID);
Frm.ShowModal
end;
procedure TCaseListFrm.BtnTakeOutExecute(Sender: TObject);
begin
If (Bills.State = dsInactive) Or (Bills.IsEmpty=True) Then Exit;
If SaveXLS.Execute Then
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS, BillGrid, SaveXLS.FileName ,true);
end;
procedure TCaseListFrm.ActDelExecute(Sender: TObject);
begin
If (Bills.State = dsInactive) Or (Bills.IsEmpty=True) Then Exit;
if Application.MessageBox('刪除將不可返回,確定刪除嗎?','系統提示',MB_OKCancel+MB_ICONQuestion) =IDOK then
Begin
Bills.Delete;
Bills.UpdateBatch
End
end;
procedure TCaseListFrm.BillGridGetCellParams(Sender: TObject;
Column: TColumnEh; AFont: TFont; var Background: TColor;
State: TGridDrawState);
begin
If Column.Field.DataSet.FieldByName('狀態').AsString='裁決' Then
Background:=$00FCCDD6 ;
If Column.Field.DataSet.FieldByName('是否已支付').AsBoolean=False Then
AFont.Color:=clRed ;
end;
procedure TCaseListFrm.ActPayExecute(Sender: TObject);
Var InterID:Integer;
begin
Try
If (not Bills.Active) OR (Bills.IsEmpty) OR (VarIsNull(Bills.FieldByName('FInterID').Value)) Then Exit;
InterID:=Bills.FieldByName('FInterID').Value;
SetPay.Close;
SetPay.Parameters.ParamByName('@FInterID').Value:=InterID;
SetPay.Prepared;
SetPay.ExecSQL;
Bills.Requery;
Except
Application.MessageBox('數據更新失敗!','提示',MB_ICONINFORMATION);
SetPay.Cancel;
End;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -