Static控件

开发平台：
Delphi

pQRBarCode.pas：源码内容
							// =============================================================================
//
// Barcode VCL Component for Quick Report
//
// For Delphi 4/5/6/7, C++ Builder 4/5/6, BDS 2005/2005, Turbo Delphi 2006
//
// Copyright (c) 2001, 2007  Han-soft Software, all rights reserved.
//
// $Rev: 44 $   $Id: pQRBarCode.pas 44 2007-01-16 01:16:04Z hanjy $
//
// =============================================================================
unit pQRBarCode;
interface
uses
  Windows, Messages, SysUtils, Classes, Controls, QuickRpt, QRCtrls, Graphics,
  Forms, HBarcode;
{$I 'BarCode.inc'}
type
  TInvalidChar = procedure(Sender: TObject; var Barcode: string) of object;
  TQRBarcode = class(TQRImage)
  private
    { Private declarations }
    FBarCode        : string;           //Barcode value
    FBarType        : TBarType;         //Barcode Type
    FBarHeight      : Integer;          //Barcode Height
    FModul          : Integer;          //Width of thin bar
    FRatio          : Double;           //Ratio of thick and thin bar
    FCheckSum       : TCheckSum;        //Algorithms of checksum
    FColorSpc       : TColor;           //Background color
    FColorBar       : TColor;           //Bar color
    FOrientation    : TOrientation;     //Orientation of barcode
    FTextShow       : TTextShow;        //Content of barcode text to display
    FTextPosition   : TTextPosition;    //Position of barcode text to display
    FTextColor      : TColor;           //Background color of text to display
    FHMargin        : Integer;          //Left and right margin when auto width
    FAutoWidth      : Boolean;
    FFont           : TFont;
    //FRotation       : Double;
    FOnChange       : TNotifyEvent;
    FOnInvalidChar  : TInvalidChar;
    FDisplayBar     : Boolean;
    function  GetAngle:Double;
    procedure SetBarType(const Value: TBarType); 
    procedure SetBarHeight(const Value: Integer);
    procedure SetModul(const Value: Integer);
    procedure SetRatio(const Value: Double);
    procedure SetCheckSum(const Value: TCheckSum);
    procedure SetColorSpc(const Value: TColor);
    procedure SetColorBar(const Value: TColor);
    procedure SetOrientation(const Value: TOrientation);
    procedure SetTextShow(const Value: TTextShow);
    procedure SetTextPosition(const Value: TTextPosition);
    procedure SetTextColor(const Value: TColor);
    procedure SetHMargin(const Value: Integer);
    procedure SetAutoWidth(const Value: Boolean);
    function GetBarTypeName: string;
    procedure SetAbout(const Value: string);
    function GetAbout: string;
    //procedure SetRotation(const Value: Double);
    procedure SetFont(const Value: TFont);
  protected
    { Protected declarations }
    procedure SetBarcode(const Value:string); virtual;
    procedure DoChange; virtual;
  public
    { Public declarations }
    constructor Create(Owner : TComponent); override;
    destructor  Destroy; override;
    procedure Assign(Source: TPersistent);override;
    procedure Paint; override;
    procedure Loaded; override;
    function  AutoSetWidth(H_Margin: Integer): Integer;
    function  GetBarWidth: Integer;
    function  GetBarHeight: Integer;
    property  BarTypeName  : string  read GetBarTypeName;
    property  BarWidth     : Integer read GetBarWidth;
  published
    { Published declarations }
    property BarType: TBarType read FBarType write SetBarType default bcCode39;
    property BarCode: string read FBarCode write SetBarCode;
    property BarHeight: Integer read FBarHeight write SetBarHeight default 0;
    property Modul: Integer read FModul write SetModul;
    property Ratio: Double read FRatio write SetRatio;
    property CheckSum:TCheckSum read FCheckSum write SetCheckSum default csNone;
    property ColorSpc: TColor read FColorSpc write SetColorSpc default clWhite;
    property ColorBar: TColor read FColorBar write SetColorBar default clBlack;
    property Orientation: TOrientation read FOrientation write SetOrientation
      default toLeftRight;
    property TextShow: TTextShow read FTextShow write SetTextShow default tsNone;
    property TextPosition: TTextPosition read FTextPosition write SetTextPosition
      default tpBottomCenter;
    property TextColor: TColor read FTextColor write SetTextColor default clWhite;
    property AutoWidth: Boolean read FAutoWidth write SetAutoWidth default False;
    property HMargin: Integer read FHMargin write SetHMargin default 0;
    //property Rotation: Double read FRotation write SetRotation;
    property About: string read GetAbout write SetAbout;
    property Font: TFont read FFont write SetFont;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnInvalidChar: TInvalidChar read FOnInvalidChar write FOnInvalidChar;
    property Alignment;
    property AutoSize;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
  end;
