我寫了一支列印的程式，可以在一般的噴墨或雷射的印表機列印出來， 但現在我要在列印時指定特定的標籤印表機，我該如何修改~ 我的列印的程式碼如下 procedure TMainForm.BitBtn1Click(Sender: TObject); Var x, y:Integer; iRecord:Integer; iLine:Integer; St:String; Rc:TRect; iW:Integer; Procedure PrintHeader; Begin y := 1; St := ''; x := Printer.Canvas.TextWidth(St); y := y (iLine * 1); y := iLine * 1; End; begin Printer.SetPrinter := BarCodePrinter1; if Printer = nil Then raise Exception.Create('找不到印表機'); Printer.Orientation := poLandscape; Printer.BeginDoc; Printer.Canvas.Font.Name := 'Times New Roman'; Printer.Canvas.Font.Size := 9; iLine := Printer.Canvas.TextHeight ('X'); iRecord := iLine * 3; PrintHeader; BCQry.DisableControls; BCQry.First; Try While not BCQry.EOF Do Begin if (y iRecord) >= Printer.PageHeight Then Begin Printer.NewPage; PrintHeader; End; DBDuckBarCode.Barcode.Text := BCQrydescrt.Text; Rc := DBDuckBarCode.PaintPoint (Printer.Canvas, Point (x, y iLine)); if vBCValue='True' then st :='' else st := BCQryaa.Text BCQrydescrt.Text; iW := Printer.Canvas.TextWidth (St); if iW < (Rc.Right - Rc.Left) Then Rc.Left := Rc.Left; Printer.Canvas.TextOut (Rc.Left, y, St); y := y iRecord; BCQry.Next; End; Finally Printer.EndDoc; BCQry.EnableControls; End; end;

指定 Printer.PrinterIndex 屬性值 您可用如下的方式將所有 Printer 的名稱載至一個 TListBox 中 再來指定 PrinterIndex

begin
  ListBox1.Items.Assign(Printer.Printers);
end;

-- 向 KTop 的弟兄們致敬!

我並不是想讓USER選擇從哪台印表機印出，我是要執行這列印動作時，固定從標籤印表機印出，標籤印表機的名稱是BarcodePrinter1，請告知我該如何做~

參考紅色的部份試試:

procedure TMainForm.BitBtn1Click(Sender: TObject);
Var
  x, y:Integer;
  iRecord:Integer;
  iLine:Integer;
  St:String;
  Rc:TRect;
  iW:Integer;
  idx: integer
Procedure PrintHeader;
Begin
     y        := 1;
     St        := '';
     x        := Printer.Canvas.TextWidth(St);
     y        := y   (iLine * 1);
     y := iLine * 1;
End;
begin
  //Printer.SetPrinter := BarCodePrinter1; // 這行 mark 掉
  idx := Printer.Printers.IndexOf('BarCodePrinter1');
  //if Printer = nil Then // 這行 mark 掉
  if idx = -1 then
    raise Exception.Create('找不到印表機');
  Printer.PrinterIdex := idx;
  Printer.Orientation := poLandscape;
  Printer.BeginDoc;
  Printer.Canvas.Font.Name := 'Times New Roman';
  Printer.Canvas.Font.Size := 9;
  iLine := Printer.Canvas.TextHeight ('X');
  iRecord := iLine * 3;
  PrintHeader;
  BCQry.DisableControls;
  BCQry.First;
  Try
  While not BCQry.EOF Do
  Begin
             if (y   iRecord) >= Printer.PageHeight Then
        Begin
           Printer.NewPage;
           PrintHeader;
        End;
        DBDuckBarCode.Barcode.Text := BCQrydescrt.Text;
             Rc := DBDuckBarCode.PaintPoint (Printer.Canvas, Point (x, y   iLine));            if vBCValue='True' then
        st :=''
        else
        st := BCQryaa.Text  BCQrydescrt.Text;            iW := Printer.Canvas.TextWidth (St);
        if iW < (Rc.Right - Rc.Left) Then
        Rc.Left        := Rc.Left;
        Printer.Canvas.TextOut (Rc.Left, y, St);
             y := y   iRecord;
        BCQry.Next;
     End;
  Finally
     Printer.EndDoc;
     BCQry.EnableControls;
  End;    end;     

