名前 題名 ▼ 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; > GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示). (上限122000(120k)バイト) 削除キー Link