implementation
constructor TQRBarcode.Create(Owner : TComponent);
begin
 inherited Create(Owner);
  //Loaded;
  FDisplayBar   := False;
  FFont := TFont.Create;
  FOrientation  := toLeftRight;
  FModul        := 1;
  FRatio        := 2.0;
  FColorSpc     := clWhite;
  FColorBar     := clBlack;
  FBarCode      := '';
  FBarType      := bcCode39;
  FBarHeight    := 0;
  FCheckSum     := csNone;
  FTextColor    := clWhite;
  FTextShow     := tsNone;
  FTextPosition := tpBottomCenter;
  FHMargin      := 0;
  //FRotation     := 0;
  FAutoWidth    := False;
end;
destructor TQRBarcode.Destroy;
begin
  FFont.Free;
  inherited;
end;
{ Assign method }
procedure TQRBarcode.Assign(Source: TPersistent);
var
   BSource : TQRBarcode;
begin
  if Source is TQRBarcode then
  begin
    inherited;
    BSource       := TQRBarcode(Source);
    FOrientation  := BSource.FOrientation;
    FModul        := BSource.FModul;
    FRatio        := BSource.FRatio;
    FColorSpc     := BSource.FColorSpc;
    FColorBar     := BSource.FColorBar;
    FBarType      := BSource.FBarType;
    FBarCode      := BSource.FBarCode;
    FBarHeight    := BSource.FBarHeight;
    FCheckSum     := BSource.FCheckSum;
    FTextColor    := BSource.FTextColor;
    FTextShow     := BSource.FTextShow;
    FTextPosition := BSource.FTextPosition;
    FHMargin      := BSource.FHMargin;
    //FRotation     := BSource.FRotation;
    FAutoWidth    := BSource.FAutoWidth;
    FOnChange     := BSource.FOnChange;
  end;
end;
{ Paint method }
procedure TQRBarcode.Paint;
var
  B: TBitmap;
  Angle: Double;
  x, y, h, w: Integer;
