Delphi Cavas基础整理

参考: 万一的博客及相关示例。

窗体设计:

 

实现效果:

 

实现代码:

 

unit uFrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TFrmMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    Button10: TButton;
    Panel2: TPanel;
    Button11: TButton;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Button12: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

var
  btn: TButton;
const
  y1= 10;
  y2= 100;

procedure TFrmMain.Button10Click(Sender: TObject);
const
  pts: array[0..4] of TPoint= (
      (x: 536; y: 250),
      (x: 536; y: 250+ 100),
      (x: 536+ 100 div 2; y: 250+ 100 div 2),
      (x: 536+ 100; y: 250+ 100),
      (x: 536+ 100; y: 250)
    );
  pts2: array[0..4] of TPoint= (
      (x: 0; y: 0),
      (x: 0; y: 0+ 99),
      (x: 0+ 100 div 2; y: 0+ 100 div 2),
      (x: 0+ 99; y: 0+ 99),
      (x: 0+ 99; y: 0)
    );
var
  cvs: TCanvas;
begin
  Canvas.Polygon(pts);
  {像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取}
  cvs := TCanvas.Create;
  try
    cvs.Handle := GetDC(Panel2.Handle);
    cvs.Pen.Color:= clRed;
    cvs.Pen.Width:= 1;
    cvs.Polygon(pts2);
  finally
    cvs.Free;
  end;
end;

procedure TFrmMain.Button11Click(Sender: TObject);
const
  pts: array[0..4] of TPoint= (
      (x: 640; y: 250),
      (x: 640; y: 250+ 100),
      (x: 640+ 100 div 2; y: 250+ 100 div 2),
      (x: 640+ 100; y: 250+ 100),
      (x: 640+ 100; y: 250)
    );
  pts2: array[0..4] of TPoint= (
      (x: 0; y: 0),
      (x: 0; y: 0+ 99),
      (x: 0+ 100 div 2; y: 0+ 100 div 2),
      (x: 0+ 99; y: 0+ 99),
      (x: 0+ 99; y: 0)
    );
var
  cvs: TCanvas;
begin
  Canvas.Polyline(pts);
  {像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取}
  cvs := TCanvas.Create;
  try
    cvs.Handle := GetDC(Panel3.Handle);
    cvs.Pen.Color:= clRed;
    cvs.Pen.Width:= 1;
    cvs.Polyline(pts2);
  finally
    cvs.Free;
  end;
end;

procedure TFrmMain.Button12Click(Sender: TObject);
var
  cvs: TCanvas;
  function DrawCorner(ADrawColor : TColor;ix, iy, ix2, iy2:Integer):Boolean;
  var
    ilength : Integer;   //转角线段长度
  begin
    ilength := 15;
    cvs.Pen.Width := 2;
    cvs.Pen.Color := ADrawColor;
    cvs.Brush.Style := bsClear;
    //画左上角
    cvs.MoveTo(ix-cvs.Pen.Width+1 , iy + ilength+1);
    cvs.LineTo(ix-cvs.Pen.Width+1, iy-cvs.Pen.Width);                                        //
    cvs.LineTo(ix +ilength,  iy-cvs.Pen.Width+1);                            //-Canvas.Pen.Width+1
    //画右上角
    cvs.MoveTo(ix2 - ilength -1, iy-cvs.Pen.Width+1);
    cvs.LineTo(ix2 + 1, iy-cvs.Pen.Width);
    cvs.LineTo(ix2 + 1, iy + ilength);
    //画右下角
    cvs.MoveTo(ix2 + 1 ,  iy2 - ilength -1);
    cvs.LineTo(ix2 + 1 , iy2 + 1);
    cvs.LineTo(ix2 - ilength -1, iy2 + 1);
    //画左下角
    cvs.MoveTo(ix-cvs.Pen.Width  + ilength+1, iy2);
    cvs.LineTo(ix-cvs.Pen.Width+1 , iy2 + 1);
    cvs.LineTo(ix-cvs.Pen.Width+1 , iy2 - ilength -1);
  end;
