delphi 用 GDI+ 给图片添加花边的例子


本文整理自网络,侵删。

 本例效果图:



代码文件:
--------------------------------------------------------------------------------

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
Button1: TButton;
Button2: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
p1W: TSpinEdit;
bWidth: TSpinEdit;
bHeight: TSpinEdit;
ComboBox1: TComboBox;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
p2W: TSpinEdit;
p3W: TSpinEdit;
p4W: TSpinEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure bWidthChange(Sender: TObject);
procedure bHeightChange(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure p1WChange(Sender: TObject);
procedure p2WChange(Sender: TObject);
procedure p3WChange(Sender: TObject);
procedure p4WChange(Sender: TObject);
procedure p1XChange(Sender: TObject);
procedure p1YChange(Sender: TObject);
procedure p2XChange(Sender: TObject);
procedure p2YChange(Sender: TObject);
procedure p3XChange(Sender: TObject);
procedure p3YChange(Sender: TObject);
procedure p4XChange(Sender: TObject);
procedure p4YChange(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses GDIPOBJ, GDIPAPI, TypInfo;

var
img,imgb: TGPImage;
b: TGPTextureBrush;
P1,P2,P3,P4: TGPPen;

procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
PaintBox1.Left := 0;
PaintBox1.Top := 0;

for i := 0 to 3 do
ComboBox1.Items.Add(GetEnumName(TypeInfo(TWrapMode), i));
ComboBox1.ItemIndex := 0;

img := TGPImage.Create;
imgb := TGPImage.Create;
b := TGPTextureBrush.Create;
P1 := TGPPen.Create;
P2 := TGPPen.Create;
P3 := TGPPen.Create;
P4 := TGPPen.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
img.Free;
imgb.Free;
b.Free;
P1.Free;
P2.Free;
P3.Free;
P4.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter :=
'All (*.jpg;*.png;*.gif;*.bmp;*.tif)|*.jpg;*.png;*.gif;*.bmp;*.tif|' +
'JPG (*.jpg)|*.jpg|' +
'PNG (*.png)|*.png|' +
'GIF (*.gif)|*.gif|' +
'BMP (*.bmp)|*.bmp|' +
'TIF (*.tif)|*.tif';
if OpenDialog1.Execute then
begin
img.Free;
img := TGPImage.Create(OpenDialog1.FileName);
PaintBox1.Repaint;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDialog1.Filter := GraphicFilter(TMetafile);
if OpenDialog1.Execute then
begin
imgb.Free;
imgb := TGPImage.Create(OpenDialog1.FileName);

bWidth.Text := IntToStr(imgb.GetWidth * 10);
bHeight.Text := IntToStr(imgb.GetHeight * 10);

p1w.Text := bHeight.Text;
p2w.Text := bHeight.Text;
p3w.Text := bWidth.Text;
p4w.Text := bWidth.Text;

PaintBox1.Repaint;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
SaveDialog1.Filter :=
'JPG (*.jpg)|*.jpg|' +
'PNG (*.png)|*.png|' +
'GIF (*.gif)|*.gif|' +
'BMP (*.bmp)|*.bmp|' +
'TIF (*.tif)|*.tif|' +
'All (*.jpg;*.png;*.gif;*.bmp;*.tif)|*.jpg;*.png;*.gif;*.bmp;*.tif';
if SaveDialog1.Execute then
begin
//暂时没做保存
end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
g: TGPGraphics;
rt: TGPRect;
begin
if img.GetWidth = 0 then Exit;
if imgb.GetWidth > 0 then
begin
b.Free;
b := TGPTextureBrush.Create(imgb, TWrapMode(ComboBox1.ItemIndex),
MakeRect(0.0, 0, StrToIntDef(bWidth.Text, 0) / 10, StrToIntDef(bHeight.Text, 0) / 10));

P1.Free;
P2.Free;
P3.Free;
P4.Free;

P1 := TGPPen.Create(b, StrToIntDef(p1w.Text, 0) / 10);
P2 := TGPPen.Create(b, StrToIntDef(p2w.Text, 0) / 10);
P3 := TGPPen.Create(b, StrToIntDef(p3w.Text, 0) / 10);
P4 := TGPPen.Create(b, StrToIntDef(p4w.Text, 0) / 10);

P1.SetAlignment(PenAlignmentInset);
P2.SetAlignment(PenAlignmentInset);
P3.SetAlignment(PenAlignmentInset);
P4.SetAlignment(PenAlignmentInset);
end;

PaintBox1.ClientWidth := img.GetWidth;
PaintBox1.ClientHeight := img.GetHeight;

g := TGPGraphics.Create(PaintBox1.Canvas.Handle);
g.DrawImage(img, 0, 0, img.GetWidth, img.GetHeight);

rt := MakeRect(PaintBox1.ClientRect);
g.DrawLine(p1, rt.X, rt.Y, rt.X + rt.Width, rt.Y);
g.DrawLine(p2, rt.X, rt.Y + rt.Height, rt.X + rt.Width, rt.Y + rt.Height);
g.DrawLine(p3, rt.X, rt.Y, rt.X, rt.Y + rt.Height);
g.DrawLine(p4, rt.X + rt.Width, rt.Y, rt.X + rt.Width, rt.Y + rt.Height);

g.Free;
end;

procedure TForm1.bWidthChange(Sender: TObject);
var
n: Single;
begin
n := imgb.GetHeight / imgb.GetWidth;
bHeight.Text := IntToStr(Trunc(StrToIntDef(bWidth.Text, 1) * n));
PaintBox1.Repaint;
end;

procedure TForm1.bHeightChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p1WChange(Sender: TObject);
begin
PaintBox1.Repaint;
p2w.Text := p1w.Text;
end;

procedure TForm1.p1XChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p1YChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p2WChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p2XChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p2YChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p3WChange(Sender: TObject);
begin
PaintBox1.Repaint;
p4w.Text := p3w.Text;
end;

procedure TForm1.p3XChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p3YChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p4XChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p4YChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.p4WChange(Sender: TObject);
begin
PaintBox1.Repaint;
end;

end.

相关阅读 >>

Delphi idftp 错误:socket error 10054 �c connection reset by peer -连接被重置

Delphi listbox用canvas属性绘图

Delphi hmacsha256

Delphi 模拟按键的一些误解

Delphi中控件数组批量赋值

Delphi shellexecute多种用法

Delphi 一个call应该如何写?

Delphi processid, process handle, window handle 之间的互相转换

Delphi之猥琐的webserver实现

Delphi 获取指定目录下的所有文件名,包括子目录函数

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...