begin
  //inherited;
  if FAutoWidth then AutoSetWidth(FHMargin);
  x := 0;
  y := 0;
  h := 0;
  Angle := GetAngle;
  Case FOrientation of
    toLeftRight, toRightLeft:
    begin
      if FBarHeight = 0 then h := Height else h := FBarHeight;
      w := GetBarWidth;
      if Alignment = taLeftJustify then
       x := 0
      else
        if Alignment = taRightJustify then
          x := Width - w
        else
          x := (Width - w) div 2;
      y := (Height - h) div 2;
    end;
    toTopBottom, toBottomTop:
    begin
      if FBarHeight = 0 then h := Width else h := FBarHeight;
      w := GetBarWidth;
      if Alignment = taLeftJustify then
       y := 0
      else
        if Alignment = taRightJustify then
          y := Height - w
        else
          y := (Height - w) div 2;
      x := (Width - h) div 2;
    end;
  end;
  //if FAutoWidth then AutoSetWidth(FHMargin);
  B := TBitmap.Create;
  try
    B.Empty;
    case FOrientation of
      toLeftRight, toRightLeft:
      begin
        B.Width := GetBarWidth;
        B.Height := Height;
      end;
      toTopBottom, toBottomTop:
      begin
        B.Width := Width;
        B.Height := GetBarWidth;
      end;
    end;
    H_DrawBar(B.Canvas, FBarType, FBarCode, FModul, FRatio, FCheckSum, 0, 0, h,
      FFont, FTextShow, FTextPosition, FColorBar, FColorSpc, FTextColor, Angle);
    Picture.Bitmap.Empty;
    Picture.Bitmap.Width := Width;
    Picture.Bitmap.Height := Height;
    if Stretch then
    begin
      if FOrientation in [toLeftRight, toRightLeft] then
      begin
        h := Height;
        y := 0;
        case Alignment of
          taRightJustify:
          begin
            x := FHMargin * 2;
            w := Width;
          end;
          taCenter:
          begin
            x := FHMargin;
            w := Width - x;
          end;
          taLeftJustify:
          begin
            x := 0;
            w := Width - 2 * FHMargin;
          end;
        end;
      end
      else
      begin
        w := Width;
        x := 0;
        case Alignment of
          taRightJustify:
          begin
            y := FHMargin * 2;
            h := Height - 2 * FHMargin;
          end;
          taCenter:
          begin
            y := FHMargin;
            h := Height - 2 * FHMargin;
          end;
          taLeftJustify:
          begin
            y := 0;
            h := Height - 2 * FHMargin;
          end;
        end;
      end;
      StretchBlt(inherited Canvas.Handle, x, y, w, h, B.Canvas.Handle, 0, 0,
        B.Width, B.Height, SRCCOPY);
    end
    else
      BitBlt(inherited Canvas.Handle, x, y, B.Width, B.Height, B.Canvas.Handle,
        0, 0, SRCCOPY);
    inherited Paint;
  finally
    B.Free;
  end;
  
end;
{ OnChange Event }
procedure TQRBarcode.DoChange;
begin
  //Repair: Can not be previewed or printed when the component is not visible.
  //RePaint;
  if FDisplayBar then Paint;
  if Assigned(FOnChange) then FOnChange(Self);
end;
{ Auto adjust width method }
function TQRBarcode.AutoSetWidth(H_Margin: Integer): Integer;
begin
  result := GetBarWidth + 2 * (H_Margin);
  if FOrientation in [toLeftRight, toRightLeft] then
    Width := result
  else
    Height := result;
end;
{ Get barcode angle of left rotate }
function TQRBarcode.GetAngle:Double;
begin
  Case FOrientation of
    toLeftRight : result := 0;
    toRightLeft : result := 180;
    toTopBottom : result := 270;
    toBottomTop : result := 90;
    else
      result := 0;
  end ;
end;
{ Set HMargin }
procedure TQRBarcode.SetHMargin(const Value: Integer);
begin
  if Value <> FHMargin then
  begin
    FHMargin := Value;
    if AutoWidth then DoChange;
  end;
end;
{ Get barcode width }
function TQRBarcode.GetBarWidth: Integer;
begin
  result := H_GetBarWidth(FBarType,FBarCode,FModul,FRatio,FCheckSum);
end;
{ Set barcode value }
procedure TQRBarcode.SetBarcode(const Value: string);
label
  CheckAgain, TryAgain;
var
  tmp: string;
  chk: Boolean;
  i: Integer;
  NewValue: string;
begin
  if Value <> FBarCode then
  begin
    NewValue := Value;
    if BCdata[FBarType].num then
    begin
      CheckAgain:
      tmp := Trim(NewValue);
      chk := False;
      for i := 1 to Length(tmp) do
        chk := chk or ((tmp[i] > '9') or (tmp[i] < '0'));
      if chk then
      begin
        if Assigned(FOnInvalidChar) then FOnInvalidChar(Self, NewValue);
        if NewValue = Value then
          raise Exception.CreateFmt('%s: %s', [Value, ErrorBarcode])
        else
          goto CheckAgain;
      end
      else
        FBarCode := NewValue;
      DoChange;
    end
    else
    begin
      TryAgain:
      chk := False;
      try
        FBarCode := NewValue;
        DoChange;
      except
        if Assigned(FOnInvalidChar) then FOnInvalidChar(Self, NewValue);
        if NewValue = Value then
          raise Exception.CreateFmt('%s: %s', [Value, ErrorBarcode])
        else
          chk := True;
      end;
      if chk then goto TryAgain;
    end;
  end;
