rm_asbarview.pas

这是一个功能强大

  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 1); // 版本号
  RMWriteBoolean(aStream, FBarInfo.ShowText);
  RMWriteInt32(aStream, FBarInfo.Zoom);
  RMWriteFloat(aStream, FBarInfo.Ratio);
  RMWriteByte(aStream, Byte(FBarInfo.BarType));
  RMWriteBoolean(aStream, FBarInfo.Checksum);
  RMWriteByte(aStream, Byte(FBarInfo.CheckSumMethod));
  RMWriteByte(aStream, Byte(FBarInfo.Angle));
  RMWriteInt32(aStream, FBarInfo.ColorBar);
  RMWriteFont(aStream, FBarInfo.TextFont);
end;

procedure TRMAsBarCodeView.Draw(aCanvas: TCanvas);
var
  lStr: string;
  lEmptyStrFlag: Boolean;
  lPicWidth, lPicHeight: Integer;
  lTxtHeight: Integer;

  procedure _DrawOneLine(aCanvas: TMetafileCanvas; x, x1, x2: Integer; s: string);
  begin
    if FBarInfo.BarCode.Angle = 90 then
    begin
      aCanvas.FillRect(Rect(lPicWidth - lTxtHeight, lPicHeight - x1, lPicWidth, lPicHeight - x2 - 1));
      aCanvas.TextOut(lPicWidth - lTxtHeight, lPicHeight - x, s);
    end
    else if FBarInfo.BarCode.Angle = 180 then
    begin
      aCanvas.FillRect(Rect(lPicWidth - x1, 0, lPicWidth - x2 - 1, lTxtHeight + 2));
      aCanvas.TextOut(lPicWidth - x, lTxtHeight, s);
    end
    else if FBarInfo.BarCode.Angle = 270 then
    begin
      aCanvas.FillRect(Rect(0, x1, lTxtHeight, x2 + 1));
      aCanvas.TextOut(lTxtHeight, x, s);
    end
    else
    begin
      aCanvas.FillRect(Rect(x1, lPicHeight - lTxtHeight - 2, x2 + 1, lPicHeight));
      aCanvas.TextOut(x, lPicHeight - lTxtHeight, s);
    end;
  end;

  procedure _DrawText(aCanvas: TMetafileCanvas);
  var
    lOldFont, lNewFont: HFont;
    lBarWidth: Integer;
  begin
    if not FBarInfo.ShowText then Exit;

    lBarWidth := FBarInfo.BarCode.Width;
    lStr := FBarInfo.Text;
    with aCanvas do
    begin
      Font.Assign(FBarInfo.TextFont);
      lNewFont := CreateRotatedFont(Font, Round(FBarInfo.BarCode.Angle));
      lOldFont := SelectObject(Handle, lNewFont);
      Brush.Color := FBarInfo.BarCode.Color;
      case FBarInfo.BarCode.Typ of
        bcCodeEAN8:
          begin
            _DrawOneLine(aCanvas, 3, 3, 30, Copy(lStr, 1, 4));
            _DrawOneLine(aCanvas, 35, 35, lBarWidth - 4, Copy(lStr, 5, 4));
          end;
        bcCodeEAN13:
          begin
            if lStr[1] <> '0' then
              _DrawOneLine(aCanvas, -8, -8, -2, Copy(lStr, 1, 1));

            _DrawOneLine(aCanvas, 3, 3, 44, Copy(lStr, 2, 6));
            _DrawOneLine(aCanvas, 49, 49, lBarWidth - 4, Copy(lStr, 8, 6));
          end;
        bcCodeUPC_A:
          begin
            _DrawOneLine(aCanvas, -8, -8, -2, Copy(lStr, 1, 1));
            _DrawOneLine(aCanvas, 10, 10, 44, Copy(lStr, 2, 5));
            _DrawOneLine(aCanvas, 49, 49, 83, Copy(lStr, 7, 5));
            _DrawOneLine(aCanvas, lBarWidth + 1, lBarWidth + 1, lBarWidth + 8, Copy(lStr, 12, 1));
          end;
        bcCodeUPC_E0, bcCodeUPC_E1:
          begin
            _DrawOneLine(aCanvas, 3, 3, 44, Copy(lStr, 1, 6));
            _DrawOneLine(aCanvas, lBarWidth + 1, lBarWidth + 1, lBarWidth + 8, Copy(lStr, 7, 1));
          end;
      else
        _DrawOneLine(aCanvas, (lBarWidth - TextWidth(lStr)) div 2, 0, lBarWidth, lStr);
      end;

      SelectObject(Handle, lOldFont);
      DeleteObject(lNewFont);
    end;
  end;

  procedure _DrawBarCode(aCanvas: TCanvas; aRect: TRect);
  var
    lEMF: TMetafile;
    lEMFCanvas: TMetafileCanvas;
    lBarWidth: Integer;
    lZoom: Extended;
  begin
    try
      FBarInfo.BarCode.MakeData;
    except
      FBarInfo.Text := cbDefaultText;
      FBarInfo.BarCode.MakeData;
    end;

    lBarWidth := FBarInfo.BarCode.Width;
    if (FBarInfo.BarCode.Angle = 0) or (FBarInfo.BarCode.Angle = 180) then
    begin
      lZoom := (aRect.Right - aRect.Left) / lBarWidth;
      lPicWidth := lBarWidth;
      lPicHeight := Round((aRect.Bottom - aRect.Top) / lZoom);
      FBarInfo.BarCode.Height := lPicHeight;
      if FBarInfo.ShowText then
      begin
        if FBarInfo.BarCode.Typ in [bcCodeEAN8, bcCodeEAN13, bcCodeUPC_A, bcCodeUPC_E0, bcCodeUPC_E1] then
        begin
          FBarInfo.BarCode.Height := lPicHeight - lTxtHeight div 2;
          if FBarInfo.BarCode.Angle = 180 then
            FBarInfo.BarCode.Top := (lTxtHeight + 2) div 2;
        end
        else
        begin
          FBarInfo.BarCode.Height := lPicHeight - lTxtHeight - 2;
          if FBarInfo.BarCode.Angle = 180 then
            FBarInfo.BarCode.Top := lTxtHeight + 2;
        end;
      end;
    end
    else
    begin
      lZoom := (aRect.Bottom - aRect.Top) / lBarWidth;
      lPicWidth := Round((aRect.Right - aRect.Left) / lZoom);
      lPicHeight := lBarWidth;
      FBarInfo.BarCode.Height := lPicWidth;
      if FBarInfo.ShowText then
      begin
        if FBarInfo.BarCode.Typ in [bcCodeEAN8, bcCodeEAN13, bcCodeUPC_A, bcCodeUPC_E0, bcCodeUPC_E1] then
        begin
          FBarInfo.BarCode.Height := lPicWidth - lTxtHeight div 2;
          if FBarInfo.BarCode.Angle = 270 then
            FBarInfo.BarCode.Left := (lTxtHeight + 2) div 2;
        end
        else
        begin
          FBarInfo.BarCode.Height := lPicWidth - lTxtHeight - 2;
          if FBarInfo.BarCode.Angle = 270 then
            FBarInfo.BarCode.Left := lTxtHeight + 2;
        end;
      end;
    end;

    if (lPicWidth > 0) and (lPicHeight > 0) then
    begin
      lEMF := TMetafile.Create;
      lEMF.Width := lPicWidth;
      lEMF.Height := lPicHeight;
      lEMFCanvas := TMetafileCanvas.Create(lEMF, 0);
      try
        FBarInfo.BarCode.DrawBarcode(lEMFCanvas);
        _DrawText(lEMFCanvas);
        FreeAndNil(lEMFCanvas);
        aCanvas.StretchDraw(aRect, lEMF);
      finally
        lEMF.Free;
        lEMFCanvas.Free;
      end;
    end;
  end;

