rm_barcode.pas

这是一个功能强大

  liPos: Integer;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Label1, 'Caption', rmRes + 260);
  RMSetStrProp(Label16, 'Caption', rmRes + 261);
  RMSetStrProp(Label14, 'Caption', rmRes + 261);
  RMSetStrProp(Label15, 'Caption', rmRes + 261);

  RMSetStrProp(Label2, 'Caption', rmRes + 262);
  RMSetStrProp(Label4, 'Caption', rmRes + 263);
  RMSetStrProp(Label3, 'Caption', rmRes + 264);
  RMSetStrProp(Label5, 'Caption', rmRes + 265);
  RMSetStrProp(CheckBox2, 'Caption', rmRes + 660);
  RMSetStrProp(Label6, 'Caption', rmRes + 661);
  RMSetStrProp(Label9, 'Caption', rmRes + 662);
  RMSetStrProp(CheckBox1, 'Caption', rmRes + 663);
  RMSetStrProp(CheckBox3, 'Caption', rmRes + 664);
  RMSetStrProp(rb1, 'Caption', rmRes + 665);
  RMSetStrProp(rb2, 'Caption', rmRes + 666);
  RMSetStrProp(rb3, 'Caption', rmRes + 665);

  RMSetStrProp(CheckBox5, 'Caption', rmRes + 660);
  RMSetStrProp(Label7, 'Caption', rmRes + 667);
  RMSetStrProp(Label8, 'Caption', rmRes + 662);
  RMSetStrProp(Label13, 'Caption', rmRes + 661);
  RMSetStrProp(Label10, 'Caption', rmRes + 668);
  RMSetStrProp(Label12, 'Caption', rmRes + 669);
  RMSetStrProp(Label11, 'Caption', rmRes + 670);
  cmbMaxiMode.Items.Clear;
  cmbMaxiMode.Items.Add(RMLoadStr(rmRes + 672));
  cmbMaxiMode.Items.Add('cmMode3');
  cmbMaxiMode.Items.Add(RMLoadStr(rmRes + 673));
  cmbMaxiMode.Items.Add(RMLoadStr(rmRes + 674));
  cmbMaxiMode.Items.Add('cmMode6');

  RMSetStrProp(DBBtn, 'Hint', rmRes + 656);

  str := RMLoadStr(rmRes + 671);
  ComboBox2.Items.Clear;
  liPos := Pos(';', str);
  while liPos > 0 do
  begin
    ComboBox2.Items.Add(Copy(str, 1, liPos - 1));
    Delete(str, 1, liPos);
    liPos := Pos(';', str);
  end;
  ComboBox2.Items.Add(str);
  ComboBox4.Items.Assign(ComboBox2.Items);

  btnOk.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRM2DBarCodeForm.ShowSample;
var
  Xsize, Ysize: integer;