-- 向 KTop 的弟兄們致敬! 發表人 - hagar 於 2004/07/23 12:09:21

hangar: 這個方法是可以列印，但要將印表機設成是預設的印表機才能列印，不然沒有反應~ 沒有沒什麼方法，就是不要設成預設的印表機， 照樣從BarCodePrinter1列印出來。 真的很謝謝您替我解答~

小弟實測了一下 發現用 Printer.Printers.IndexOf(Printer_Name) 的值 會等於預設表機所在 Printer.Printers 這 TStrings 中的 Index 值 也就是 Printer_Name 字串即使不在 Printer.Printers 這 TStrings 中 它的值也不會是 -1 而 Printer.PrinterIndex 值為 -1 的話 它是說如果要用預設印表機的話 這也是您說要設為預設印表機才有作用的原因 因此程式改成如下試試:

procedure TMainForm.BitBtn1Click(Sender: TObject);
Var
  x, y:Integer;
  iRecord:Integer;
  iLine:Integer;
  St:String;
  Rc:TRect;
  iW:Integer;
  idx: integer
  sl: TStringList;
Procedure PrintHeader;
Begin
     y        := 1;
     St        := '';
     x        := Printer.Canvas.TextWidth(St);
     y        := y   (iLine * 1);
     y := iLine * 1;
End;
begin
  sl := TStringList.Create;
  sl.Assign(Printer.Printers);
  idx := sl.IndexOf('BarCodePrinter1');
  sl.Free;
  if idx = -1 then
    raise Exception.Create('找不到印表機');
  Printer.PrinterIdex := idx;
  Printer.Orientation := poLandscape;
  ...

-- 向 KTop 的弟兄們致敬! 發表人 - hagar 於 2004/07/23 15:33:13

真的很感謝hagar版主替我解答 但我按照您給我的方式做，不管印表機指定哪一台，都會出現"找不到印表機"說~那又該如何解決??? 我又把if idx = -1 then raise Exception.Create(''找不到印表機'');Mark起來，變成還是要將BarCodePrinter1那台印表機設成預設值才可以印，請問我哪邊做錯了~ 再請教一下，您給我的程式碼中 Printer.PrinterIdex := idx; PrinterIdex==>這是不是少了一個n，我把他改成PrinterIndex跑才沒問題說~~

找不到印表機表示妳輸入的 Printer Name 不正確 建議妳用一個 TListBox 把所有的 Printer Name 載入 確認妳輸入的 Printer Name 是否正確    -- 向 KTop 的弟兄們致敬! 

嗯~果然是我Printer Name 不正確~謝謝您~ 這問題解決了，但又出現了另一問題。 最先未指定從特定印表機列印時，文字都從標籤紙的最左邊印到最右邊， 但現在指定印表機後，變成文字是從標籤紙寬的三分之一處開始列印，請問我該在哪邊的程式碼做修改。 procedure TMainForm.BitBtn1Click(Sender: TObject); Var x, y:Integer; iRecord:Integer; iLine:Integer; St:String; Rc:TRect; iW:Integer; idx: integer; sl: TStringList; Procedure PrintHeader; Begin y := 1; St := ''; x := Printer.Canvas.TextWidth(St); y := y (iLine * 1); y := iLine * 1; End; begin sl := TStringList.Create; sl.Assign(Printer.Printers); idx := sl.IndexOf('BarcodePrinter1 on COM2:'); sl.Free; if idx = -1 then raise Exception.Create('找不到印表機'); Printer.PrinterIndex := idx; Printer.Orientation := poLandscape; Printer.BeginDoc; Printer.Canvas.Font.Name := 'Times New Roman'; Printer.Canvas.Font.Size := 9; iLine := Printer.Canvas.TextHeight ('X'); iRecord := iLine * 3; PrintHeader; BCQry.DisableControls; BCQry.First; Try While not BCQry.EOF Do Begin if (y iRecord) >= Printer.PageHeight Then Begin Printer.NewPage; PrintHeader; End; DBDuckBarCode.Barcode.Text := BCQrydescrt.Text; Rc := DBDuckBarCode.PaintPoint (Printer.Canvas, Point (x, y iLine)); if vBCValue='True' then st :='' else st := BCQryaa.Text BCQrydescrt.Text; iW := Printer.Canvas.TextWidth (St); if iW < (Rc.Right - Rc.Left) Then Rc.Left := Rc.Left; Printer.Canvas.TextOut (Rc.Left, y, St); y := y iRecord; BCQry.Next; End; Finally Printer.EndDoc; BCQry.EnableControls; End; end; 再次謝謝hagar版主的細心教導~

