本例效果图:
代码文件:
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.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 406 ClientWidth = 647 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesktopCenter OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 491 Top = 0 Width = 156 Height = 406 Align = alRight BevelOuter = bvLowered TabOrder = 0 object Button1: TButton Left = 10 Top = 16 Width = 67 Height = 25 Caption = #25171#24320#22270#20687 TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 83 Top = 16 Width = 67 Height = 25 Caption = #25171#24320#33457#36793 TabOrder = 1 OnClick = Button2Click end object GroupBox1: TGroupBox Left = 6 Top = 55 Width = 147 Height = 122 Caption = #35843#25972#23567#22270 TabOrder = 2 object Label5: TLabel Left = 17 Top = 21 Width = 40 Height = 13 Caption = #23567#22270#23485':' end object Label6: TLabel Left = 80 Top = 21 Width = 40 Height = 13 Caption = #23567#22270#39640':' end object Label7: TLabel Left = 17 Top = 73 Width = 52 Height = 13 Caption = #29615#32469#26679#24335':' end object bWidth: TSpinEdit Left = 17 Top = 40 Width = 57 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 0 Value = 0 OnChange = bWidthChange end object bHeight: TSpinEdit Left = 80 Top = 40 Width = 57 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 1 Value = 0 OnChange = bHeightChange end object ComboBox1: TComboBox Left = 16 Top = 92 Width = 121 Height = 21 ItemHeight = 13 TabOrder = 2 Text = 'ComboBox1' OnChange = ComboBox1Change end end object GroupBox2: TGroupBox Left = 6 Top = 188 Width = 147 Height = 138 Caption = #35843#25972#36793#23485 TabOrder = 3 object Label1: TLabel Left = 17 Top = 27 Width = 40 Height = 13 Caption = #19978#36793#23485':' end object Label2: TLabel Left = 17 Top = 55 Width = 40 Height = 13 Caption = #19979#36793#23485':' end object Label3: TLabel Left = 17 Top = 82 Width = 40 Height = 13 Caption = #24038#36793#23485':' end object Label4: TLabel Left = 17 Top = 111 Width = 40 Height = 13 Caption = #21491#36793#23485':' end object p1W: TSpinEdit Left = 63 Top = 22 Width = 65 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 0 Value = 0 OnChange = p1WChange end object p2W: TSpinEdit Left = 63 Top = 50 Width = 65 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 1 Value = 0 OnChange = p2WChange end object p3W: TSpinEdit Left = 63 Top = 78 Width = 65 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 2 Value = 0 OnChange = p3WChange end object p4W: TSpinEdit Left = 63 Top = 106 Width = 65 Height = 22 Increment = 5 MaxValue = 0 MinValue = 0 TabOrder = 3 Value = 0 OnChange = p4WChange end end object Button3: TButton Left = 40 Top = 335 Width = 75 Height = 25 Caption = #20445#23384#22270#20687 TabOrder = 4 OnClick = Button3Click end end object ScrollBox1: TScrollBox Left = 0 Top = 0 Width = 491 Height = 406 Align = alClient Color = clWhite ParentColor = False TabOrder = 1 object PaintBox1: TPaintBox Left = 24 Top = 23 Width = 105 Height = 105 OnPaint = PaintBox1Paint end end object OpenDialog1: TOpenDialog Left = 232 Top = 216 end object SaveDialog1: TSaveDialog Left = 232 Top = 248 end end