begin
  if (spWidth < 0) or (spHeight < 0) then Exit;

  lTxtHeight := RM_Utils.RMCanvasHeight('aa', FBarInfo.TextFont);
  lEmptyStrFlag := False;
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  if (Memo1.Count > 0) and (Length(Memo1[0]) > 0) and (Memo1[0][1] <> '[') then
    lStr := Trim(Memo1.Strings[0])
  else
  begin
    lEmptyStrFlag := True;
    lStr := cbDefaultText;
  end;

  if bcData[FBarInfo.BarType].Num = False then
    FBarInfo.Text := lStr
  else if RMIsNumeric(lStr) then
    FBarInfo.Text := lStr
  else
  begin
    lEmptyStrFlag := True;
    FBarInfo.Text := cbDefaultText;
  end;

//  FBarInfo.BarCode.Modul := FBarInfo.Modul;
//  FBarInfo.BarCode.Ratio := FBarInfo.Ratio;

//  if AutoSize then
  begin
    try
      if (FBarInfo.BarCode.Angle = 0) or (FBarInfo.BarCode.Angle = 180) then
      begin
      	FBarInfo.BarCode.Width := spWidth;
        spWidth := FBarInfo.BarCode.Width + spGapLeft * 2 + _CalcHFrameWidth(LeftFrame.Width, RightFrame.Width);;
      end
      else
      begin
      	FBarInfo.BarCode.Width := spHeight;
        spHeight := FBarInfo.BarCode.Width + spGapTop * 2 + _CalcVFrameWidth(TopFrame.Width, BottomFrame.Width);
      end;
    except
      on e: Exception do
      begin
      end;
    end;
  end;
