flatcode.pas

风格控件。。支持数据库和界面风格优化

 Result[3] := Result[1] * 2;
end;

{Print the Barcode data :0-3 white Line;5-8 black Line;A-D black Line (2/5 in Height)}
procedure TFlatBarcode.OneBarProps(Data:Char;Var Width:Integer;var lt:TFlatLines);
begin
 case data of
   '0': begin width := Modules[0]; lt := ltWhite; end;
   '1': begin width := Modules[1]; lt := ltWhite; end;
   '2': begin width := Modules[2]; lt := ltWhite; end;
   '3': begin width := Modules[3]; lt := ltWhite; end;

   '5': begin width := Modules[0]; lt := ltBlack; end;
   '6': begin width := Modules[1]; lt := ltBlack; end;
   '7': begin width := Modules[2]; lt := ltBlack; end;
   '8': begin width := Modules[3]; lt := ltBlack; end;

   'A': begin width := Modules[0]; lt := ltBlack_half; end;
   'B': begin width := Modules[1]; lt := ltBlack_half; end;
   'C': begin width := Modules[2]; lt := ltBlack_half; end;
   'D': begin width := Modules[3]; lt := ltBlack_half; end;
 end;
end;

procedure TFlatBarcode.DrawUPC_AText(Canvas:TCanvas;width,wBorder:Integer);
var x,y,tCenter:Integer;
    Rect:TRect;
    str:String;
begin
 with Canvas do
  begin
        x           := wBorder - TextWidth('1')-2;
        y           := fBarHeight+fBarTop-(TextHeight('A') div 2);
        str         := BarText[1];
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := x+TextWidth(Str);
        Rect.Bottom := y+TextHeight(Str);
        TextRect(Rect,x,y,Str);
        Str         := Copy(BarText,2,5);
        x           := wBorder + ProLine;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := (width-ProLine) div 2;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
        str         := Copy(BarText,7,5);
        x           := (Width + ProLine)div 2;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := width - wBorder - ProLine;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
        str         := BarText[12];
        x           := Width - wBorder;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := width;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
  end;
end;

procedure TFlatBarcode.DrawEAN8Text(Canvas:TCanvas;width,wBorder:Integer);
var x,y,tCenter:Integer;
    Rect:TRect;
    str:String;
begin
 with Canvas do
  begin
        y           := fBarHeight+fBarTop-(TextHeight('A') div 2);
        str         := copy(BarText,1,4);
        x           := wBorder + ProLine;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := (width-ProLine) div 2;
        Rect.Bottom := y+TextHeight(Str);
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
        str         := copy(BarText,5,4);
        x           := (Width + ProLine)div 2;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := width - wBorder - ProLine;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
  end;
end;

procedure TFlatBarcode.DrawUPC_EText(Canvas:TCanvas;width,wBorder:Integer);
var x,y,tCenter:Integer;
    Rect:TRect;
    str:String;
begin
 with Canvas do
  begin
        y           := fBarHeight+fBarTop-(TextHeight('A') div 2);
        str         := copy(BarText,1,6);
        x           := wBorder + ProLine;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := width - wBorder - ProLine;
        Rect.Bottom := y+TextHeight(Str);
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
  end;
end;

procedure TFlatBarcode.DrawEAN13Text(Canvas:TCanvas;width,wBorder:Integer);
var x,y,tCenter:Integer;
    Rect:TRect;
    str:String;
begin
 with Canvas do
  begin
        x           := wBorder - TextWidth('1')-2;
        y           := fBarHeight+fBarTop-(TextHeight('A') div 2);
        str         := BarText[1];
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := x+TextWidth(Str);
        Rect.Bottom := y+TextHeight(Str);
        TextRect(Rect,x,y,Str);
        Str         := Copy(BarText,2,6);
        x           := wBorder + ProLine;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := (width-ProLine) div 2;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
        str         := Copy(BarText,8,6);
        x           := (Width + ProLine)div 2;
        Rect.Left   := x;
        Rect.Top    := y;
        Rect.Right  := width - wBorder - ProLine;
        tCenter     := (Rect.Right + x - TextWidth(str)) div 2;
        TextRect(Rect,tCenter,y,Str);
  end;