Printer.Canvas.TextOut (Rc.Left, y, St); 此行是把 St 變數的值印出 由您描述的問題來看，應該是 Rc.Left 的值的問題        -- 向 KTop 的弟兄們致敬! 

我在試的過程中，發現若指定印表機的話， 列印的地方會從標籤紙寬的三分之一處開始列印， 但將印表機設成預設值的話，就是正常從左邊印到右邊。 且兩個方式的rc.left都是0說~ 那我該如何著手改這部份， 是要在列印的程式加入設定紙張大小嗎?還是????

小弟看不出原因 您可以用各種方法測 另外, 這行看來怪怪的, Rc.Left := Rc.Left？

if iW < (Rc.Right - Rc.Left) Then
  Rc.Left := Rc.Left;

-- 向 KTop 的弟兄們致敬!

我已將程式碼改成下面的樣子 procedure TMainForm.BitBtn1Click(Sender: TObject); Var   x, y:Integer;   iRecord:Integer;   iLine:Integer;   St:String;   Rc:TRect;   idx: integer;   sl: TStringList; Procedure PrintHeader; Begin      y        := 1;      St        := '';      x        := Printer.Canvas.TextWidth(St);      y        := y + (iLine * 1);      y := iLine * 1; End; begin   sl := TStringList.Create;   sl.Assign(Printer.Printers);   idx := sl.IndexOf('\\PRINTER_SERVER\3F-Public');    sl.Free;   if idx = -1 then raise Exception.Create('找不到印表機');   Printer.PrinterIndex := idx;   Printer.Orientation := poLandscape;   Printer.BeginDoc;   Printer.Canvas.Font.Name := 'Times New Roman';   Printer.Canvas.Font.Size := 9;   iLine := Printer.Canvas.TextHeight ('X');   iRecord := iLine * 3;   PrintHeader;   BCQry.DisableControls;   BCQry.First;   Try   While not BCQry.EOF Do   Begin         DBDuckBarCode.Barcode.Text := BCQrydescrt.Text;         Rc := DBDuckBarCode.PaintPoint (Printer.Canvas, Point (x, y iLine)); if vBCValue='True' then st :='' else st := BCQryaa.Text BCQrydescrt.Text; Printer.Canvas.TextOut (rc.left , y, St); y := y iRecord; BCQry.Next; End; Finally Printer.EndDoc; BCQry.EnableControls; End; end; 我覺的紅色那段，才是列出BarCode的程式碼 那你見意我該如何試呢? 且我今天測試的結果，從我這台電腦跟另一台電腦印同一台印表機，居然BarCode的啟始位置不一樣說~

procedure TMainForm.BitBtn1Click(Sender: TObject);
Var
  x, y:Integer;
  iRecord:Integer;
  iLine:Integer;
  St:String;
  Rc:TRect;
  idx: integer;
  sl: TStringList;
Procedure PrintHeader;
Begin
     y        := 1;
     St        := '';
     x        := Printer.Canvas.TextWidth(St); // 第一次 PrintHeader 時, St 變數未給值
     y        := y   (iLine * 1); // 這行的 y 值沒有用？
     y := iLine * 1;