//  else
//  begin
//		FBarInfo.Zoom := 1;
//    FBarInfo.Ratio := 2;
//  end;

  CalcGaps;
  ShowBackground;
  if not lEmptyStrFlag then
  begin
    InflateRect(RealRect, -_CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth) - spGapLeft,
      -_CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth) - spGapTop);
    _DrawBarCode(aCanvas, RealRect);
  end;
  ShowFrame;
  RestoreCoord;
end;

procedure TRMAsBarCodeView.PlaceOnEndPage(aStream: TStream);
begin
  inherited;
{  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  InternalOnBeforePrint(Memo1, Self);
  if not Visible then Exit;
//  if IsPrinting and (not PPrintFrame) then Exit;

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

  aStream.Write(Typ, 1);
  RMWriteString(aStream, ClassName);
  SaveToStream(aStream);
}end;

procedure TRMAsBarCodeView.DefinePopupMenu(aPopup: TRMCustomMenuItem);
begin
  inherited;
end;

procedure TRMAsBarCodeView.ShowEditor;
begin
end;

function TRMAsBarCodeView.GetDirectDraw: Boolean;
begin
  Result := (FFlags and flBarCodeDirectDraw) = flBarCodeDirectDraw;
end;

procedure TRMAsBarCodeView.SetDirectDraw(Value: Boolean);
begin
  FFlags := (FFlags and not flBarCodeDirectDraw);
  if Value then
    FFlags := FFlags + flBarCodeDirectDraw;
end;

function TRMAsBarCodeView.GetAutoSize: Boolean;
begin
  Result := (FFlags and flBarCodeAutoSize) = flBarCodeAutoSize;
end;

procedure TRMAsBarCodeView.SetAutoSize(Value: Boolean);
begin
  FFlags := (FFlags and not flBarCodeAutoSize);
  if Value then
    FFlags := FFlags + flBarCodeAutoSize;
end;

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

const
  cRM = 'RM_AsBarView';

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

initialization
  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);
//  RMRegisterObjectByRes(TRMAsBarCodeView, 'RM_BARCODEOBJECT', RMLoadStr(SInsBarcode), nil);
  RMRegisterControl('ReportPage Additional', 'RM_OtherComponent', False,
    TRMAsBarCodeView, 'RM_BARCODEOBJECT', RMLoadStr(SInsBarcode));

finalization

end.