喫茶XRAYトップページ

[スレッド全体
]

[13676] Re2:白黒プリンターで白抜き文字をきれいに印字したい返信 削除
2023/10/3 (火) 20:14:57 Mr.XRAY
で思い出しました.
が,いずれにしても TCanvas への描画ですね.

[ 158_マウス操作による図形の編集 ]
http://mrxray.on.coocan.jp/Delphi/plSamples/158_EditPath_Bezier.htm


[13677] 袋文字返信 削除
2023/10/4 (水) 06:59:26 Mr.XRAY
こんな感じでしょうか.
( スミマセン.白抜きではありません )


implementation

{$R *.dfm}

var
    FPointArray     : TByteArray;
    FPointKindArray : TByteArray;
    FPointCount     : Integer;

//=============================================================================
//  動作確認 : Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
//  描画開始ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  // バスの記録開始
  BeginPath(Canvas.Handle);
  try
    Canvas.Brush.Style  := bsClear;
    Canvas.Font.Size    := 100;
    Canvas.Font.Charset := DEFAULT_CHARSET;
    Canvas.Font.Name    := '遊ゴシック';
    Canvas.Textout(40, 40, '袋文字');
  finally
    // バスの記録終了
    EndPath(Canvas.Handle);
  end;

  // パスの座標値の格納に必要な数を取得して配列に格納
  FPointCount := GetPath(Canvas.Handle, FPointArray, FPointKindArray, 0);
  GetPath(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

  // パス情報が取得できたので再描画
  Invalidate;
end;


//=============================================================================
//  OnPaint イベント
//  実際の描画
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
begin
  // 計算結果のパス情報で図形を描画
  BeginPath(Canvas.Handle);
     PolyDraw(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
  EndPath(Canvas.Handle);

  // 現在のブラシでバスの内部を塗りつぶし,現在のペンで輪郭線を描画する
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clGreen;
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 5;
  StrokeAndFillPath(Canvas.Handle);
end;



[13678] 袋文字 / 白抜き文字のサンプル返信 削除
2023/10/4 (水) 19:04:15 Mr.XRAY
サンプルの記事を作成してみました.

[ 袋文字 / 白抜き文字の描画 ]
http://mrxray.on.coocan.jp/Delphi/Others/FukuroMoji.htm


[13679] Re:袋文字 / 白抜き文字のサンプル返信 削除
2023/10/12 (木) 15:52:08 snail
▼ Mr.XRAYさん

すいません。書込していただいていたのに暫く来ていませんでした。

>袋文字というやつですね.

それ以前の問題で、真っ黒の塗り潰しができません。(; ;)ホロホロ

塗り潰し無しでとりあえず1つ目の納品書を作成しました。
現在2つめの納品書を作成しています。この後20日締請求書
が終わるまで暫く綱渡りが続きます。

同時に複数のことができないので改めて来ます。
勝手で申し訳ありません。




[13680] Re2:袋文字 / 白抜き文字のサンプル返信 削除
2023/10/15 (日) 14:00:19 Mr.XRAY
> すいません。書込していただいていたのに暫く来ていませんでした。
>


いやいや、私こそスミマセン。放置しておいて。
お仕事大変なようで、
身体だけは大事にしてくださいね。


[13683] Re3:袋文字 / 白抜き文字のサンプル返信 削除
2023/11/29 (水) 14:15:56 snail
▼ Mr.XRAYさん
すいません、ずいぶん遠回りしましたがやっと戻ってきました。

本日サンプルをみながらプリンターで印字してみました。
印字で利用したプリンターは EPSON LP-S3250

白抜き文字はっきりくっきり見えます。さすがです。 \(^_^)/

問題は黒塗り部分、一見問題無いように見えますが
よーくみるとナメクジがはったような模様が、、、 (;_;)

EXCELで印字しても同じなのでプリンタの問題だと思います。

ありがとうございました。 _(._.)_

一応ソースを貼っておきます。

unit PrintTest;
// 白抜き文字印刷テスト
// http://mrxray.on.coocan.jp/Delphi/Others/FukuroMoji.htm

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers, Clipbrd, WinSpool;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
    FPointArray     : TByteArray;
    FPointKindArray : TByteArray;
    FPointCount     : Integer;

procedure TForm1.Button1Click(Sender: TObject);
var
  LLogFont : TLogFont;
  LText    : string;
  WStX  : Integer;  // 罫線印字開始X座標
  WStY  : Integer;  // 罫線印字開始Y座標
  WEndX : Integer;  // 罫線印字終了X座標
  WEndY : Integer;  // 罫線印字終了Y座標
  WRect : TRect;
begin
  Printer.BeginDoc;   // 印字のための準備
  try
    WStX  := 200;   // WrkRect.Left;
    WStY  := 100;   // WrkRect.Top;
    WEndX := 4800;   // WrkRect.Right;
    WEndY := 400;   // WrkRect.Bottom;
    Printer.Canvas.Brush.Color := clBlack;   // clAqua;
    Printer.Canvas.Rectangle( WStX, WStY, WEndX, WEndY );

    GetObject( Printer.Canvas.Font.Handle,SizeOf(LLogFont),@LLogFont);
    LLogFont.lfWeight := 1000;

    Printer.Canvas.Font.Handle := CreateFontIndirect(LLogFont);

    Printer.Canvas.Font.Name := 'メイリオ';
    Printer.Canvas.Font.Size    := 10;
    Printer.Canvas.Font.Charset := DEFAULT_CHARSET;
    Printer.Canvas.Brush.Style := bsClear;

    // バスの記録
    BeginPath(Printer.Canvas.Handle);
    LText := '白抜き文字';
    Printer.Canvas.Textout(40, 120, LText);
    EndPath(Printer.Canvas.Handle);

    // パスの座標値の格納に必要な数を取得して配列に格納
    FPointCount := GetPath(Printer.Canvas.Handle, FPointArray, FPointKindArray, 0);
    GetPath(Printer.Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

    // パス情報が取得できたので再描画
////  Invalidate; //////////
    // 取得したパス情報で図形を描画
    BeginPath(Printer.Canvas.Handle);
    PolyDraw(Printer.Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
    EndPath(Printer.Canvas.Handle);

    // 現在のブラシでバスの内部を塗りつぶし,現在のペンで輪郭線を描画する
    Printer.Canvas.Brush.Style := bsSolid;
    Printer.Canvas.Brush.Color := clWhite;
    Printer.Canvas.Pen.Color   := clBlack;
    Printer.Canvas.Pen.Width   := 5;
    StrokeAndFillPath(Printer.Canvas.Handle);

  finally
    Printer.EndDoc;
  end;

end;

end.




[13685] Re4:袋文字 / 白抜き文字のサンプル返信 削除
2023/12/6 (水) 13:41:22 Mr.XRAY
>
> 問題は黒塗り部分、一見問題無いように見えますが
> よーくみるとナメクジがはったような模様が、、、 (;_;)


うーむ.
この現象,何か記憶があるような,ないような・・・
TMetafile の画像にすれば,いや,分かりません.
でも貴重な情報です.


[13686] Re5:袋文字 / 白抜き文字のサンプル返信 削除
2023/12/14 (木) 11:15:38 snail
▼ Mr.XRAYさん

最近 Delphi を起動するのも月に数回に減りまして、、、、

細かな修正なんかやろうと思えば色々あるけど
とりあえず動いているからいいかなって (>_<)


[13687] Re6:袋文字 / 白抜き文字のサンプル返信 削除
2023/12/18 (月) 05:02:24 DEKO
> EPSON LP-S3250

トナーセーブモードになっているとか?

> トナーセーブは、トナーを節約して印刷するため、通常の印刷に比べ品質が低下します。
> 試し印刷など、印刷品質を問わない印刷に適しています。
> 操作パネルまたはプリンタードライバーでトナーセーブモードを解除してください。
>
> Windows では[応用設定]−[画像処理設定]−[トナーセーブ]のチェックを外してください。


[13691] Re7:袋文字 / 白抜き文字のサンプル返信 削除
2024/1/13 (土) 09:52:43 snail
▼ DEKOさん
> > EPSON LP-S3250
>
> トナーセーブモードになっているとか?


最初に確認しました。
そうだ別のプリンターで確認すれば、、、、

話は変わりますが、
EPSONはSDGs推進するためにインクジェットをメインにして
レーザープリンターから撤退するって記事がありました。




[▼次のスレッド]
INCM/CMT
Cyclamen v3.82