直線描画の端点を変更するには？

解決

うめおにぎり 2004-05-19 06:29:17 No: 9032

直線描画の端点を変更するにはどのようにしたらよいのでしょうか？
わかる方教えてください、お願いします。

フォームにペイントボックスを貼り付けて、そこに太線を書くと
線の両端が丸くなってしまいます。以下、ソース抜粋です。

procedure TForm1.PaintBox1Click(Sender: TObject);
begin
PaintBox1.Canvas.Pen.Width := 10;
PaintBox1.Canvas.MoveTo(100,100);
PaintBox1.Canvas.LineTo(300,100);
end;

環境：Win2000＆Delphi5

jok 2004-05-19 07:55:58 No: 9033

以下のソースを試してみてください。

function CreateGeometricPen(Width:integer;Color:TColor):HPEN;
var
  lb:TLogBrush;
begin
  lb.lbStyle := BS_SOLID;
  lb.lbColor := Color;
  lb.lbHatch := 0;
  result := ExtCreatePen(PS_GEOMETRIC or PS_SOLID or
           PS_ENDCAP_FLAT or PS_JOIN_MITER,Width,lb,0,nil);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PaintBox1.Canvas.Pen.Handle := CreateGeometricPen(14,clYellow);
  PaintBox1.Canvas.MoveTo(100,100);
  PaintBox1.Canvas.LineTo(300,100);

  PaintBox1.Canvas.Pen.Width := 1;
  PaintBox1.Canvas.MoveTo(100,100);
  PaintBox1.Canvas.LineTo(300,100);
end;

うめおにぎり 2004-05-19 09:21:54 No: 9034

jokさん、返答ありがとうございます。
上記ソースを試してみたところ、端点が平らな黄色直線が書けました。
ExtCreatePen関数でペンを作成すればよいのですね^^
PS_ENDCAP_FLATが平らにするパラメータのような感じがしますが、
ヘルプで引数の意味調べてみます。
大変助かりました。また、よろしくお願い致します。

にゃ〜 2004-05-19 18:02:54 No: 9035

このサンプル、Win98にゃとウマクいかないにゃ〜
まだまだWin98ユーザーも多いから困るにゃ〜
これでどうかにゃ〜

var
  DC : HDC;
  NewPen, OldPen : HPEN;
begin
  with PaintBox1.Canvas do begin
    DC := Handle;
    // path bracketに線を引くにゃ〜
    BeginPath(DC);
    MoveToEx(DC, 20, 20, nil);  Windows.LineTo(DC, 300, 20);
    MoveToEx(DC, 20, 40, nil);  Windows.LineTo(DC, 300, 320);
    EndPath(DC);
    // 端が平らな太いペンに持ち替えるにゃ〜
    NewPen := CreateGeometricPen(18, $77ffaa);
    OldPen := SelectObject(DC, NewPen);
    // 新しいペンでキャンバスに描くにゃ〜
    StrokePath(DC);
    // 元のペンに戻すにゃ〜
    SelectObject(DC, OldPen);
    DeleteObject(NewPen);
    // 元の細いペンでキャンバスに線を描くにゃ〜
    MoveTo(20, 20);  LineTo(300, 20);
    MoveTo(20, 40);  LineTo(300, 320);
  end;

jok 2004-05-19 20:02:45 No: 9036

> このサンプル、Win98にゃとウマクいかないにゃ〜

Windows98 で確認しました。コードを見習って、それ用の LineTo() 手続き
を作りました。フォローありがとうございました。

procedure LineToByExtPen(Canvas:TCanvas;hExtPen:HPen;X,Y:integer);
var
  OldPen:HPEN;
begin
  with Canvas do begin
    BeginPath(Handle);
    LineTo(X,Y);
    EndPath(Handle);
    OldPen := SelectObject(Handle,hExtPen);
    StrokePath(Handle);
    SelectObject(Handle,OldPen);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hExtPen:HPEN;
begin
  PaintBox1.Canvas.MoveTo(100,100);
  hExtPen := CreateGeometricPen(18,clLime);
    PaintBox1.Canvas.MoveTo(20,20);
    LineToByExtPen(PaintBox1.Canvas,hExtPen,300,20);
    PaintBox1.Canvas.MoveTo(20,40);
    LineToByExtPen(PaintBox1.Canvas,hExtPen,300,320);
  DeleteObject(hExtPen);

  PaintBox1.Canvas.MoveTo(20,20);
  PaintBox1.Canvas.LineTo(300,20);
  PaintBox1.Canvas.MoveTo(20,40);
  PaintBox1.Canvas.LineTo(300,320);
end;