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

📄 fm_getmarcfileform.pas

📁 delphi控件的使用
💻 PAS
字号:
unit FM_GetMarcFileForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, EditPro, Grids, StringGridPro, Db, DBTables,
  TabAsEnter;

type
  TGenerateMarcFrm = class(TForm)
    tBarCodeEditPro: TEditPro;
    Label1: TLabel;
    Label2: TLabel;
    tClassCodeCombo: TComboBox;
    Label3: TLabel;
    tGoodsLevelCombo: TComboBox;
    Label4: TLabel;
    tPressCombo: TComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label5: TLabel;
    tGoodsNameEditPro: TEditPro;
    tMarcStringGrid: TStringGridPro;
    EnterAsTab1: TEnterAsTab;
    Database1: TDatabase;
    tMarcQuery: TQuery;
    tMarcDataSource: TDataSource;
    tMarcSaveDialog: TSaveDialog;
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure tClassCodeComboKeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure InitGrid;
    procedure InitComponent;
  end;

var
  GenerateMarcFrm: TGenerateMarcFrm;

implementation

uses JBCUtilsCV, JBCUtils, DBUtils;

{$R *.DFM}

procedure TGenerateMarcFrm.InitComponent;
var sStr : string;
begin
  sStr := 'Select ClassCode, ClassName From gds_Class ' +
          'Where Length(rtrim(ClassCode)) = 6 Order By ClassCode ';
  if not SqlSetComboBox(tMarcQuery, sStr, tClassCodeCombo, 0, True) then begin
    ShowMessage('读取商品类别发生错误。 ');
    exit;
  end;
  tClassCodeCombo.ItemIndex := 1;

  sStr := 'Select LevelCode, LevelComment From gds_GoodsLevel Order By LevelCode ';
  if not SqlSetComboBox(tMarcQuery, sStr, tGoodsLevelCombo, 0, True) then begin
    ShowMessage('读取商品级别发生错误。 ');
    exit;
  end;
  tGoodsLevelCombo.ItemIndex := 1;

  sStr := 'Select PressCode, PressName From sjb_Press Order By PressCode ';
  if not SqlSetComboBox(tMarcQuery, sStr, tPressCombo, 0, True) then begin
    ShowMessage('读取出版社发生错误。 ');
    exit;
  end;
  tPressCombo.ItemIndex := 1;
end;

procedure TGenerateMarcFrm.InitGrid;
var i : integer;
begin
  with tMarcStringGrid do begin
    i := 0;
    ColCount := 14;
    i := i + 1;
    Columns[i].Title.caption:= '记录日期';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 8 * WidthRadix;
    i := i + 1;

    Columns[i].Title.caption:= 'ISBN';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taCenter;
    ColWidths[i] := 12 * WidthRadix;
    i := i + 1;

    Columns[i].Title.caption:= '销售单位';
    Columns[i].Format := cfString;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 20 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '单价';
    Columns[i].Format := cfNumber;
    Columns[i].Decimal := 2;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '征订单号';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taCenter;
    ColWidths[i] := 12 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '介质类别';
    Columns[i].Format := cfString;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 20 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '书名';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 9 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '作者';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 9 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '出版社';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '开本';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

{    i := i + 1;
    Columns[i].Title.caption:= '摘要';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;
}
    i := i + 1;
    Columns[i].Title.caption:= '中图分类';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '版次';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

    i := i + 1;
    Columns[i].Title.caption:= '作者';
    Columns[i].Format := cfNumber;
    Columns[i].Alignment := taRightJustify;
    ColWidths[i] := 12 * WidthRadix;

    InitGrid;
  end;
end;

procedure TGenerateMarcFrm.FormShow(Sender: TObject);
begin
  InitGrid;
  InitComponent;
end;

procedure TGenerateMarcFrm.BitBtn1Click(Sender: TObject);
var
  sStr : string;
  tRet : TExecSqlVal;
