rm_barc.pas

中小企业管理系统------ ERP系统原代码

    if (Length(Memo1[0]) > 0) and (Memo1[0][1] = '[') then
    begin
      try
        Memo1[0] := RMParser.Calc(Memo1[0]);
      except
        Memo1[0] := '0';
      end;
    end;
  end;

  Stream.Write(Typ, 1);
  RMWriteString(Stream, ClassName);
  SaveToStream(Stream);

  RMInterpretator.DoScript(Script_AfterPrint);
  Tag := SaveTag;
end;

procedure TRMBarCodeView.DefinePopupMenu(Popup: TPopupMenu);
begin
  // no specific items in popup menu
end;

procedure TRMBarCodeView.BarcodeEditor(Sender: TObject);
begin
  ShowEditor;
end;

procedure TRMBarCodeView.ShowEditor;
var
  tmpForm: TRMBarcodeForm;
begin
  tmpForm := TRMBarcodeForm.Create(nil);
  try
    with tmpForm do
    begin
      if Memo.Count > 0 then
        edtCode.Text := Memo.Strings[0];
      cbType.ItemIndex := ord(Param.cBarType);
      chkCheckSum.checked := Param.cCheckSum;
      chkViewText.Checked := Param.cShowText;
      eZoom.Text := IntToStr(Param.cModul);
      if Param.cAngle = 0 then
        RB1.Checked := True
      else if Param.cAngle = 90 then
        RB2.Checked := True
      else if Param.cAngle = 180 then
        RB3.Checked := True
      else
        RB4.Checked := True;
      if ShowModal = mrOk then
      begin
        RMDesigner.BeforeChange;
        Memo.Clear;
        Memo.Add(edtCode.Text);
        Param.cModul := StrToInt(eZoom.Text);
        Param.cCheckSum := chkCheckSum.Checked;
        Param.cShowText := chkViewText.Checked;
        Param.cBarType := TRMBarcodeType(cbType.ItemIndex);
        if RB1.Checked then
          Param.cAngle := 0
        else if RB2.Checked then
          Param.cAngle := 90
        else if RB3.Checked then
          Param.cAngle := 180
        else
          Param.cAngle := 270;
        RMDesigner.AfterChange;
      end;
    end;
  finally
    tmpForm.Free;
  end;
end;

function TRMBarCodeView.GetViewCommon: string;
begin
  Result := '[BarCode]';
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMBarCodeForm}

procedure TRMBarCodeForm.ShowSample;
var
  Txt: string;
  hg: Integer;
  h, oldh: HFont;
begin
  if IsNumeric(edtCode.Text) then
    FBarCode.Text := edtCode.Text
  else
    FBarCode.Text := cbDefaultText;
  FBarCode.Checksum := chkCheckSum.Checked;
  FBarCode.Typ := TRMBarcodeType(cbType.ItemIndex);
  FBarCode.Ratio := 2;
  FBarCode.Modul := StrToInt(eZoom.Text);
  if RB1.Checked then
    FBarCode.Angle := 0
  else if RB2.Checked then
    FBarCode.Angle := 90
  else if RB3.Checked then
    FBarCode.Angle := 180
  else
    FBarCode.Angle := 270;

  imgSample.Canvas.FillRect(Rect(0, 0, imgSample.Width, imgSample.Height));
  if (FBarCode.Angle = 90) or (FBarCode.Angle = 270) then
    hg := imgSample.Width - 14
  else
    hg := imgSample.Height - 14;

  FBarCode.Left := 0; FBarCode.Top := 0;
  FBarCode.Height := hg;
  if FBarCode.Angle = 180 then
    FBarCode.Top := imgSample.Height - hg
  else if FBarCode.Angle = 270 then
    FBarCode.Left := imgSample.Width - hg;

  Txt := FBarCode.Text;
  with imgSample.Canvas do
  begin
    Font.Color := clBlack;
    Font.Name := 'Courier New';
    Font.Height := -12;
    Font.Style := [];
    h := CreateRotatedFont(Font, Round(FBarCode.Angle));
    oldh := SelectObject(Handle, h);
    if FBarCode.Angle = 0 then
      TextOut((imgSample.Width - TextWidth(Txt)) div 2, imgSample.Height - 12, Txt)
    else if FBarCode.Angle = 90 then
      TextOut(imgSample.Width - 12, imgSample.Height - (imgSample.Height - TextWidth(Txt)) div 2, Txt)
    else if FBarCode.Angle = 180 then
      TextOut(imgSample.Width - (imgSample.Width - TextWidth(Txt)) div 2, 12, Txt)
    else
      TextOut(12, (imgSample.Height - TextWidth(Txt)) div 2, Txt);
    SelectObject(Handle, oldh);
    DeleteObject(h);
  end;

  FBarCode.DrawBarcode(imgSample.Canvas);