begin
  if Check2BarCode(edtCode.text) = false then //条码 连续的数字溢出
    exit;
  if FBusy then
    Exit;

  FBusy := True;
  Fpdf417.code := '';
  ySize := FPDF417.Height;
  xSize := FPDF417.Width;

  if Choos2DType.ActivePage = tabSheet1 then //PDF417
  begin
    Fpdf417.BarWidth := FSpinEdit1.AsInteger;
    Fpdf417.NumColumns := FSpinEdit2.AsInteger;
    Fpdf417.NumRows := FSpinEdit3.AsInteger;
    Fpdf417.Height := Ysize;
    Fpdf417.Width := Xsize;
    case ComboBox1.ItemIndex of
      0: Fpdf417.ECCLevel := ecAuto;
      1: Fpdf417.ECCLevel := ecLevel0;
      2: Fpdf417.ECCLevel := ecLevel1;
      3: Fpdf417.ECCLevel := ecLevel2;
      4: Fpdf417.ECCLevel := ecLevel3;
      5: Fpdf417.ECCLevel := ecLevel4;
      6: Fpdf417.ECCLevel := ecLevel5;
      7: Fpdf417.ECCLevel := ecLevel6;
      8: Fpdf417.ECCLevel := ecLevel7;
      9: Fpdf417.ECCLevel := ecLevel8;
    else
      Fpdf417.ECCLevel := ecAuto;
    end;

    if CheckBox1.Checked then
      Fpdf417.Truncated := True
    else
      Fpdf417.Truncated := false;

    if CheckBox3.checked then
      Fpdf417.RelativeBarHeight := True
    else
      Fpdf417.RelativeBarHeight := False;

    //   If CheckBox4.checked Then
    //     Fpdf417.ParentColor := True
    //   Else
    //     Fpdf417.ParentColor := False;
    if rb2.Checked = True then
      Fpdf417.Alignment := taCenter
    else if rb1.Checked = True then
      Fpdf417.Alignment := taLeftJustify
    else if rb3.Checked = True then
      Fpdf417.Alignment := taRightJustify;

    if CheckBox2.Checked then
    begin
      Fpdf417.Caption := Edit1.Text;
      case ComboBox2.ItemIndex of
        0: Fpdf417.CaptionLayout := tlTop;
        1: Fpdf417.CaptionLayout := tlCenter;
        2: Fpdf417.CaptionLayout := tlBottom;
      else
        Fpdf417.CaptionLayout := tlCenter;
      end;
    end
    else
      Fpdf417.Caption := '';

    Fpdf417.Code := edtCode.text;
    label14.caption := 'Width:' + inttostr(Fpdf417.BarCodeWidth);
    label15.caption := 'Height:' + inttostr(Fpdf417.BarCodeHeight);
  end
  else if Choos2DType.ActivePage = tabSheet2 then //maxicode
  begin
    if cmbMaxiMode.ItemIndex = 0 then
    begin
      FMaxi.CarrierCountryCode := StrToInt(Edit2.Text);
      FMaxi.CarrierPostalCode := Edit3.Text;
      FMaxi.CarrierServiceClass := StrToInt(Edit4.Text);
      FMaxi.Mode := cmMode2;
    end
    else
    begin
      FMaxi.CarrierCountryCode := 0;
      FMaxi.CarrierPostalCode := '000000000';
      FMaxi.CarrierServiceClass := 0;
      FMaxi.Mode := cmMode4;
    end;

    if CheckBox5.Checked then
    begin
      FMaxi.Caption := Edit5.Text;
      case ComboBox4.itemindex of
        0: FMaxi.CaptionLayout := tlTop;
        1: FMaxi.CaptionLayout := tlCenter;
        2: FMaxi.CaptionLayout := tlBottom;
      else
        FMaxi.CaptionLayout := tlBottom;
      end;
    end
    else
      FMaxi.Caption := '';
    case cmbMaxiMode.ItemIndex of
      0: FMaxi.Mode := cmMode2;
      1: FMaxi.Mode := cmMode3;
      2: FMaxi.Mode := cmMode4;
      3: FMaxi.Mode := cmMode5;
      4: FMaxi.Mode := cmMode6;
    else
      FMaxi.Mode := cmMode4;
    end;
    FMaxi.code := edtCode.text;
    label14.caption := 'Width:' + inttostr(FMaxi.BarCodeWidth);
    label15.caption := 'Height:' + inttostr(FMaxi.BarCodeHeight);
  end
  else
  begin //其他 可以加入其他二维条码类型 退出
  end;

  FBusy := False;
end;

procedure TRM2DBarCodeForm.FormDestroy(Sender: TObject);
begin
  FPDF417.Free;
  FMaxi.Free;
end;

procedure TRM2DBarCodeForm.Edit1DblClick(Sender: TObject);
begin
  Edit1.Text := '';
end;

procedure TRM2DBarCodeForm.edtCodeChange(Sender: TObject);
begin

  if Check2BarCode(edtCode.Text) = False then
    Edtcode.Undo
  else
    ShowSample;
end;

procedure TRM2DBarCodeForm.CheckBox5Click(Sender: TObject);
begin
  ShowSample;
  if CheckBox5.Checked then
  begin
    ComboBox4.visible := True;
    label6.visible := True;
    edit5.visible := True;
    label9.visible := true;
  end
  else
  begin
    ComboBox4.visible := false;
    label6.visible := false;
    edit5.visible := False;
    label9.visible := False;
  end;
end;

procedure TRM2DBarCodeForm.CheckBox5KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if CheckBox5.Checked then
  begin
    ComboBox4.Enabled := True;
    label13.Enabled := True;
    edit5.Enabled := True;
    label8.Enabled := true;
  end
  else
  begin
    ComboBox4.Enabled := false;
    label13.Enabled := false;
    edit5.Enabled := False;
    label8.Enabled := False;
  end;
end;