begin
  sStr := 'Select To_Char(ggc.RecordTime,''YYYYMMDDHH24MISS''), ggc.ISBN, ggc.SaleUnit, ' +
          'ggc.DefSalePrice, ggt.PreOrderNo, ' +
          'ggc.MediumSort, ggc.GoodsName, ggc.Auther, sp.PressName, ggc.PFormat, ' +
          'ggc.Clc, ggc.EdtionVer, ggc.Auther ' +
          'From gds_GoodsCode ggc, sjb_Press sp, gds_GoodsToPreOrderNo ggt ' +
          'Where ggc.GoodsCode = ggt.GoodsCode(+) ' +
          'And ggc.PressCode = sp.PressCode ';
  if trim(tClassCodeCombo.Text) <> '' then begin
    sStr := sStr + ' And ggc.ClassCode = ''' + GetStrInComboBoxBySite(tClassCodeCombo) + '''';
  end;
  if trim(tGoodsLevelCombo.Text) <> '' then begin
    sStr := sStr + ' And ggc.LevelCode = ''' + GetStrInComboBoxBySite(tGoodsLevelCombo) + '''';
  end;
  if trim(tPressCombo.Text) <> '' then begin
    sStr := sStr + ' And ggc.PressCode = ''' + GetStrInComboBoxBySite(tPressCombo) + '''';
  end;
  tRet := SqlSelectGetRecord(tMarcQuery, sStr);
  case ord(tRet) of
  1 : begin ShowMessage('取商品资料时出现了错误。'); exit; end;
  2 : begin ShowMessage('没有找到相应的纪录。'); exit; end;
  end;
  tMarcDataSource.DataSet:= tMarcQuery;
  tMarcStringGrid.DataSource := tMarcDataSource;
  tMarcStringGrid.SetGrid;
end;

procedure TGenerateMarcFrm.tClassCodeComboKeyPress(Sender: TObject;
  var Key: Char);
var
  Found: boolean;
  i,SelSt: Integer;
  TmpStr: string;
begin
  { first, process the keystroke to obtain the current string }
  { This code requires all items in list to be uppercase}
  if Key in ['a'..'z'] then Dec(Key,32); {Force Uppercase only!}
  with (Sender as TComboBox) do
  begin
    SelSt := SelStart;
    if (Key = Chr(vk_Back)) and (SelLength <> 0) then
     TmpStr := Copy(Text,1,SelStart)+Copy(Text,SelLength+SelStart+1,255)

    else if Key = Chr(vk_Back) then {SelLength = 0}
     TmpStr := Copy(Text,1,SelStart-1)+Copy(Text,SelStart+1,255)
    else {Key in ['A'..'Z', etc]}
     TmpStr := Copy(Text,1,SelStart)+Key+Copy(Text,SelLength+SelStart+1,255);
    if TmpStr = '' then Exit;
    { update SelSt to the current insertion point }

    if (Key = Chr(vk_Back)) and (SelSt > 0) then Dec(SelSt)

    else if Key <> Chr(vk_Back) then Inc(SelSt);
    Key := #0; { indicate that key was handled }
    if SelSt = 0 then
    begin
      Text:= '';
      Exit;
    end;

   {Now that TmpStr is the currently typed string, see if we can locate a match }

    Found := False;
    for i := 1 to Items.Count do
      if Copy(Items[i-1],1,Length(TmpStr)) = TmpStr then
      begin
        Text := Items[i-1]; { update to the match that was found }
        ItemIndex := i-1;
        Found := True;
        Break;
      end;
    if Found then { select the untyped end of the string }
    begin
      SelStart := SelSt;
      SelLength := Length(Text)-SelSt;
    end
    else Beep;
  end;
end;

procedure TGenerateMarcFrm.BitBtn2Click(Sender: TObject);
var
  tMarcFile : TextFile;
  x, y, iLen, iMarcLen, iTmp : integer;
  sYear, sYear2, sDate : string;
  sTmp, sStr, sLen, sMarcRec  : string;
begin
  with tMarcStringGrid do begin
    if Cells[1,1] = '' then begin
      ShowMessage('没有可以保存的数据。');
      exit;
    end;

    sYear  := FormatDateTime('YY', Date);
    sYear2 := FormatDateTime('YYYY', Date);
    sDate  := FormatDateTime('YYYYMMDD', Date);

    tMarcSaveDialog.Filter := 'ISO2709文件格式(*.iso)|*.iso|MARC文本文件格式(*.txt)|*.txt';
    if tMarcSaveDialog.Execute then begin
      AssignFile(tMarcFile, tMarcSaveDialog.Filename);
      Rewrite(tMarcFile);
      for x := 1 to RowCount - 1 do begin
        sLen := '';   //记录标记的索引字符串
        sTmp := '';   //临时存储标记的内容
        sStr := '';   //纪录标记的内容
        iLen := 0;    //记录标记的长度
        iTmp := 0;    //纪录标记的起始位置
        iMarcLen := 0;//该纪录的总长度
        for y := 1 to ColCount - 1 do begin
          case y of
          1 : begin
                sTmp := Chr(30) + '01' + sYear + Format('%.6d', [x]);
                sStr := sTmp;
                iLen := Length(sTmp);
                sLen := '001' + Format('%.4d%.5d', [iLen,0]);
                iTmp := iLen;

                sTmp := Chr(30) + Cells[y,x]+ '.0';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '005' + Format('%.4d%.5d', [iLen,iTmp]);
                iTmp := iTmp + iLen;
              end;
          2 : begin
                sTmp := Chr(30)+ '  ' +Chr(31) +'a' + Cells[y,x];
              end;
          3 : begin
                sTmp := sTmp + Chr(31) + 'b' + Cells[y,x];
              end;
          4 : begin
                sTmp := sTmp + Chr(31) + 'd' + 'CNY' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '010' + Format('%.4d%.5d', [iLen,iTmp]);
                iTmp := iTmp + iLen;
              end;
          5 : begin
                sTmp := Chr(30) + '  ' + Chr(31) + 'b' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '092' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          6 : begin
                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + sDate + 'd' + sYear2 + '    ' +
                        'em ' + 'y' +'0'+ 'chi' + 'y' + '0121' + '    ' + 'ea';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '100' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + '0 ' + Chr(31) + 'achi';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '101' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + '  ' + Chr(31) + 'aCN' + Chr(31) + 'b ';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '102' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + 'y   ' + 'z   ' +
                        '0' + '0' + '0' + 'y' + 'y';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '105' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '106' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          7 : begin
                sTmp := Chr(30) + '1 ' + Chr(31) + 'a' + Cells[y,x];
              end;
          8 : begin
                sTmp := sTmp + Chr(31) + 'f' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '200' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          9 : begin
                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + Chr(31) + 'c' + Cells[y,x] +
                        Chr(31) + 'd' + sDate;
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '210' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          10: begin
                sTmp := Chr(30) + '  ' + Chr(31) + 'a' +'10页'+ Chr(31) + 'd' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '215' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          11: begin
{               sTmp := Chr(30) + '  ' + Chr(31) + 'a' + '明信片为荣宝斋版明信片中《中国古代美术》系刊之一。一般读者对“扬州八怪”并不陌生,但对“扬州八怪”产生的社会背景、代表画家及其艺术风格不一定清楚。此明信片以八位画家的代表作品和简历对这一画派做了概括的介绍。';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '330' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
}
                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + '读者对象:各界读者';
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '333' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + '  ' + Chr(31) + 'a' + Cells[y,x];
              end;
          12: begin   //有问题
                sTmp := sTmp + Chr(31) + 'v' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '690' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          13: begin
                sTmp := Chr(30) + ' 0' + Chr(31) + 'a' + Cells[y,x];
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '701' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;

                sTmp := Chr(30) + ' 3' + Chr(31) + 'a' + 'CN' + Chr(31) + 'b' + 'HBSW' +
                        Chr(31) + 'c' + sDate;
                sStr := sStr + sTmp;
                iLen := Length(sTmp);
                sLen := sLen + '801' + Format('%.4d%.5d', [iLen, iTmp]);
                iTmp := iTmp + iLen;
              end;
          end;
        end;
        iMarcLen := Length(sLen + sStr) + 24 + 2;
        sMarcRec := Format('%.5d', [iMarcLen]) + 'nam0 2200229   45  ' +
                    sLen + sStr + Chr(30) + Chr(29);
        Writeln(tMarcFile, sMarcRec);
      end;
      CloseFile(tMarcFile);
    end;
  end;
end;

end.

⌨️ 快捷键说明

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