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

📄 vcdhz.pas

📁 一个关于VCD销售的系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit vcdhz;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ComCtrls, ToolWin, Buttons, StdCtrls, AppEvnts,
  LabelButton, TradeImage, MaskImageButton, MoveImageButton, Grids, DBGrids,
  DB;

type
  Tfrm_vcdhz = class(TForm)
    palUp: TPanel;
    palLeftUp: TPanel;
    imgLeftUp: TImage;
    palRightUp: TPanel;
    imgRightUp: TImage;
    palUpMid: TPanel;
    imgCaption: TImage;
    palDown: TPanel;
    imgLeftDown: TImage;
    imgRightDown: TImage;
    imgDownMin: TImage;
    palLeft: TPanel;
    palRight: TPanel;
    imgRight: TImage;
    imgCloseButton: TImage;
    imgMinButton: TImage;
    imgSizeButton: TImage;
    imgMaxButton: TImage;
    imgRestoreButton: TImage;
    imgSysIcon: TImage;
    popSystemMenu: TPopupMenu;
    N_Restore: TMenuItem;
    N_Max: TMenuItem;
    N_Min: TMenuItem;
    N_Move: TMenuItem;
    N_Size: TMenuItem;
    N_Speater: TMenuItem;
    N_Close: TMenuItem;
    palClient: TPanel;
    lbCaption: TLabel;
    CoolBarMenu: TCoolBar;
    ToolBarMenu: TToolBar;
    imgLeft: TImage;
    imgColorLeftUp: TImage;
    imgGrayCaption: TImage;
    imgGrayMenuBar: TImage;
    imgGrayRightUp: TImage;
    imgColorCaption: TImage;
    imgGrayLeftUp: TImage;
    imgColorRightUp: TImage;
    imgRightUp1: TImage;
    imgLeftUp1: TImage;
    imgColorMenubar: TImage;
    group_hy: TGroupBox;
    Group_hz: TGroupBox;
    Group_zl: TGroupBox;
    Group_js: TGroupBox;
    DBGrid1: TDBGrid;
    group_zlr: TRadioGroup;
    Label1: TLabel;
    e_hyid: TEdit;
    Label2: TLabel;
    e_zlname: TEdit;
    Label3: TLabel;
    e_zlsex: TEdit;
    Label4: TLabel;
    e_zlzlx: TEdit;
    Label5: TLabel;
    e_zlyj: TEdit;
    Label6: TLabel;
    e_zltel: TEdit;
    Label7: TLabel;
    e_vcdid: TEdit;
    Group_lz: TGroupBox;
    Label8: TLabel;
    e_yjid: TEdit;
    Label9: TLabel;
    e_yj: TEdit;
    Label10: TLabel;
    e_qk: TEdit;
    e_ys: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    e_ss: TEdit;
    Label13: TLabel;
    e_thyj: TEdit;
    b_ok: TMoveImgBtn;
    blabel_ok: TLabelBtn;
    ZTL: TStatusBar;
    Group_qp: TGroupBox;
    Label14: TLabel;
    DataSource1: TDataSource;
    procedure imgMinButtonClick(Sender: TObject);
    procedure imgSizeButtonClick(Sender: TObject);
    procedure imgCloseButtonClick(Sender: TObject);
    procedure imgCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgCaptionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure imgSysIconMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure popSystemMenuPopup(Sender: TObject);
    procedure N_SizeClick(Sender: TObject);
    procedure N_MoveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure group_zlrClick(Sender: TObject);
    procedure e_hyidChange(Sender: TObject);
    procedure e_ssKeyPress(Sender: TObject; var Key: Char);
    procedure e_thyjKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure e_hyidExit(Sender: TObject);
    procedure e_yjidExit(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure e_vcdidExit(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure e_yjidChange(Sender: TObject);
    procedure b_okClick(Sender: TObject);
    procedure e_thyjExit(Sender: TObject);
    procedure e_ssExit(Sender: TObject);
  private
    { Private declarations }
    canmove:boolean;
    curPoint:TPoint;
    oldPoint:TPoint;
    Canvas:TCanvas;
  protected
    procedure CreateParams(var Params:TCreateParams);override;
    procedure WMActivate(var Msg:TWMACTIVATE); message WM_ACTIVATE;
  public
    { Public declarations }
    procedure ysje;//应收金额计算
    procedure hylzcx;//vcdid反查会员零租
  end;

var
  frm_vcdhz: Tfrm_vcdhz;
  sqlz:string;
  hylzbh:string;//会员或零租证号
implementation

uses datam;

{$R *.dfm}

procedure tfrm_vcdhz.ysje;
var
 ysje,czts:real;//应收金额,出租天数
begin
 czts:=trunc(Date)-trunc(dm.ADO_czbtmp.FieldByName('出租日期').asdatetime);
 if czts=0 then czts:=1;
 ysje:=strtofloat(e_ys.text)+czts*dm.ADO_czbtmp.fieldbyname('出租单价').asfloat;
 e_ys.Text:=formatfloat('0.00',ysje);
end;
procedure tfrm_vcdhz.hylzcx;//vcdid反查会员零租
begin
   dm.ADO_czb.open;
   dm.ADO_czb.first;
   if not dm.ado_czb.locate('编号',e_vcdid.Text,[]) then
     begin
      application.MessageBox(pchar('无此图书、影碟的出租记录,请检查!')
            ,pchar('提示'),MB_ICONEXCLAMATION);
      e_vcdid.text:='';
      e_vcdid.setfocus();
      exit;
     end;
   hylzbh:=dm.ADO_czb.fieldbyname('证号').asstring;
   if Length(hylzbh)=5 then
     begin
      group_zlr.itemindex:=0;
      group_zlr.onclick(group_zlr);
      e_hyid.text:=hylzbh;
      e_hyid.onexit(e_hyid);
      e_hyid.enabled:=false;
      e_hyid.color:=cl3dlight;
     end;
   if length(hylzbh)=6 then
     begin
      group_zlr.itemindex:=1;
      group_zlr.onclick(group_zlr);
      e_yjid.text:=hylzbh;
      e_yjid.onexit(e_yjid);
      e_yjid.enabled:=false;
      e_yjid.color:=cl3dlight;
     end;
end;
procedure Tfrm_vcdhz.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  if BorderStyle<>bsNone then
    Params.Style :=WS_THICKFRAME or WS_POPUP or WS_BORDER;
end;

procedure Tfrm_vcdhz.imgMinButtonClick(Sender: TObject);
begin
  if Application.MainForm =self then
    Application.Minimize
  else
    DefWindowProc(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure Tfrm_vcdhz.imgSizeButtonClick(Sender: TObject);
begin
  if self.WindowState = wsNormal then
  begin
    DefWindowProc(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
    imgSizeButton.Picture :=imgRestoreButton.Picture;
  end
  else
  begin
    DefWindowProc(Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
    imgSizeButton.Picture :=imgMaxButton.Picture;
  end;

end;

procedure Tfrm_vcdhz.imgCloseButtonClick(Sender: TObject);
begin
  DefWindowProc(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
end;

procedure Tfrm_vcdhz.imgCaptionMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft)and(ssLeft in Shift)then
  begin
    canmove:=true;
    Canvas:=TCanvas.Create;
    with Canvas do
    begin
      pen.Style :=psdot;
      brush.Style :=bsClear;
      pen.Width :=2;
      Pen.Mode :=pmNotXor;
      Handle :=GetDC(0);
      Rectangle(left,top,Left+width,top+height);
      curPoint.X :=X;
      curPoint.Y :=Y;
      oldPoint.X :=Left;
      oldPoint.Y :=Top;
    end;        //end with
  end;  //end if
end;

procedure Tfrm_vcdhz.imgCaptionMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    oldPoint.x :=Left +X-curPoint.x;
    oldPoint.y :=Top +Y-curPoint.y;
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
  end;
end;

procedure Tfrm_vcdhz.imgCaptionMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    Left :=oldPoint.x;
    Top :=oldPoint.y;
    Free;
  end;
  canmove:=not canmove;
end;

procedure Tfrm_vcdhz.FormCreate(Sender: TObject);
begin
  lbCaption.Caption :=Caption;
  dm.adoq_czbtmp.SQL.Clear;
   dm.ADOQ_czbtmp.SQL.Add('delete from czbtmp');
   dm.ADOQ_czbtmp.ExecSQL;
   dm.adoq_czbtmp.Close;
   dm.ADO_czbtmp.Close;
end;

procedure Tfrm_vcdhz.imgSysIconMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  PopSystemMenu.Popup(Left+ImgSysIcon.Left,Top+ImgSysIcon.Top+ImgSysIcon.Height);
end;

procedure Tfrm_vcdhz.popSystemMenuPopup(Sender: TObject);
begin

  N_Restore.Enabled :=imgSizeButton.Visible and (WindowState =wsMaximized);
  N_Max.Enabled :=imgSizeButton.Visible and (WindowState =wsNormal);
  N_Size.Enabled :=imgSizeButton.Visible ;
  n_min.Enabled:=imgMinButton.Visible;
end;

procedure Tfrm_vcdhz.N_SizeClick(Sender: TObject);
begin
  DefWindowProc(Handle, WM_SYSCOMMAND, SC_SIZE, 0);
end;

procedure Tfrm_vcdhz.N_MoveClick(Sender: TObject);
begin
  DefWindowProc(Handle, WM_SYSCOMMAND, SC_MOVE, 0);
end;

procedure Tfrm_vcdhz.FormShow(Sender: TObject);
begin
  if WindowState=wsNormal then
    imgSizeButton.Picture.Bitmap :=imgMaxButton.Picture.Bitmap
  else if WindowState=wsMaximized then
    imgSizeButton.Picture.Bitmap :=imgRestoreButton.Picture.Bitmap;
  e_hyid.SetFocus();
  e_ys.Text:='0.00';
  e_ss.Text:='0.00';
  e_thyj.Enabled:=false;
  e_thyj.Color:=cl3dlight;
  e_thyj.Text:='0.00';
end;

procedure Tfrm_vcdhz.WMActivate(var Msg: TWMACTIVATE);
begin
  if (Msg.Active =WA_ACTIVE) or (Msg.Active =WA_CLICKACTIVE) then
  begin
    imgCaption.Picture.Bitmap :=imgColorCaption.Picture.Bitmap;
    imgLeftUp1.Picture.Bitmap :=imgColorLeftUp.Picture.Bitmap;
    imgRightUp1.Picture.Bitmap :=imgColorRightUp.Picture.Bitmap;
    coolBarMenu.Bitmap :=imgColorMenubar.Picture.Bitmap;
  end
  else begin
    imgCaption.Picture.Bitmap :=imgGrayCaption.Picture.Bitmap;
    imgLeftUp1.Picture.Bitmap :=imgGrayLeftUp.Picture.Bitmap;
    imgRightUp1.Picture.Bitmap :=imgGrayRightUp.Picture.Bitmap;
    coolBarMenu.Bitmap :=imgGrayMenubar.Picture.Bitmap;
  end;
end;

procedure Tfrm_vcdhz.FormActivate(Sender: TObject);
begin
   ztl.Panels[1].Text:='  当前日期:'+datetostr(date());
end;

procedure Tfrm_vcdhz.group_zlrClick(Sender: TObject);
begin
   dm.adoq_czbtmp.SQL.Clear;
   dm.ADOQ_czbtmp.SQL.Add('delete from czbtmp');
   dm.ADOQ_czbtmp.ExecSQL;
   dm.adoq_czbtmp.Close;
   dm.ADO_czbtmp.Close;
   dm.ADO_czbtmp.Open;
   e_qk.Text:='0.00';
   e_ys.Text:='0.00';
   e_ss.Text:='0.00';
   e_thyj.Text:='0.00';
   //删除czbtmp
   CASE GROUP_ZLR.ItemIndex OF
    0:BEGIN
       GROUP_HY.Visible:=true;
       e_hyid.Enabled:=true;
       e_hyid.SetFocus();
       group_lz.Visible:=false;
       group_qp.Visible:=false;
       e_yjid.Text:='';
       e_yj.Text:='0.00';
       e_ss.Enabled:=true;
       e_ss.Color:=clwindow;
       e_thyj.Enabled:=false;
       e_thyj.Color:=cl3dlight;
      end;
    1:begin
       GROUP_HY.Visible:=false;
       group_qp.Visible:=false;
       group_lz.Visible:=true;
       e_zlname.Text:='';
       e_zlsex.Text:='';
       e_zlzlx.Text:='';
       e_zlyj.Text:='';
       e_zltel.Text:='';
       e_ss.Enabled:=true;
       e_ss.Color:=clwindow;
       e_thyj.Enabled:=true;
       e_thyj.Color:=clwindow;
       e_hyid.Text:='';
       e_yjid.Enabled:=true;

⌨️ 快捷键说明

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