procedure TRM2DBarCodeForm.SpinEdit1Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.ComboBox1Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.ComboBox2Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.Edit1Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.CheckBox1Click(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.CheckBox3Click(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.CheckBox4Click(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.Edit2Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.Edit4Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.Edit3Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.cmbMaxiModeChange(Sender: TObject);
begin
  if cmbMaxiMode.ItemIndex >= 0 then
    FMaxi.Mode := TStMaxiCodeMode(cmbMaxiMode.ItemIndex);
  ShowSample;

  if cmbMaxiMode.ItemIndex = 0 then
  begin
    label10.Enabled := True;
    label11.Enabled := True;
    label12.Enabled := True;
    edit2.Enabled := True;
    edit3.Enabled := True;
    edit4.Enabled := True;
  end
  else
  begin
    label10.Enabled := False;
    label11.Enabled := False;
    label12.Enabled := False;
    edit2.Enabled := False;
    edit3.Enabled := False;
    edit4.Enabled := False;
  end;
end;

procedure TRM2DBarCodeForm.ComboBox4Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.Edit5Change(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.FormShow(Sender: TObject);
begin
  Choos2DTypeChange(nil);
  cmbMaxiModeChange(nil);
  FBusy := False;
  ShowSample;
end;

function TRM2DBarCodeForm.Check2BarCode(S: ansistring): Boolean;
const
  Number = ['0'..'9']; //字符类型
var
  i, j, k: integer;
  WS: string;
  BKiss: TStringlist;
begin
  BKiss := TStringList.Create;
  try
    bKiss.Clear;
    S := Trim(S + '#');
    j := 0;
    Result := True;
    for i := 1 to Length(s) do
    begin
      WS := '';
      if not (S[i] in Number) then
      begin
        if Length(Copy(S, j + 1, i - j - 1)) <> 0 then
          WS := (Copy(S, j + 1, i - j - 1));
        j := i;
        if trim(WS) <> '' then
          BKiss.Append(ws);
      end;
    end;
    for k := 0 to BKiss.Count - 1 do
    begin
      if length(BKiss.Strings[k]) > 17 then
      begin
        Result := False;
        Application.MessageBox(Pchar('整形溢出错误,连续的数字不可以大于17位.' + #13 + '请效验数字类型字符"' +
          BKiss.Strings[k] +
          '"'), '错误', MB_OK +
          MB_ICONSTOP);

      end;
    end;
  finally
    FreeAndNil(BKiss);
  end;
end;

procedure TRM2DBarCodeForm.edtCodeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Check2BarCode(edtcode.Text) = false then
end;

procedure TRM2DBarCodeForm.SpeedButton2Click(Sender: TObject);
begin
  Application.MessageBox(Pchar(
    '二维条码PDF417技术的特点' + #13
    + '1 、信息量大 一个PDF417条码符号，可以将1848个字母字符或2729个数字字符或字母、数字混编字符进行    编码。在同等面积下，二维条码比一维条码信息含量高几十倍。' +
    #13
    + '2、容易印制 PDF417条码可以印在纸、卡片及各种常用条码载体上，可以用多种标准的打印技术及卡片印制   技术印制，包括：喷墨打印、激光打印、热敏／热转印条码打印机打印等。' +
    #13
    + '3、修正错误能力强 错误修正甚至可以将符号受损面积达50％的条码符号所含信息复现出来。' + #13
    + '4、译码可靠性高 在管理数据库测试中，阅读2000万个条码符号，没有出现一例译码错误，这说明PDF417具   有极高的可靠性。' +
    #13
    + '5、保密性强 PDF417可以把编码信息按密码格式进行编码,防止伪造条码符号或非法使用有关编码的信息。'
    ), '错误', MB_OK + MB_ICONINFORMATION);
end;

procedure TRM2DBarCodeForm.RB1Click(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.rb2Click(Sender: TObject);
begin
  ShowSample;
end;

procedure TRM2DBarCodeForm.rb3Click(Sender: TObject);
begin
  ShowSample;
end;

const
	cRM = 'RM_BarCode';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cRM, TRMBarCodeView, 'TRMBarCodeView');
    AddClass(cRM, TRM2DBarCodeView, 'TRM2DBarCodeView');
  end;
end;

initialization
  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);
//  RMRegisterObjectByRes(TRMBarCodeView, 'RM_BarCodeObject', RMLoadStr(SInsBarcode), nil);
//  RMRegisterObjectByRes(TRM2DBarCodeView, 'RM_2BARCODEOBJECT', RMLoadStr(SInsBarcode), nil);
  RMRegisterControls('ReportPage Additional', 'RM_OtherComponent', False,
    [TRMBarCodeView, TRM2DBarCodeView],
    ['RM_BarCodeObject', 'RM_2BARCODEOBJECT'],
    [RMLoadStr(SInsBarcode), RMLoadStr(SInsBarcode)]);

finalization

  {$ENDIF}
end.