begin
  {像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取}
  cvs := TCanvas.Create;
  try
    cvs.Handle := GetDC(Panel5.Handle);
    cvs.Pen.Width:= 1;
    DrawCorner(clBlue, 50, 50, 150, 150);
  finally
    FreeAndNil(cvs);
  end;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  Canvas.Pen.Color:= clRed;
  Canvas.Pen.Width:= 2;
  Canvas.MoveTo(112, 10);
  Canvas.LineTo(212, 100);
end;

procedure TFrmMain.Button2Click(Sender: TObject);
begin
  Canvas.Brush.Color:= clYellow;
  Canvas.FillRect(ClientRect);
end;

procedure TFrmMain.Button3Click(Sender: TObject);
var
  R: TRect;
begin
  btn:= TButton(Sender);
//  Canvas.Rectangle(btn.Left, y1, btn.Left+ btn.Width, y2);
  r:= Rect(btn.Left, y1, btn.Left+ btn.Width, y2);
  Canvas.Rectangle(R);
end;

procedure TFrmMain.Button4Click(Sender: TObject);
const
  arr: array[0..3] of WideString = (
    '白日依山尽',
    '黄河入海流',
    '欲穷千里目',
    '更上一层楼'
  );
  a = 20; {横向间隔}
  b = 20; {纵向间隔}
var
  cvs: TCanvas;
  i, j, x, y: Integer;
  s: string;
begin
  {像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取}
  x:= 20;
  y:= 20;
  cvs := TCanvas.Create;
  try
    cvs.Handle := GetDC(Panel4.Handle);
    cvs.Brush.Color:= clWhite;
    cvs.FillRect(Panel4.ClientRect);
    for I := 0 to Length(arr)- 1 do
    begin
      for J := 1 to Length(arr[I]) do
      begin
        s:= arr[I][J];
        cvs.TextOut(x, y, s);
        x:= x+ cvs.TextWidth(s)+ a;
      end;
      x:= 20;
      y:= y+ cvs.TextHeight(s)+ b;
    end;
  finally
    FreeAndNil(cvs);
  end;
end;

procedure TFrmMain.Button5Click(Sender: TObject);
var
  R: TRect;
begin
  btn:= TButton(Sender);
//  Canvas.Ellipse(btn.Left, y1, btn.Left+ btn.Width, y2);
  r:= Rect(btn.Left, y1, btn.Left+ btn.Width, y2);
  Canvas.Ellipse(R);
end;

procedure TFrmMain.Button6Click(Sender: TObject);
begin
  btn:= TButton(Sender);
  Canvas.Pie(btn.Left, y1, btn.Left+ btn.Width, y2,
    btn.Left+ btn.Width, y1+ (y2- y1) div 2,
    btn.Left+ btn.Width div 2, y1);
end;

procedure TFrmMain.Button7Click(Sender: TObject);
begin
  btn:= TButton(Sender);
  Canvas.Chord(btn.Left, y1, btn.Left+ btn.Width, y2,
    btn.Left+ btn.Width, y1+ (y2- y1) div 2,
    btn.Left+ btn.Width div 2, y1);
end;

procedure TFrmMain.Button8Click(Sender: TObject);
begin
  btn:= TButton(Sender);
  Canvas.Arc(btn.Left, y1, btn.Left+ btn.Width, y2,
    btn.Left+ btn.Width, y1+ (y2- y1) div 2,
    btn.Left+ btn.Width div 2, y1);
end;

procedure TFrmMain.Button9Click(Sender: TObject);
var
  cvs: TCanvas;
begin
  {PaintBox1 就像窗体一样, 也有 Canvas 属性}
  PaintBox1.Canvas.Brush.Color:= clRed;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
  {像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取}
  cvs := TCanvas.Create;
  cvs.Handle := GetDC(Panel1.Handle);
  cvs.Brush.Color := clBlue;
  cvs.FillRect(Panel1.ClientRect);
  cvs.Free;
end;

end.