end;

procedure TRMBarCodeForm.FormCreate(Sender: TObject);
var
  i: TRMBarcodeType;
begin
  FBarCode := TRMBarCode.Create(Self);
  FBarCode.Height := ImgSample.ClientHeight;
  CbType.Items.Clear;
  for i := bcCode_2_5_interleaved to bcCodeEAN128C do
    cbType.Items.Add(bcData[i].Name);
  cbType.ItemIndex := 0;

  Localize;
end;

procedure TRMBarCodeForm.FormDestroy(Sender: TObject);
begin
  FBarCode.Free;
end;

procedure TRMBarCodeForm.FormActivate(Sender: TObject);
begin
  edtCode.SetFocus;
end;

procedure TRMBarCodeForm.DBBtnClick(Sender: TObject);
var
  s: string;
begin
  s := RMDesigner.InsertExpression;
  if s <> '' then
    edtCode.Text := s;
end;

procedure TRMBarCodeForm.btnOKClick(Sender: TObject);
var
  bc: TRMBarCode;
  Bmp: TBitmap;
begin
  bc := TRMBarCode.Create(nil);
  Bmp := TBitmap.Create;
  try
    bc.Text := edtCode.Text;
    bc.CheckSum := chkCheckSum.Checked;
    bc.Typ := TRMBarcodeType(cbType.ItemIndex);
    Bmp.Width := 16; Bmp.Height := 16;
    if (bc.Text = '') or (bc.Text[1] <> '[') then
    begin
      try
        bc.DrawBarcode(Bmp.Canvas);
      except
        MessageBox(0, PChar(RMLoadStr(SBarcodeError)), PChar(RMLoadStr(SError)),
          mb_Ok + mb_IconError);
        ModalResult := 0;
      end;
    end;
  finally
    Bmp.Free;
    bc.Free;
  end;
end;

procedure TRMBarCodeForm.edtCodeChange(Sender: TObject);
begin
  ShowSample;
end;

procedure TRMBarCodeForm.cbTypeChange(Sender: TObject);
begin
  ShowSample;
end;

procedure TRMBarCodeForm.chkCheckSumClick(Sender: TObject);
begin
  ShowSample;
end;

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

procedure TRMBarCodeForm.FormShow(Sender: TObject);
begin
  ShowSample;
end;

procedure TRMBarCodeForm.SpeedButton1Click(Sender: TObject);
var
  i: Integer;
begin
  i := StrToInt(eZoom.Text);
  Inc(i);
  eZoom.Text := IntToStr(i);
end;

procedure TRMBarCodeForm.SpeedButton2Click(Sender: TObject);
var
  i: Integer;
begin
  i := StrToInt(eZoom.Text);
  Dec(i);
  if i <= 0 then i := 1;
  eZoom.Text := IntToStr(i);
end;

procedure TRMBarCodeForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 650);
  RMSetStrProp(Label1, 'Caption', rmRes + 651);
  RMSetStrProp(Label2, 'Caption', rmRes + 652);
  RMSetStrProp(Label3, 'Caption', rmRes + 659);
  RMSetStrProp(GroupBox1, 'Caption', rmRes + 653);
  RMSetStrProp(chkCheckSum, 'Caption', rmRes + 654);
  RMSetStrProp(chkViewText, 'Caption', rmRes + 655);
  RMSetStrProp(DBBtn, 'Hint', rmRes + 656);
  RMSetStrProp(GroupBox2, 'Caption', rmRes + 658);
  btnOk.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

initialization
  RMRegisterObjectByRes(TRMBarCodeView, 'RM_BARCODEOBJECT', RMLoadStr(SInsBarcode), TRMBarCodeForm);

finalization

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档