PNG缩放

 

下面是自己用delphi7写的一个控件 

最近手头一个程序中需要用到PNG格式的图片 但是崩溃的是delphi中没有实现对png图片的缩放

好在网上有用GDI+实现的方法  主要方法都是从万一大神的博客上直接copy的   为了方便使用做成了控件

虽然写的不细致 但是够我用了

 

unit GDIpanel;

 

interface

 

uses

  SysUtils, Classes, Controls, ExtCtrls,GDIPOBJ,GDIPUTIL,GDIPAPI,Messages,Graphics;

 

type

  tGDIpanel = class(TPaintBox)

  private

    FLabel:String;//可以在上面显示文本

    FColorOfLable:TColor;//设置文本的颜色

    FColorOfShadow:TColor;//设置文本阴影的颜色

    Fww:Integer;//阴影的距离

    FFontOfLabel:TFont;//文本的字体 但是令人郁闷的是设置属性之后不变 运行的时候效果就出来了

    FUrlImage:string;//图片的位置  这里暂时用string  以后修改时候再添加设置的方法

 

 

    procedure gdi(sender:TObject);//这个是用来画图片的

    procedure draw(sender:tobject);//这个是用来画文字的

    procedure Seturlimage(value:String);

    procedure setlabelcolor(value:TColor);

    procedure setshadowcolor(value:TColor);

    procedure setlabel(value:String);

    procedure SetLabelfont(Value: TFont);

    procedure setfww(value:Integer);

    { Private declarations }

  protected

    procedure Paint; override;

    { Protected declarations }

  public

    { Public dec--larations }

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  published

    property UrlImage:string read FUrlImage write Seturlimage;

    property Lable:String  read FLabel write setlabel;

    property FontOfLabel:TFont read FFontOfLabel write SetLabelfont;

    property ColorOfLable:TColor read FColorOfLable write setlabelcolor default clRed;

    property ColorOfShadow:TColor read FColorOfShadow write setshadowcolor default clBlack ;

    property Ww:Integer read Fww write setfww default 2;

    { Published declarations }

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

  RegisterComponents('Samples', [tGDIpanel]);

end;

 

{ tGDIpanel }

 

constructor tGDIpanel.Create(AOwner: TComponent);

begin

  inherited;

  FUrlImage:='';

  FFontOfLabel:=TFont.Create;

  Fww:=2;

  FColorOfLable:=clRed;

  FColorOfShadow:=clBlack;

end;

 

destructor tGDIpanel.Destroy;

begin

  inherited;

end;

 

procedure tGDIpanel.draw(sender:tobject);

var

  g: TGPGraphics;

  b: TGPBrush;

  font: TGPFont;

  sf: TGPStringFormat;

  rect: TGPRectF;

begin

  if FLabel<>''then

  begin

    g := TGPGraphics.Create((sender as TPaintBox).Canvas.Handle);

    g.SetTextRenderingHint(TextRenderingHintAntiAlias);

    font := TGPFont.Create(FFontOfLabel.Name, FFontOfLabel.size);

    sf := TGPStringFormat.Create;

    sf.SetFormatFlags(StringFormatFlagsNoClip);

    sf.SetAlignment(TStringAlignment(StringAlignmentCenter));

    sf.SetLineAlignment(TStringAlignment(StringAlignmentCenter));

 

    b := TGPSolidBrush.Create(ColorRefToARGB(ColorOfShadow));

    rect.X := 0;

    rect.Y := 0;

    rect.Width := (sender as TPaintBox).ClientWidth+Fww;

    rect.Height := (sender as TPaintBox).ClientHeight+Fww;

    g.DrawString(FLabel, -1, font, rect, sf, b);

 

    b := TGPSolidBrush.Create(ColorRefToARGB(FColorOfLable));

    rect.X := 0;

    rect.Y := 0;

    rect.Width := (sender as TPaintBox).ClientWidth;

    rect.Height := (sender as TPaintBox).ClientHeight;

    g.DrawString(FLabel, -1, font, rect, sf, b);

 

    sf.Free;

    font.Free;

    b.Free;

 

    g.Free;

  end;

end;

 

procedure tGDIpanel.gdi(sender: TObject);

var

  g: TGPGraphics;

  img: TGPImage;

  rt: TGPRectF;

  x,y:Cardinal;

begin

  if FUrlImage<>'' then

  begin

    g := TGPGraphics.Create((sender as TPaintBox).Canvas.Handle);

 

    img := TGPImage.Create(FUrlImage);

 

    //g.DrawImage(img, 0, 0, img.GetWidth, img.GetHeight);

 

    x:=(sender as TPaintBox).Width;

    y:=(sender as TPaintBox).Height;

 

    rt := MakeRect(0,0,x, y);

 

    g.SetInterpolationMode(InterpolationModeHighQualityBicubic);

    g.DrawImage(img, rt, 0, 0, img.GetWidth, img.GetHeight, UnitPixel);

 

    img.Free;

    g.Free;

  end;

end;

 

procedure tGDIpanel.Paint;

begin

  inherited;

  gdi(Self);

  draw(Self);

end;

 

procedure tGDIpanel.setfww(value: Integer);

begin

  if fww<>value then

  begin

  Fww:=value;

  Paint;

  end;

end;

 

procedure tGDIpanel.setlabel(value: String);

begin

  if FLabel<>value then

  begin

  FLabel:=value;

  Paint;

  end;

end;

 

procedure tGDIpanel.setlabelcolor(value: TColor);

begin

  if FColorOfLable<>value then

  begin

  FColorOfLable:=value;

  Paint;

  end;

end;

 

procedure tGDIpanel.SetLabelfont(Value: TFont);

begin

  if FFontOfLabel<>Value then

  begin

  FFontOfLabel := Value;

  Paint;

  end;

end;

 

procedure tGDIpanel.setshadowcolor(value: TColor);

begin

  if FColorOfShadow<>value then

  begin

  FColorOfShadow:=value;

  Paint;

  end;

end;

 

procedure tGDIpanel.Seturlimage(value: String);

begin

  if FUrlImage<>value then

  begin

  FUrlImage:=value;

  Paint;

  end;

end;

 

end.