end;

procedure TFlatBarcode.DrawBarcode;
var tCenter,i,xadd, x, y:Integer;
    lt : TFlatLines;
    fwidth, fheight,wBorder:integer;
    a,b,c,d, orgin : TPoint;
    bmpMem:TBitmap;
    Rect:TRect;
    str:String;
begin
 bmpMem:= TBitmap.Create;
 try
 with bmpMem.Canvas do
 begin
  Font.Assign(self.Font);
  wBorder    := TextWidth('1')*2 + fBorderWidth div 2;
  case CodeType of
   EAN13,EAN8,UPC_A,UPC_EODD,UPC_EVEN:
     xadd    := wBorder
  else
     xadd    := fBorderWidth;
  end;
  orgin.x := xadd;//Left;
  orgin.y := fBarTop;//Top 0;
  bmpMem.Width   := xadd;
  bmpMem.Height  := fBarHeight+fBarTop;
  brush.Style := bsClear;
  Brush.Color := Color;
  FillRect(ClipRect);
  Pen.Width   := 1;
  for i:=1 to Length(data) do
   begin
    OneBarProps(Data[i],fWidth,lt);
    Pen.Color   := fBarColor;//clWhite;
    brush.Style := bsClear;
    Brush.Color := Color;
    if (lt = ltBlack) or (lt = ltBlack_half) then
        Brush.Color := fBarColor;//clBlack
    if lt = ltBlack_half then
       fheight := bmpMem.Height * 2 div 5
    else
       fheight := bmpMem.Height;
    GetABCED(a,b,c,d,orgin,xadd,fWidth,fHeight);
    Polygon([a,b,c,d]);
    xadd        := xadd + fwidth;
    bmpMem.Width   := xadd;
   end;//结束画直线
  Brush.Color := Color;
  Rect        := ClipRect;
  Rect.Bottom := fBarTop;
  FillRect(Rect);
  Rect        := ClipRect;
  Rect.Right  := fBorderWidth;
  FillRect(Rect);
  if fShowText then
   begin
     if (CodeType = EAN13)or(CodeType = EAN8)or
        (CodeType = UPC_A)or(CodeType = UPC_EODD)or
        (CodeType = UPC_EVEN) then
      begin
        bmpMem.Height     := bmpMem.Height + TextHeight('A') div 2;
        bmpMem.Width      := xadd + wBorder;
        case CodeType of
          EAN13  : DrawEAN13Text(bmpMem.Canvas,bmpMem.Width,wBorder);
          EAN8   : DrawEAN8Text(bmpMem.Canvas,bmpMem.Width,wBorder);
          UPC_A  : DrawUPC_AText(bmpMem.Canvas,bmpMem.Width,wBorder);
        else  //UPC_EODD,UPC_EVEN;
          DrawUPC_EText(bmpMem.Canvas,bmpMem.Width,wBorder);
        end;
      end
     else
      begin
       bmpMem.Height     := bmpMem.Height + TextHeight('A');
       bmpMem.Width      := xadd + fBorderWidth;
       if bmpMem.Width > TextWidth(BarText) then
          tCenter:=(bmpMem.width-TextWidth(BarText))div 2
       else
          tCenter:=0;
       case CodeType of
         Code93Ext,
         Code39Ext:Str := Copy(BarText,3,Length(BarText)-2);
       else
         Str := BarText;
       end;
       TextOut(tCenter, fBarHeight+fBarTop, Str);
      end;
   end
  else
   begin
     bmpMem.Width   := xadd + fBorderWidth;
     Rect        := ClipRect;
     Rect.Top    := Rect.Bottom - fBarTop;
     FillRect(Rect);
   end;  
   case fRotateType of
    raNone:fBitmap.Assign(bmpMem);
    ra270:begin
            fBitmap.width  := bmpMem.Height;
            fBitmap.Height := bmpMem.Width;
            for x:=0 to bmpMem.Height-1 do
               for y:=0 to bmpMem.Width-1 do
                   fBitmap.canvas.Pixels[(-x+bmpMem.Height),y]:=Pixels[y,x];
          end;
    ra180:begin
            fBitmap.width  := bmpMem.Width;
            fBitmap.Height := bmpMem.Height;
            for x:=0 to bmpMem.Height-1 do
               for y:=0 to bmpMem.Width-1 do
                   fBitmap.canvas.Pixels[(bmpMem.Width-y),(bmpMem.Height-x)]:=Pixels[y,x];
          end;
    ra090:begin
            fBitmap.width  := bmpMem.Height;
            fBitmap.Height := bmpMem.Width;
            for x:=0 to bmpMem.Height-1 do
               for y:=0 to bmpMem.Width-1 do
                   fBitmap.canvas.Pixels[x,(bmpMem.Width-y)]:=Pixels[y,x];

          end;
   end;
 end;
 finally
 bmpMem.free;
 end;
