zhcycxunit.~pas

宁夏中药管理系统,在其它的基础上改的,将他人没有完成的功能补上

unit zhcycxUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, ComCtrls, DB, ADODB, Grids, DBGrids,
  DBCtrls, Mask, Menus, ExtDlgs,mainfrm, Buttons, ToolWin;

type
  Tzhcycxfrm = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    DBGrid1: TDBGrid;
    Aqyzcyt2: TADOQuery;
    DataSource1: TDataSource;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBEdit6: TDBEdit;
    DBMemo1: TDBMemo;
    DBMemo2: TDBMemo;
    DBMemo3: TDBMemo;
    DBMemo4: TDBMemo;
    Panel2: TPanel;
    Panel3: TPanel;
    DBEdit1: TDBEdit;
    DeName: TDBEdit;
    Label12: TLabel;
    CkPicM: TCheckBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Aqyzcyt2DSDesigner: TWideStringField;
    Aqyzcyt2DSDesigner2: TWideStringField;
    Aqyzcyt2DSDesigner3: TWideStringField;
    Aqyzcyt2DSDesigner4: TMemoField;
    Aqyzcyt2DSDesigner5: TMemoField;
    Aqyzcyt2DSDesigner6: TMemoField;
    Aqyzcyt2DSDesigner7: TMemoField;
    Aqyzcyt2DSDesigner8: TWideStringField;
    Aqyzcyt2DSDesigner9: TWideStringField;
    Aqyzcyt2DSDesigner10: TWideStringField;
    Aqyzcyt2DSDesigner11: TWideStringField;
    Aqyzcyt2DSDesigner12: TBlobField;
    BtIntertPic: TButton;
    BtUpdatePic: TButton;
    OpenImage: TOpenPictureDialog;
    Panel4: TPanel;
    ImgMed: TImage;
    AqyImgInfo: TADOQuery;
    Label14: TLabel;
    Label15: TLabel;
    la: TLabel;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Bevel1: TBevel;
    Label16: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    SpeedButton5: TSpeedButton;
    Bevel6: TBevel;
    SpeedButton6: TSpeedButton;
    Bevel7: TBevel;
    ADOQuery2: TADOQuery;
    procedure CkPicMClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
      procedure BtIntertPicClick(Sender: TObject);
    procedure DBGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OpenImageCanClose(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
   // procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    //自定义过程寻找图片路径
    procedure SearchImgPath;
    procedure judgeImgPath(ImgPath : String) ;
  public
    { Public declarations }
    t_flag:integer;
  end;

var
  zhcycxfrm: Tzhcycxfrm;
  //中草药名
  ZcyName :String;
implementation

{$R *.dfm}

var
  //sysdir记录应用程序所在的绝对路径
  sysdir : String ;
  PLeft,PTop :Integer;
  PWidth,PHeight : Integer;

procedure Tzhcycxfrm.judgeImgPath(ImgPath : String);
begin
  if not FileExists(ImgPath) then
  // 若没有发现文件则中止程序
  begin
     showmessage('找不到图片文件，请检查' + #10#13+
                   ImgPath + #10#13+
                   '是否存在该图片文件');
     Abort ;              
  end;
end;
procedure Tzhcycxfrm.SearchImgPath ;
begin

  ZcyName := Aqyzcyt2.FieldValues['中药名'];
  label15.Caption := ZcyName;
  with AqyImgInfo do
  begin
  //==============================================
    //查询是否有图片可供加载
    close;
    SQL.Clear;
    SQL.Add('Select ImgPath from ImgInfo');
    SQl.Add('where ZCName = :ZcName');
    parameters.ParamByName('ZcName').Value := ZcyName ;
    open;
    //================================================
    if FieldByName('ImgPath').AsString = '' then
    begin
      label15.Caption := ZcyName + '暂无图片';
      judgeImgPath(sysdir + '\' + 'image\default.jpg');
      ImgMed.Picture.LoadFromFile(sysdir + '\'+'image\default.jpg');
    end
    else
    begin
      judgeImgPath(sysdir + '\'+fieldbyname('ImgPath').AsString);
      ImgMed.Picture.LoadFromFile(sysdir + '\'+fieldbyname('ImgPath').AsString);
    end;
    //=================================================
    close;
  //===================================================
  end;
end;

procedure Tzhcycxfrm.FormCreate(Sender: TObject);
begin
  //连接数据库
  //ADOConnection1.ConnectionString := mainfrm.ConnStr ;
  //获取应用程序绝对路径
  sysdir := GetCurrentDir ;
  la.Caption := sysdir ;
  PLeft := panel4.Left;
  PTop := panel4.Top;
  PWidth := Panel4.Width ;
  PHeight := Panel4.Height ;
  Aqyzcyt2.Close;
  Aqyzcyt2.SQL.Clear;
  Aqyzcyt2.SQL.Add('select * from zcyt2');
  Aqyzcyt2.Open;
  SearchImgPath;
end;
procedure Tzhcycxfrm.BitBtn1Click(Sender: TObject);
begin
  if trim(edit1.Text)<>'' then
  begin
  with Aqyzcyt2 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select* from Zcyt2 where 中药名=:ym');
    parameters.ParamByName('ym').value:=edit1.text;
  try
    execsql;
    open;
    SearchImgPath;
  except
    showmessage('此药不存在，请确认输入正确的中药名！');
    exit;
  end;
    end;
    end
    else
    showmessage('请输入要查询的中药名!')
end;


procedure Tzhcycxfrm.BtIntertPicClick(Sender: TObject);

begin
    if (label15.Caption = ZcyName )then
    begin
      showmessage('该项的图片已经存在，您不能执行添加操作，' + #10#13+
                  '要想修改图片，请单击修改图片按钮，进行修改!');
      Abort;
    end;
    OpenImage.InitialDir := 'image';
    OpenImage.Execute ;
end;

procedure Tzhcycxfrm.CkPicMClick(Sender: TObject);
begin
   if CkPicM.Checked then
   begin
     Panel4.Align := alClient ;
     ImgMed.Align := alClient ;
   end
   else
   begin
     panel4.Align := alNone ;
     panel4.Left := PLeft ;
     Panel4.Top := PTop ;
     Panel4.Width := PWidth ;
     Panel4.Height := PHeight ;
   end;
end;

procedure Tzhcycxfrm.DBGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SearchImgPath ;
  speedbutton2.Enabled:=true;
  speedbutton3.Enabled:=true;
  //speedbutton4.Enabled:=true;
end;

procedure Tzhcycxfrm.OpenImageCanClose(Sender: TObject;
  var CanClose: Boolean);
var
  //================================
  {
     变量说明
     Imgdir :要插入图片的位置
     ImgPath :存放图片的绝对路径
     ReImgPath :存放图片的相对路径
  }
  Imgdir,ImgPath,ReImgPath : String;
  //================================
  FromF,ToF :File ;
  NumRead ,NumWritten :Integer ;
  Buf :array [1..2048] of Char ;
begin
      if OpenImage.FileName = 'image\default.jpg' then
      begin
        showmessage('您选择的图片无效，请选择一张有效的图片!');
        abort;
      end;
      Imgdir := OpenImage.FileName;
      ReImgPath := 'image'+'\'+ ZcyName +ExtractFileExt(OpenImage.FileName);
      ImgPath := sysdir + '\' + ReImgPath ;
    if Imgdir <> ImgPath then
    begin
      showmessage('您选择的文件不在当前系统，系统'+ #10#13+
                  '可将该图片放置在image文件夹下：'+ #10#13
                  );
      //==================================================
      //不在系统文件夹下，先把它拷贝到系统的图片管理文件夹下
      AssignFile(FromF , Imgdir);
      Reset(FromF,1);
      AssignFile(ToF , ImgPath);
      Rewrite(ToF,1);
      repeat
        BlockRead(FromF,Buf,SizeOf(Buf),NumRead);
        BlockWrite(ToF,Buf,NumRead,NumWritten);
        //重复进行读写，直到图片文件拷贝完毕
      until (NumRead = 0) or (NumWritten <> NumRead) ;
        CloseFile(FromF);
        CloseFile(ToF);
          //==================================================
       end;
    with AqyImgInfo do