按 "sky123" 的样图要求, 花边必须是透空的, 最好使用图元文件; 本例没有做完保存功能, 也没有实现整个图片的调整功能. 因为有测试图片, 给个源码下载吧: https://files.cnblogs.com/del/sky123.rar

本例效果图:



代码文件:
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

posted on 2008-07-01 17:31  万一  阅读(4811)  评论(2编辑  收藏  举报