htxg.pas

一个仓库管理中的子系统－－采购子系统

unit htxg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ComCtrls, Grids, StdCtrls, ExtCtrls;

const
  grid_headcolor=$00ACEEFF;
  grid_highcolor=$00F7FFFF;
  grid_lowcolor=$00CAFFFF;
  grid_selectedcolor=$00ACEEFF;  
type
  ThtxgForm = class(TForm)
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    jfmcEdit: TEdit;
    Label3: TLabel;
    yfmcEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    dhjeEdit: TEdit;
    qzsjEdit: TEdit;
    Label6: TLabel;
    qzrEdit: TEdit;
    Label7: TLabel;
    nrmsEdit: TEdit;
    StringGrid1: TStringGrid;
    Label8: TLabel;
    bzEdit: TEdit;
    Label9: TLabel;
    hthEdit: TEdit;
    qzsjDate: TDateTimePicker;
    Bevel2: TBevel;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    jldwCombo: TComboBox;
    dhsjDate: TDateTimePicker;
    StatusBar1: TStatusBar;
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure jldwComboChange(Sender: TObject);
    procedure dhsjDateCloseUp(Sender: TObject);
    procedure qzsjDateCloseUp(Sender: TObject);
    procedure dhjeEditExit(Sender: TObject);
    procedure dhjeEditKeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
  private
  procedure initStringGrid;
  Procedure DisplayComponent(TheObject:TWinControl);
  Function CheckEdit:Boolean;
  Function CheckGrid:Boolean;
    { Private declarations }
  public
  Procedure jszj;
  Procedure distributetext (canvas:tcanvas; width: integer; font: tfont; text:string; strings: tstringlist);
  Procedure writetext (canvas:tcanvas; x1,y1,x2,y2: integer; textxdirectionspace,textydirectionspace:integer;text: string; font: tfont; alignflag: integer; ifrh: boolean);
    { Public declarations }
  end;

var
  htxgForm: ThtxgForm;

implementation

uses sqbinput, Datamodule;

{$R *.DFM}
var MyRowCount,oldCol,oldRow,count:integer;
    hthstr:string;
    
procedure ThtxgForm.jszj;
var
  count1:integer;
  zj:real;
begin
  zj:=0;
for count1:=1 to stringgrid1.RowCount-1 do
  if stringgrid1.Cells[6,count1]<>''
  then zj:=zj+strtofloat(stringgrid1.Cells[6,count1])
  else break;
dhjeEdit.Text:=Format('%8.3f', [zj]);
end;

Procedure ThtxgForm.distributetext (canvas:tcanvas; width: integer; font: tfont; text:string; strings: tstringlist);
Var
  count1 : integer;
  buf : string;
  addbuf : string;
Begin
  strings.Clear;
  Canvas.Font := font;
  buf := '';
  count1 := 1;
  While count1 <= length (text) Do
    Begin
      addbuf := '';
      If ord (text[count1]) <= 126 Then
        Begin
          // that is to say text[count1] is not chinese;
          addbuf := text[count1];
          inc (count1)
        End
      Else
        Begin
          addbuf := text[count1] + text[count1 + 1];
          count1 := count1 + 2
        End;
      If Canvas.TextWidth (buf +
                                  addbuf) <= width Then
        // that is to say there has enough space;
        buf := buf + addbuf
      Else
        Begin
          If Canvas.TextWidth (buf) <= width Then
            strings.Add (buf);
          buf := addbuf
        End
    End; // while count1<=length(text) do end;
  If ((strings.Count <> 0)
       and
      (strings[strings.count -
               1] <> buf))
      or
     ((strings.Count = 0)
       and
      (buf <> '')) Then
    strings.Add (buf)
End;

Procedure ThtxgForm.writetext (canvas:tcanvas; x1,y1,x2,y2: integer; textxdirectionspace,textydirectionspace:integer;text: string; font: tfont; alignflag: integer; ifrh: boolean);
Var
  count1 : integer;
  count2 : integer;
  length : integer;
  textheight : integer;
  beforeheight : integer;
  strings : tstringlist;
  width,height:integer;
