直線描画の端点を変更するには？ (ID：9036)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

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

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

←解決時は質問者本人がここをチェックしてください。

戻る