end;

{Print the Barcode data :0-3 white Line;5-8 black Line;A-D black Line (2/5 in Height)}
procedure TFlatBarcode.Paint;
begin
 DrawBarcode;
 inherited Paint;
 if AutoSize then
 begin
    Width  := fBitmap.Width;
    Height := fBitmap.Height;
 end;
 fBitmap.Transparent := fTransparent;
 if FTransparent then
 begin
    DrawparentImage(self, Canvas);
 end;
 Canvas.StretchDraw(ClientRect,fBitmap);
end;   

procedure TFlatBarcode.SetRotateType(const Value: TFlatRotation);
begin
 if FRotateType <> value then
  begin
    FRotateType := Value;
    Invalidate;
  end;
end;

function TFlatBarcode.GetTypName: String;
begin
 result := BCData[CodeType].Name;
end;

function TFlatBarcode.GetProLine: Integer;
var Inx,w:Integer;
    TempStr:String;
    lt : TFlatLines;
begin
 Result  := 0;
 TempStr := '505';
 for Inx := 1 to Length(TempStr) do
   begin
     OneBarProps(TempStr[Inx],w,lt);
     Inc(Result,W);
   end;
end;

procedure TFlatBarcode.SetText(const Value: string);
begin
 if fText <> Value then
  begin
    fText := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetBarHeight(const Value: Integer);
begin
 if fBarHeight <> Value then
  begin
    fBarHeight := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetBorderWidth(const Value: Byte);
begin
 if fBorderWidth <> Value then
 begin
  fBorderWidth := Value;
  Invalidate;
 end;
end;

procedure TFlatBarcode.SetBarColor(const Value: TColor);
begin
 if fBarColor <> Value then
  begin
   fBarColor := Value;
   Invalidate;
  end;
end;

procedure TFlatBarcode.SetRatio(const Value: double);
begin
 if FRatio <> Value then
  begin
    FRatio := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetCodeType(const Value: TFlatColeType);
begin
 if FCodeType <> Value then
  begin
    FCodeType := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetModul(const Value:Integer);
begin
 if (Value >= 1) and (Value  < 50) then
  begin
    fModul  := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetBarTop(const Value: Byte);
begin
 if fBarTop <> Value then
  begin
    fBarTop := Value;
    Invalidate;
  end;
end;

procedure TFlatBarcode.SetColor(const Value: TColor);
begin
 if FColor <> Value then
 begin
    FColor := Value;
    Invalidate;
 end;
end;

procedure TFlatBarcode.FontChange(sender: TObject);
begin
  Invalidate;
end;

procedure TFlatBarcode.WMSize(var Message: TWMSize);
begin
  inherited;
  Invalidate;
end;

procedure TFlatBarcode.SetBools(Index: Integer; Value: Boolean);
begin
  case index of
   0: fAutoSize       := Value;
   1: FCheckSum       := Value;
   2: fCheckOdd       := Value;
   3: FShowText       := Value;
   4: fTransparent    := Value;
  end;
  invalidate;
end;

end.