u_main.pas

专用条码打印工具

unit U_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzCommon, StdCtrls, RzLabel, ExtCtrls, RzPanel, RzButton,
  ImgList, ActnList, Grids, RzCmboBx, RzRadGrp, RM_BarC, RM_Barcode,
  RzRadChk, BaseGrid, AdvGrid, RM_class, AppEvnts, RM_dset, RM_e_main,
  RM_e_htm;

type
  TFrm_main = class(TForm)
    RzFrameController1: TRzFrameController;
    RzPanel1: TRzPanel;
    RzPanel3: TRzPanel;
    RzLabel1: TRzLabel;
    ImageList1: TImageList;
    RzToolButton1: TRzToolButton;
    RzPanel2: TRzPanel;
    RzBitBtn1: TRzBitBtn;
    ActionList1: TActionList;
    Action_close: TAction;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    cbType: TRzRadioGroup;
    RMBarCodeObject1: TRMBarCodeObject;
    RzCheckBox1: TRzCheckBox;
    RzPanel4: TRzPanel;
    StringGrid1: TAdvStringGrid;
    Action_open: TAction;
    Action_save: TAction;
    Action_print: TAction;
    Action_export: TAction;
    RzBitBtn4: TRzBitBtn;
    OpenDialog1: TOpenDialog;
    RMReport1: TRMReport;
    ApplicationEvents1: TApplicationEvents;
    RMHTMExport1: TRMHTMExport;
    SaveDialog: TSaveDialog;
    procedure Action_closeExecute(Sender: TObject);
    procedure RzPanel3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RzPanel3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1CellValidate(Sender: TObject; Col, Row: Integer;
      var Value: string; var Valid: Boolean);
    procedure cbTypeChanging(Sender: TObject; NewIndex: Integer;
      var AllowChange: Boolean);
    procedure RzCheckBox1Click(Sender: TObject);
    procedure Action_openExecute(Sender: TObject);
    procedure Action_saveExecute(Sender: TObject);
    procedure Action_printExecute(Sender: TObject);
    procedure Action_exportExecute(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure RMReport1UserFunction(const Name: string; p1, p2,
      p3: Variant; var Val: Variant);
  private
    myposx, myposY: integer;
    bc: TRMBarCode;
    dataFileName: string;
    procedure setbc(btype: TRMBarcodeType; check: boolean);
    procedure open;
    procedure setData(ts: tstrings);
    procedure save;
    procedure setRm(ts: tstrings);
    procedure printData(ts: tstrings);
    procedure exportdata;
  public
    { Public declarations }
  end;

var
  Frm_main: TFrm_main;

implementation

{$R *.dfm}

procedure TFrm_main.Action_closeExecute(Sender: TObject);
begin
  close;
end;

procedure TFrm_main.RzPanel3MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  myposx := x;
  myposY := y;
end;

procedure TFrm_main.RzPanel3MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if ssLeft in Shift then
    begin
      left := left - (myposx - x);
      top := top - (myposY - y);
    end;
end;

procedure TFrm_main.FormCreate(Sender: TObject);
var
  iType: TRMBarcodeType;
  sl: Tstringlist;

begin
  dataFileName := ExtractFilePath(Application.ExeName) + 'data.txt';
  OpenDialog1.FileName := dataFileName;


  StringGrid1.ColWidths[0] := 24;
  StringGrid1.ColWidths[1] := 240;
  StringGrid1.ColWidths[2] := 240;

  bc := TRMBarCode.Create(nil);
  bc.Width := 1;
  bc.Height := StringGrid1.DefaultRowHeight;
  for iType := bcCode_2_5_interleaved to bcCodeEAN128C do
    cbType.Items.Add(bcData[iType].Name);
  cbType.ItemIndex := 4;
  setbc(TRMBarcodeType(cbType.ItemIndex), RzCheckBox1.Checked);

  if FileExists(dataFileName) then
    begin
      sl := Tstringlist.Create;
      sl.LoadFromFile(OpenDialog1.FileName);
      if sl.Count = 0 then
        sl.Add('');
      setData(sl);
      freeandnil(sl);
    end;
end;

procedure TFrm_main.setData(ts: tstrings);
begin
  StringGrid1.RowCount := ts.Count;
  StringGrid1.Cols[1].Text := '';
  StringGrid1.Cols[2].Text := '';
  StringGrid1.Cols[1].AddStrings(ts);
  StringGrid1.Cols[2].AddStrings(ts);
end;

procedure TFrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  freeandnil(bc);
end;

procedure TFrm_main.StringGrid1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  str: string;
  Bitmap: TBitmap;
begin
  with TAdvStringGrid(Sender) do
    begin
      str := cells[Acol, arow];
      case Acol of
        0:
          begin
            Canvas.TextOut(Rect.Left, Rect.Top, inttostr(Arow + 1) + '.');
          end;
        1:
          begin
            Bitmap := TBitmap.Create;
            Bitmap.Width := Rect.Right - Rect.Left;
            Bitmap.Height := Rect.Bottom - rect.Top;

            bc.Text := str;
            
            if trim(str) <> '' then
            try
              bc.DrawBarcode(Bitmap.Canvas);
            except;
            end;
            Canvas.Draw(rect.Left, rect.Top, Bitmap);
            freeandnil(Bitmap);
          end;
      end;
    end;
end;

procedure TFrm_main.StringGrid1CellValidate(Sender: TObject; Col,
  Row: Integer; var Value: string; var Valid: Boolean);
var
  Bitmap: TBitmap;
begin

  Bitmap := TBitmap.Create;
  Bitmap.Width := bc.Width;
  Bitmap.Height := bc.Height;

  bc.Text := Value;

  try
    bc.DrawBarcode(Bitmap.Canvas);
    Valid := true;
  except
    Valid := false;
  end;
  freeandnil(Bitmap);

  if Valid then
    if col = 2 then
      StringGrid1.Cells[1, row] := Value;
end;

procedure TFrm_main.setbc(btype: TRMBarcodeType; check: boolean);
begin
  bc.Typ := btype;
  bc.Checksum := check;
  StringGrid1.Refresh;
end;

procedure TFrm_main.cbTypeChanging(Sender: TObject; NewIndex: Integer;
  var AllowChange: Boolean);
begin
  setbc(TRMBarcodeType(NewIndex), RzCheckBox1.Checked);
end;

procedure TFrm_main.RzCheckBox1Click(Sender: TObject);
begin
  setbc(TRMBarcodeType(cbType.ItemIndex), RzCheckBox1.Checked);
end;

procedure TFrm_main.Action_openExecute(Sender: TObject);
begin
  open;
end;

procedure TFrm_main.Action_saveExecute(Sender: TObject);
begin
  save
end;

procedure TFrm_main.Action_printExecute(Sender: TObject);
begin
  printData(StringGrid1.Cols[2]);
end;

procedure TFrm_main.Action_exportExecute(Sender: TObject);
begin
  exportdata;
end;

procedure TFrm_main.open;
var
  sl: Tstringlist;
begin
  if OpenDialog1.Execute then
    if FileExists(OpenDialog1.FileName) then
      begin
        dataFileName := OpenDialog1.FileName;
        sl := Tstringlist.Create;
        sl.LoadFromFile(OpenDialog1.FileName);
        if sl.Count = 0 then
          sl.Add('');
        setData(sl);
        freeandnil(sl);
      end;
end;

procedure TFrm_main.save;
begin
  StringGrid1.Cols[2].SaveToFile(dataFileName);
end;

procedure TFrm_main.setRm(ts: tstrings);
var
  cBarType: TRMBarcodeType;
  i, j: integer;
begin
  cBarType := TRMBarcodeType(cbType.ItemIndex);
  for i := 0 to RMReport1.Pages.Count - 1 do
    for j := 0 to RMReport1.Pages[i].Objects.Count - 1 do
      begin
        if TRMView(RMReport1.Pages[i].Objects[j]) is TRMBarCodeView then
          begin
            TRMbarCodeView(RMReport1.Pages[i].Objects[j]).Param.cBarType := cBarType;
          end;
      end;
  for i := 0 to RMReport1.Pages.Count - 1 do
    for j := 0 to RMReport1.Pages[i].Objects.Count - 1 do
      begin
        if TRMView(RMReport1.Pages[i].Objects[j]) is TRMBandView then
          begin
            TRMBandView(RMReport1.Pages[i].Objects[j]).DataSet := inttostr(ts.count);
          end;
      end;

end;

procedure TFrm_main.printData(ts: tstrings);
begin
  setRm(ts);
  RMReport1.ShowReport;
end;

procedure TFrm_main.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
var
  str: string;
begin
  str := e.Message;
  if sametext(str, 'Barcode must be numeric') then
    begin
      str := '该类型的条码必须是数字！';
      showmessage(str);
    end;
end;

procedure TFrm_main.RMReport1UserFunction(const Name: string; p1, p2,
  p3: Variant; var Val: Variant);
var
  idx: integer;
begin
  try
    if sametext(Name, 'getbar') then
      begin
        idx := RMParser.Calc(p1);
        if idx <= StringGrid1.RowCount then
          val := StringGrid1.Cols[2][idx - 1];
      end;
  except
  end;
end;

procedure TFrm_main.exportdata;
begin
  if SaveDialog.Execute then
    begin
      setRm(StringGrid1.Cols[2]);
      if RMReport1.PrepareReport then
        RMReport1.ExportTo(RMHTMExport1, ChangeFileExt(SaveDialog.FileName, '.htm'));
    end;
end;

end.