End;
begin
  sl := TStringList.Create;
  sl.Assign(Printer.Printers);
  idx := sl.IndexOf('\\PRINTER_SERVER\3F-Public'); 
  sl.Free;
  if idx = -1 then raise Exception.Create('找不到印表機');
  Printer.PrinterIndex := idx;
  Printer.Orientation := poLandscape;
  Printer.BeginDoc;
  Printer.Canvas.Font.Name := 'Times New Roman';
  Printer.Canvas.Font.Size := 9;
  iLine := Printer.Canvas.TextHeight ('X');
  iRecord := iLine * 3;
  PrintHeader;
  BCQry.DisableControls;
  BCQry.First;
  Try
  While not BCQry.EOF Do
  Begin
        DBDuckBarCode.Barcode.Text := BCQrydescrt.Text;
        Rc := DBDuckBarCode.PaintPoint (Printer.Canvas, Point (x, y   iLine)); // DBDuckBarCode.PaintPoint 的實際內容是？
        if vBCValue='True' then
        st :=''
        else
        st := BCQryaa.Text  BCQrydescrt.Text;
        Printer.Canvas.TextOut (rc.left , y, St); // 這行是把 St 印出, 而印行的 X 座標值是 Rc.Left, Y 座標值是 y, 所以檢查是 X 座標還是 Y 座標出問題？
             y := y   iRecord;
        BCQry.Next;
     End;
  Finally
     Printer.EndDoc;
     BCQry.EnableControls;
  End;    end;

-- 向 KTop 的弟兄們致敬!

