Lazarus条形码组件

zwz

        该组件是由delphi下的一个组件包分离出来的条码组件,在Lazarus下编译安装通过,但还存在一些问题,查找了半天没有找出问题在什么地方,有需要的朋友请下载自行研究,如修改成功请发一份附件到社区,谢谢!

猫工

关注................

bruce0829

好像少了什麼 ... 無法安裝

zwz

bruce0829兄，无法安装可能是由于版本不同造成的，你把@去掉编译试试，我已编译安装，但存在的问题不知是什么原因，请你帮忙解决一下。

bruce0829

我的 Lazarus 0.9.28.2 版 uses 加個 windows 就可以 compile 了

試了一下午, 試不出來
討厭就討厭在沒有 compile 錯誤
若有錯誤, 通常把錯誤的地方解決就 OK
沒有錯誤, 就不知問題出在哪個環節
一定是有些物件屬性或方法, 在語法上跟 Delphi 相同 (所以沒有 compile 錯誤)
但呈現出來的結果不同

猫工

bruce0829 ：你在lazarus菜单里的configure build lazarus里改一下设置，在高级选择里把options加上 -g 的参数，再试试看可不可以捕捉到错误

zwz

我的lazarus0.9.29   fpc2.4.3  svn 27012 编译通过,麻烦bruce0829留个qq以便联系你,我的qq:1597317607

bruce0829

畫圖的部份解決了, 但條碼顯示不正確   ..... 仍然算是未解決

畫圖的部份說明一下
1.所有的 brush.Style := bsClear; 都被我 remark 起來, 因為聽說有 bug, 跟 Delphi 呈現效果不同
2.bmpMem 在一開始就決定其 Width 及 Height, 不要在 for loop 中追加改變它的值, 我發現只要動態去改變其值, 整個 Canvas 就變黑了 (又是一個跟 Delphi 不一樣的地方)
3.計算條碼間距的 Function 有問題, 算出的間距都太小, 條碼都結在一塊, 所以我加了個

fWidth:=fWidth*2; (放大間距)

4.對計算條碼間距的 Function 內部處理不熟悉, 只是聽說 Lazarus 有些變量 type 跟 Delphi 內部存放的 byte 數不同, 或許這是造成計算值有問題的原因


procedure TLazBarcode.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 := 218; //xadd;
bmpMem.Height := 46; //fBarHeight+fBarTop;
//brush.Style := bsClear;
Brush.Color := Color;
FillRect(ClipRect);
Pen.Width := 1;


for i:=1 to Length(data) do
begin
OneBarProps(Data,fWidth,lt);

fWidth:=fWidth*2;

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 div 2

,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;

zwz

研究透彻,继续学习,很感谢!我的功力确实还不够,学习Lazaurs还得多向你请教

bruce0829

問題還沒解決哩 ~ 條碼雖可印出, 但都是錯的

zwzqq 兄可以把 Delphi 的組件給我嗎 ?
使用交叉比對法, 把各函式傳回的值 LOG 下來做比對
就知哪個函式在 Lazarus 下是有問題的

(現在我家外面在刮颱風, 恐怖喔 ~)