Begin
try
  canvas.Lock;
  canvas.Brush.style:=bsclear;
  Canvas.font := font;
  width:=abs(x1-x2);
  height:=abs(y1-y2);
  If ifrh = false Then
  //不进行绕行
    Begin
      textheight := Canvas.TextHeight (text);
      Case alignflag Of
      0:
      //左对齐
      canvas.textrect(rect(x1,y1,x2,y2),x1+textxdirectionspace,y1+textydirectionspace+round ((height - 2 *textydirectionspace - textheight) / 2),text);
      1://中对齐
        Begin
          length := Canvas.TextWidth (text);
          canvas.textrect(rect(x1,y1,x2,y2),x1+round (textxdirectionspace + (width - 2* textxdirectionspace - length) / 2),y1+textydirectionspace+round ((height - 2 *textydirectionspace - textheight) / 2),text);
        End;
      2://右对齐
        Begin
          length := Canvas.TextWidth (text);
          canvas.textrect(rect(x1,y1,x2,y2),x1+width - textxdirectionspace - length,y1+round ((height - 2 * textydirectionspace - textheight) / 2 +textydirectionspace), text);
        End;
      End
      // end case;

    End
  Else
    Begin // 字符需要绕行
      strings := tstringlist.Create;
      distributetext (canvas, width - 2 * textxdirectionspace, font, text, strings);
      textheight := 0;
      For count1 := 0 to strings.Count - 1 Do
        textheight := textheight + Canvas.TextHeight (strings[count1]);
      Case alignflag Of
      0: For count1 := 0 to strings.Count - 1 Do
        Begin
          beforeheight := 0;
          For count2 := 0 to count1 - 1 Do
            beforeheight := beforeheight + canvas.textheight (strings[count2]);
            canvas.textrect(rect(x1,y1,x2,y2),x1+textxdirectionspace,y1+textydirectionspace+round ((height - 2 *textydirectionspace - textheight) / 2)+beforeheight,strings[count1]);
        End;
      2: For count1 := 0 to strings.Count - 1 Do
        Begin
          beforeheight := 0;
          For count2 := 0 to count1 - 1 Do
            beforeheight := beforeheight + canvas.textheight (strings[count2]);
          length := Canvas.TextWidth (strings[count1]);
          canvas.textrect(rect(x1,y1,x2,y2),x1+width - textxdirectionspace - length,y1+round ((height - 2 * textydirectionspace - textheight) / 2 +textydirectionspace+beforeheight), strings[count1]);
        End;
      1: For count1 := 0 to strings.Count - 1 Do
        Begin
          beforeheight := 0;
          For count2 := 0 to count1 - 1 Do
            beforeheight := beforeheight + canvas.textheight (strings[count2]);
          length := Canvas.TextWidth (strings[count1]);
          canvas.textrect(rect(x1,y1,x2,y2),x1+round (textxdirectionspace + (width - 2* textxdirectionspace - length) / 2),y1+textydirectionspace+round ((height - 2 *textydirectionspace - textheight) / 2)+beforeheight,strings[count1]);
        End;
      End
      //end case

    End
finally
  canvas.Unlock;
end;
End;

Function ThtxgForm.CheckEdit:Boolean;
begin
if (jfmcEdit.Text='') or (yfmcEdit.Text='') or (dhjeEdit.Text='') or (qzrEdit.Text='') or (qzsjEdit.Text='') or (hthEdit.Text='') then
begin
MessageDlg('请输入合同信息！',mtInformation,[mbOK],0);
Result:=False;
exit;
end;
Result:=True;
end;

Function ThtxgForm.CheckGrid:Boolean;
var I,J:integer;
begin
    Count:=0;
    For I:=1 to stringGrid1.RowCount-1 do //不能有相同的产品编号出现在同一张申请单中
    with stringGrid1 do
    if (cells[1,I]='') and (Cells[2,I]='') and (Cells[3,I]='') and (cells[4,I]='0.00') and (Cells[5,I]='0.00') and (cells[7,I]='') and (cells[8,I]='') then
    begin
    if I=1 then
    begin
    showmessage('您没有输入任何记录到合同表！');
    result:=false;
    exit;
    end;
    break;
    end
    else
    count:=count+1;

    if Count>0 then
    For I:=1 to Count do
    For J:=1 to 8 do
    if  stringGrid1.Cells[J,I]='' then
    begin
    showmessage('请您输入完整的合同记录内容！');
    Result:=False;
    exit;
    end;
    result:=True;
end;

Procedure ThtxgForm.DisplayComponent(TheObject:TWinControl);
begin
    TheObject.Visible:=True;
    with StringGrid1 do
    begin
      if  (GoEditing in Options) then
      Options:=Options-[GoEditing];
    end;
end;

procedure ThtxgForm.initStringGrid;
var I:integer;
begin
with stringGrid1 do
begin
cells[1,0]:='产品名称';
cells[2,0]:='型号规格';
cells[3,0]:='数量单位';
cells[4,0]:='单价';
cells[5,0]:='订货数量';
cells[6,0]:='金额总计';
cells[7,0]:='付款方式';
cells[8,0]:='到货时间';
Cells[9,0]:='备注';
end;
for I:=1 to stringGrid1.RowCount-1 do
with stringGrid1 do
begin
cells[4,I]:='0.00';
cells[5,I]:='0.00';
Cells[6,I]:='0.00';
cells[0,I]:=IntToStr(I);
end;
end;

procedure ThtxgForm.SpeedButton3Click(Sender: TObject);
begin
    close;
end;

procedure ThtxgForm.FormActivate(Sender: TObject);
var I:Integer;
begin