嗯，我會再檢查Printer.Canvas.TextOut (rc.left , y, St);的值 下面是DBDuckBarCode.PaintPoint 的實際內容 Function TDBDuckBarCode.PaintPoint (Canvas: TCanvas; pt: TPoint): TRect; Begin Result := FBarcode.PaintPoint (Canvas, pt); End; =========================================================== 我想我還是把整個元件的內容貼給您看好了~ Implementation Procedure Register; Begin RegisterComponents('DuckTech', [TDBDuckBarCode]); End; { ---------- TDBDuckBarCode ---------- } Constructor TDBDuckBarCode.Create(owner: TComponent); Begin inherited Create(owner); FBarcode := TDuckBarcode.Create (Self); FPicture := TPicture.Create; Color := clWhite; ControlStyle := ControlStyle [csOpaque, csReplicatable]; if not NewStyleControls then ControlStyle := ControlStyle [csFramed]; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FBorderStyle := bsSingle; End; Destructor TDBDuckBarCode.Destroy; Begin FPicture.Free; FDataLink.Free; FDataLink := nil; FBarcode.Free; inherited Destroy; End; Procedure TDBDuckBarCode.SetStyle (Const Value: TBarcodeStyle); Begin FBarcode.Style := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetStyle: TBarcodeStyle; Begin Result := FBarcode.Style; End; Procedure TDBDuckBarCode.SetRotation (Const Value: TBarcodeRotation); Begin FBarcode.Rotation := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetRotation: TBarcodeRotation; Begin Result := FBarcode.Rotation; End; Procedure TDBDuckBarCode.SetAddOn (Const Value: String); Begin FBarcode.AddOn := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetAddOn: String; Begin Result := FBarcode.AddOn; End; Procedure TDBDuckBarCode.SetHeightMM (Const Value: Double); Begin FBarcode.HeightMM := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetHeightMM: Double; Begin Result := FBarcode.HeightMM; End; Procedure TDBDuckBarCode.SetColor (Const Value: TColor); Begin FBarcode.ColorBar := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetColor: TColor; Begin Result := FBarcode.ColorBar; End; Procedure TDBDuckBarCode.SetColorBK (Const Value: TColor); Begin FBarcode.ColorBK := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetColorBK: TColor; Begin Result := FBarcode.ColorBK; End; Procedure TDBDuckBarCode.SetFont (Const Value: TFont); Begin FBarcode.Font := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetFont: TFont; Begin Result := FBarcode.Font; End; Procedure TDBDuckBarCode.SetDensity (Const Value: Integer); Begin FBarcode.Density := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetDensity: Integer; Begin Result := FBarcode.Density; End; Procedure TDBDuckBarCode.SetAlignment (Const Value: TAlignment); Begin FBarcode.Alignment := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetAlignment: TAlignment; Begin Result := FBarcode.Alignment; End; Procedure TDBDuckBarCode.SetBarWidth (Const Value: Double); Begin FBarcode.BarWidthMM := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetBarWidth: Double; Begin Result := FBarcode.BarWidthMM; End; Procedure TDBDuckBarCode.SetOptions (Const Value: TBarcodeOptions); Begin FBarcode.Options := Value; Picture.Graphic := FBarcode.GetBitmap; Invalidate; End; Function TDBDuckBarCode.GetOptions: TBarcodeOptions; Begin Result := FBarcode.Options; End; Function TDBDuckBarCode.GetDataField: String; Begin Result := FDataLink.FieldName; End; Procedure TDBDuckBarCode.SetDataField (Const Value: String); Begin FDataLink.FieldName := Value; End; Function TDBDuckBarCode.GetDataSource: TDataSource; Begin Result := FDataLink.DataSource; End; Procedure TDBDuckBarCode.SetDataSource (Value: TDataSource); Begin FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); End; Function TDBDuckBarCode.GetField: TField; Begin Result := FDataLink.Field; End; Procedure TDBDuckBarCode.SetBorderStyle(Value: TBorderStyle); Begin if FBorderStyle <> Value then Begin FBorderStyle := Value; RecreateWnd; End; End; Procedure TDBDuckBarCode.SetPicture(Value: TPicture); Begin FPicture.Assign(Value); End; Procedure TDBDuckBarCode.DataChange(Sender: TObject); Begin Picture.Graphic := nil; if Assigned (FDataLink.Field) Then Begin FBarcode.Text := FDataLink.Field.AsString; Picture.Graphic := FBarcode.GetBitmap; End; Invalidate; End; Procedure TDBDuckBarCode.CreateParams(var Params: TCreateParams); Begin inherited CreateParams(Params); With Params Do Begin if FBorderStyle = bsSingle Then if NewStyleControls and Ctl3D Then ExStyle := ExStyle or WS_EX_CLIENTEDGE Else Style := Style or WS_BORDER; WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); End; End; Procedure TDBDuckBarCode.Loaded; Begin inherited Loaded; if (csDesigning in ComponentState) then DataChange(Self); End; Procedure TDBDuckBarCode.Paint; Var Size: TSize; R: TRect; S:String; DrawPict:TPicture; Form:TCustomForm; Pal: HPalette; Begin With Canvas Do Begin Brush.Style := bsSolid; Brush.Color := Color; DrawPict := TPicture.Create; Try if csPaintCopy in ControlState then Begin if Assigned (FDataLink.Field) Then Begin FBarcode.Text := FDataLink.Field.AsString; DrawPict.Graphic := FBarcode.GetBitmap; End; End Else DrawPict.Assign (Picture); SetRect(R, 0, 0, DrawPict.Width, DrawPict.Height); OffsetRect(R, (ClientWidth - DrawPict.Width) div 2, (ClientHeight - DrawPict.Height) div 2); StretchDraw(R, DrawPict.Graphic); ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom); FillRect(ClientRect); SelectClipRgn(Handle, 0); Finally DrawPict.Free; End; Form := GetParentForm(Self); if (Form <> nil) and (Form.ActiveControl = Self) and not (csDesigning in ComponentState) and not (csPaintCopy in ControlState) then begin Brush.Color := clWindowFrame; FrameRect(ClientRect); end; End; End; Function TDBDuckBarCode.Print (rLeft, rTop: Real): TRect; Begin Result := FBarcode.Print (rLeft, rTop); End; Function TDBDuckBarCode.PaintPoint (Canvas: TCanvas; pt: TPoint): TRect; Begin Result := FBarcode.PaintPoint (Canvas, pt); End; Procedure TDBDuckBarCode.PaintRect (Canvas: TCanvas; Rc: TRect); Begin FBarcode.PaintRect (Canvas, Rc); End;