end;
{ Set barcode type }
procedure TQRBarcode.SetBarType(const Value: TBarType);
begin
  if Value <> FBarType then
  try
    FBarType := Value;
    DoChange;
  except 
    if Assigned(FOnInvalidChar) then FOnInvalidChar(Self, FBarcode) else raise;
  end;
end;
{ Set barcode height }
procedure TQRBarcode.SetBarHeight(const Value: Integer);
var
  HeightLimt: Integer;
begin
  if FOrientation in [toTopBottom, toBottomTop] then
    HeightLimt := Width
  else
    HeightLimt := Height;
  if Value <> FBarHeight then
  begin
    if (Value >= 0) and (Value <= HeightLimt) then
      FBarHeight := Value
    else
      FBarHeight := 0;
    DoChange;
  end;
end;
{ Get barcode height }
function  TQRBarcode.GetBarHeight: Integer;
begin
  if FOrientation in [toTopBottom, toBottomTop] then
    Result := Width
  else
    Result := Height;
  if (FBarHeight > 0) and (FBarHeight < Result) then
    Result := FBarHeight
  else
    FBarHeight := 0;
end;
{ Set barcode Algorithms of checksum }
procedure TQRBarcode.SetCheckSum(const Value: TCheckSum);
begin
  if Value <> FCheckSum then
  begin
     FCheckSum := Value;
     DoChange;
  end;
end;
{ Set ratio of thick and thin bar }
procedure TQRBarcode.SetRatio(const Value: Double);
begin
  if Value <> FRatio then
  begin
     FRatio := Value;
     DoChange;
  end;
end;
{
procedure TQRBarcode.SetRotation(const Value: Double);
begin
  if Value <> FRotation then
  begin
     FRotation := Value;
     DoChange;
  end;
end;
}
{ Set color of bar }
procedure TQRBarcode.SetColorBar(const Value: TColor);
begin
  if Value <> FColorBar then
  begin
     FColorBar := Value;
     DoChange;
  end;
end;
{ Set background color of barcode }
procedure TQRBarcode.SetColorSpc(const Value: TColor);
begin
  if Value <> FColorSpc then
  begin
     FColorSpc := Value;
     DoChange;
  end;
end;
{ Set width of thin bar }
procedure TQRBarcode.SetModul(const Value: Integer);
begin
  if Value <> FModul then
  begin
    if (Value >= 1) and (Value < 50) then
    begin
      FModul := Value;
      DoChange;
    end;
  end;
end;
{ Set Orientation of barcode }
procedure TQRBarcode.SetOrientation(const Value: TOrientation);
begin
  if Value <> FOrientation then
  begin
     FOrientation := Value;
     DoChange;
  end;
end;
{ Set barcode of text }
procedure TQRBarcode.SetTextColor(const Value: TColor);
begin
  if Value <> FTextColor then
  begin
     FTextColor := Value;
     DoChange;
  end;
end;
{ Set position of text }
procedure TQRBarcode.SetTextPosition(const Value: TTextPosition);
begin
  if Value <> FTextPosition then
  begin
     FTextPosition := Value;
     DoChange;
  end;
end;
procedure TQRBarcode.SetAutoWidth(const Value: Boolean);
begin
  if Value <> FAutoWidth then
  begin
     FAutoWidth := Value;
     DoChange;
  end;
end;
{ Set content of text }
procedure TQRBarcode.SetTextShow(const Value: TTextShow);
begin
  if Value <> FTextShow then
  begin
     FTextShow := Value;
     DoChange;
  end;
end;
{ Get type name of current barcode }
function TQRBarcode.GetBarTypeName: string;
begin
  result := BCdata[FBarType].Name;
end;
{ Get About }
function TQRBarcode.GetAbout: string;
begin
  Result := CopyrightInfo;
end;
{ Set About }
procedure TQRBarcode.SetAbout(const Value: string);
begin
  //
end;
procedure TQRBarcode.SetFont(const Value: TFont);
begin
  if Value <> FFont then
  begin
     //FFont := Value;
     FFont.Assign(Value);
     DoChange;
  end;
end;
procedure TQRBarcode.Loaded;
begin
  inherited;
  FDisplayBar := True;
end;
end.

						