(原创)自己写的一个仿IMAGE功能的MEMO

unit TestMemo;

interface

uses
  Windows, Classes, StdCtrls, Graphics, Controls, SysUtils, jpeg, Messages;

type
  Test = class(TMemo)
  private
    Test: string;
    FCanvas: TCanvas;
    FPicture: TPicture;
    procedure SetPicture(Value: TPicture);
  published
    property Picture: TPicture read FPicture write SetPicture;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function LoadFromFile(FilePath: String; Memo: TWinControl): Boolean; overload;
    function LoadFromFile(FilePath: String): Boolean; overload;
    procedure Wmpiant(var Msg: Tmessage); message WM_PAINT;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Memo', [Test]);
end;

{ Test }

constructor Test.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FPicture := TPicture.Create;
end;

//传入可视控件都可以
function Test.LoadFromFile(FilePath: String; Memo: TWinControl): Boolean;
begin
  if Not FileExists(FilePath) then
    Exit;
  TControlCanvas(FCanvas).Control := Memo;
  FPicture.LoadFromFile(FilePath);
  FCanvas.Draw(0,0, FPicture.Graphic);
end;

destructor Test.Destroy;
begin
  FCanvas.Free;
  FPicture.Free;
  FCanvas := nil;
  FPicture := nil;
  inherited;
end;

function Test.LoadFromFile(FilePath: String): Boolean;
begin
  if Not FileExists(FilePath) then
    Exit;
  FPicture.LoadFromFile(FilePath);
  FCanvas.Draw(0,0, FPicture.Graphic);
end;

procedure Test.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
  FCanvas.Draw(0,0, FPicture.Graphic);
end;

procedure Test.Wmpiant(var Msg:Tmessage);
begin
  if Msg.Msg = WM_PAINT then
  begin
    if Assigned(FPicture)  and Assigned(FCanvas) then
      FCanvas.Draw(0,0, FPicture.Graphic);
  end;
end;

end.