lb.pas

一个关于VCD销售的系统

unit lb;

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, Mask;

type
  Tfrm_lb = 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;
    DataSource1: TDataSource;
    b_new: TMoveImgBtn;
    blabel_new: TLabelBtn;
    b_edit: TMoveImgBtn;
    blabel_edit: TLabelBtn;
    b_save: TMoveImgBtn;
    blabel_save: TLabelBtn;
    b_del: TMoveImgBtn;
    bLabel_del: TLabelBtn;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    e_id: TEdit;
    e_name: TEdit;
    DBGrid1: TDBGrid;
    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 e_idKeyPress(Sender: TObject; var Key: Char);
    procedure b_newClick(Sender: TObject);
    procedure b_editClick(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure DBGrid1Enter(Sender: TObject);
    procedure e_nameKeyPress(Sender: TObject; var Key: Char);
    procedure b_saveClick(Sender: TObject);
    procedure b_delClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  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 }
  end;

var
  frm_lb: Tfrm_lb;
  mes:string;
implementation

uses datam;

{$R *.dfm}

procedure Tfrm_lb.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_lb.imgMinButtonClick(Sender: TObject);
begin
  if Application.MainForm =self then
    Application.Minimize
  else
    DefWindowProc(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure Tfrm_lb.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_lb.imgCloseButtonClick(Sender: TObject);
begin
  DefWindowProc(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
end;

procedure Tfrm_lb.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_lb.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_lb.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_lb.FormCreate(Sender: TObject);
begin
  lbCaption.Caption :=Caption;
  dm.ADO_lb.Open;
  dm.ADO_lb.Sort:='编号';
end;

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

procedure Tfrm_lb.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_lb.N_SizeClick(Sender: TObject);
begin
  DefWindowProc(Handle, WM_SYSCOMMAND, SC_SIZE, 0);
end;

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

procedure Tfrm_lb.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
end;

procedure Tfrm_lb.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_lb.e_idKeyPress(Sender: TObject; var Key: Char);
begin
  if not ( Key in ['0'..'9',#13,#8]) then Key := #0;
  if key=#13 then
   begin
    e_name.SetFocus();
   end;
end;

procedure Tfrm_lb.b_newClick(Sender: TObject);
begin
  b_save.Tag:=1;
  e_id.Enabled:=true;
  e_name.Enabled:=true;
  e_id.Text:='';
  e_name.text:='';
  b_new.enabled:=false;
  blabel_new.Enabled:=false;
  b_edit.Enabled:=false;
  blabel_edit.Enabled:=false;
  b_save.Enabled:=true;
  blabel_save.Enabled:=true;
  b_del.Enabled:=false;
  blabel_del.Enabled:=false;
  e_id.SetFocus();
end;

procedure Tfrm_lb.b_editClick(Sender: TObject);
begin
  dm.ADO_vcd.Open;
  if dm.ADO_vcd.Locate('小类',e_name.Text,[])=true then
   begin
    application.messagebox(pchar('此类别已经使用，不可修改其内容！')
    ,pchar('提示'),MB_ICONEXCLAMATION);
    exit;
   end;
  dm.ADO_vcd.Close;
  b_save.Tag:=2;
  b_save.Enabled:=true;
  blabel_save.Enabled:=true;
  e_id.Enabled:=true;
  e_name.Enabled:=true;
  b_edit.Enabled:=false;
  blabel_edit.Enabled:=false;
  b_new.Enabled:=false;
  blabel_new.Enabled:=false;
end;

procedure Tfrm_lb.DataSource1DataChange(Sender: TObject; Field: TField);
begin
 e_id.Text:=dm.ADO_lb.fieldbyname('编号').asstring;
 e_name.text:=dm.ADO_lb.fieldbyname('类别').asstring;
end;

procedure Tfrm_lb.DBGrid1Enter(Sender: TObject);
begin
  b_new.Enabled:=true;
  blabel_new.Enabled:=true;
  b_edit.Enabled:=true;
  blabel_edit.Enabled:=true;
  b_del.Enabled:=true;
  blabel_del.Enabled:=true;
  b_save.Enabled:=false;
  blabel_save.Enabled:=false;
  e_id.Enabled:=false;
  e_name.enabled:=false;
  //
  e_id.Text:=dm.ADO_lb.fieldbyname('编号').asstring;
  e_name.text:=dm.ADO_lb.fieldbyname('类别').asstring;
end;

procedure Tfrm_lb.e_nameKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
   begin
    b_save.OnClick(b_save);
   end;
end;

procedure Tfrm_lb.b_saveClick(Sender: TObject);
var
  bh,lbname:string;
begin
  bh:=e_id.Text;
  lbname:=e_name.text;
  if Length(e_id.Text)<2 then
    begin
     Application.MessageBox(PChar('编号不能为空或小于2位,请重新录入！')
      , PChar('提示'),MB_ICONEXCLAMATION);
      e_id.SetFocus();
      exit;
    end;
  if b_save.Tag=1 then
    begin
     try
      dm.ADO_lb.AppendRecord([bh,lbname]);
     except
     e_id.SetFocus;
     e_id.text:='';
     e_name.Text:='';
     mes:='录入错误！'+#13+#13+'注意:<编号>、<类别名>均不能为空'
     +#13+'     且不可重复,请重新录入！';
     application.messagebox(pchar(mes),pchar('提示'),MB_ICONEXCLAMATION);
     exit;
     end;
     dm.ADO_lb.Sort:='编号';
     e_id.text:='';
     e_name.Text:='';
     e_id.SetFocus();
    end
   else
    begin
    dm.ADO_lb.Edit;
    dm.ADO_lb.fieldbyname('编号').AsString:=bh;
    dm.ADO_lb.fieldbyname('类别').AsString:=lbname;
    try
     dm.ADO_lb.Post;
    except
     mes:='录入错误！'+#13+#13+'注意:<编号>、<类别名>均不能为空'
     +#13+'     且不可重复,请重新录入！';
     application.messagebox(pchar(mes),pchar('提示'),MB_ICONEXCLAMATION);
     dm.ADO_lb.Cancel;
     exit;
    end;
    dm.ADO_lb.Sort:='编号';
   end;
end;

procedure Tfrm_lb.b_delClick(Sender: TObject);
begin
 dm.ADO_vcd.Open;
  if dm.ADO_vcd.Locate('小类',e_name.Text,[])=true then
   begin
    application.messagebox(pchar('此类别已经使用，不可删除！')
    ,pchar('提示'),MB_ICONEXCLAMATION);
    exit;
   end;
  dm.ADO_vcd.Close;
 mes:='是否要删除类别<'+dm.ADO_lb.fieldbyname('类别').AsString
       +'>';
 if application.MessageBox(pchar(mes),pchar('等待确认')
    ,+MB_ICONQUESTION+mb_okcancel)=idok then
    dm.ADO_lb.Delete;
end;

procedure Tfrm_lb.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  dm.ADO_lb.Close;
  release;
end;

end.