◆◆◆如何修改OpenPictureDialog使其可以预览文本文件？

Question

如何修改OpenPictureDialog使其可以预览文本文件和Flash?
要具体点的代码，谢谢了。再看一下这个：
http://community.csdn.net/Expert/TopicView.asp?id=4304696

Answer 1

OpenPictureDialog 换成用OpenDialog就可以选文本等等其他文件了

Answer 2

unit TxtFilePreview;interfaceuses
  Messages, Windows, SysUtils, Classes, Controls, StdCtrls, Graphics,
  ExtCtrls, Buttons, Dialogs;{ TTxtFilePreViewDialog }type
  TTxtFilePreViewDialog = class(TOpenDialog)
  private
    FTxtPanel: TPanel;
    FTxtLabel: TLabel;
    FPreviewButton: TSpeedButton;
    FPaintPanel: TPanel;
    FMemoCtrl: TMemo;
  protected
    procedure PreviewClick(Sender: TObject); virtual;
    procedure DoSelectionChange; override;
    procedure DoShow; override;
    property MemoCtrl: TMemo read FMemoCtrl;
    property TxtLabel: TLabel read FTxtLabel;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  end;implementationuses Forms;{ TTxtFilePreViewDialog }constructor TTxtFilePreViewDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Filter := 'Text files (*.txt)|*.TXT';
  FTxtPanel := TPanel.Create(Self);
  with FTxtPanel do
  begin
    Name := 'TxtPanel';
    Caption := '';
    SetBounds(200, 5, 169, 200);
    BevelOuter := bvNone;
    BorderWidth := 6;
    TabOrder := 1;
    FTxtLabel := TLabel.Create(Self);
    with FTxtLabel do
    begin
      Name := 'TxtLabel';
      Caption := '';
      SetBounds(6, 6, 157, 23);
      Align := alTop;
      AutoSize := False;
      Parent := FTxtPanel;
    end;
    FPreviewButton := TSpeedButton.Create(Self);
    with FPreviewButton do
    begin
      Name := 'PreviewButton';
      SetBounds(77, 1, 23, 22);
      Enabled := False;
      Glyph.LoadFromResourceName(HInstance, 'PREVIEWGLYPH');
      ParentShowHint := False;
      OnClick := PreviewClick;
      Parent := FTxtPanel;
    end;
    FPaintPanel := TPanel.Create(Self);
    with FPaintPanel do
    begin
      Name := 'PaintPanel';
      Caption := '';
      SetBounds(6, 29, 157, 145);
      Align := alClient;
      BevelInner := bvRaised;
      BevelOuter := bvLowered;
      TabOrder := 0;
      FMemoCtrl := TMemo.Create(Self);
      Parent := FTxtPanel;
      with FMemoCtrl do
      begin
        Name := 'MemoCtrl';
        Align := alClient;
        Parent := FPaintPanel;
        ScrollBars:=ssVertical;
        ReadOnly:=True;
        Text:='';
        WordWrap:=True;
        WantReturns:=True;
      end;
    end;
  end;
end;procedure TTxtFilePreViewDialog.DoSelectionChange;
var
  FullName: string;
  ValidPicture: Boolean;  function ValidFile(const FileName: string): Boolean;
  begin
    Result := GetFileAttributes(PChar(FileName)) <> $FFFFFFFF;
  end;begin
  FullName := FileName;
  if FullName <> '' then
  begin
    ValidPicture := FileExists(FullName) and ValidFile(FullName);
    if ValidPicture then
    try
      FMemoCtrl.Lines.LoadFromFile(FullName);
      FTxtLabel.Caption:='总行数:'+IntToStr(FMemoCtrl.Lines.Count);
      FPreviewButton.Enabled := True;
      FPaintPanel.Caption := '';
    except
      ValidPicture := False;
    end;
    if not ValidPicture then
    begin
      FMemoCtrl.Lines.Clear;
      FPreviewButton.Enabled := False;
      FPaintPanel.Caption := '';
    end;
  end;
  inherited DoSelectionChange;
end;procedure TTxtFilePreViewDialog.DoShow;
var
  PreviewRect, StaticRect: TRect;
begin
  { Set preview area to entire dialog }
  GetClientRect(Handle, PreviewRect);
  StaticRect := GetStaticRect;
  { Move preview area to right of static area }
  PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
  Inc(PreviewRect.Top, 4);
  FTxtPanel.BoundsRect := PreviewRect;
  FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
  FPaintPanel.Caption := '';
  FTxtPanel.ParentWindow := Handle;
  inherited DoShow;
end;function TTxtFilePreViewDialog.Execute: Boolean;
begin
  if NewStyleControls and not (ofOldStyleDialog in Options) then
    Template := 'DLGTEMPLATE' else
    Template := nil;
  Result := inherited Execute;
end;procedure TTxtFilePreViewDialog.PreviewClick(Sender: TObject);
var
  PreviewForm: TForm;
begin
  PreviewForm := TForm.Create(Self);
  with PreviewForm do
  try
    Name := 'PreviewForm';
    Visible := False;
    Caption :=FileName;
    BorderStyle := bsSizeToolWin;
    KeyPreview := True;
    Position := poScreenCenter;
    with TMemo.Create(PreviewForm) do
    begin
      ReadOnly:=True;
      Name := 'TxtMemo';
      Align := alClient;
      Parent := PreviewForm;
      Lines.Assign(FMemoCtrl.Lines);
      ScrollBars:=ssVertical;
    end;
    ShowModal;
  finally
    Free;
  end;
end;end.只是右键点击Memo控件时报错

Answer 3

从TOpenPictureDialog派生一个类，覆盖两个方法
procedure PreviewClick(Sender: TObject); virtual;
procedure DoSelectionChange; override;// 我没试过 :)

Answer 4

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    OpenPictureDialog1: TOpenPictureDialog;
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;  TTextPicture = class(TGraphic)
  private
    FTextList: TStringList;
  public
    procedure LoadFromFile(const Filename: string);override;
    procedure Draw(ACanvas: TCanvas; const Rect: TRect);override;
//    procedure LoadFromStream(Stream: TStream); override;
//    procedure SetHeight(Value: Integer); override;
//    procedure SetWidth(Value: Integer); override;
//    function GetEmpty: Boolean;override;
//    procedure AssignTo(Dest: TPersistent); override;    function GetHeight: Integer;override;
    function GetWidth: Integer;override;    constructor Create;override;
    destructor Destroy;override;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenPictureDialog1.Execute;
end;{ TTextPicture }constructor TTextPicture.Create;
begin
  inherited Create;
  FTextList := TStringList.Create;
end;destructor TTextPicture.Destroy;
begin
  FTextList.Free;
  inherited Destroy;
end;procedure TTextPicture.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  Rt: TRect;
begin
  ACanvas.Brush.Color := clWindow;
  ACanvas.Brush.Style := bsClear;
  Rt := Rect;
  DrawText(ACanvas.Handle,PChar(FTextList.Text),Length(FTextList.Text),Rt,DT_WORDBREAK);
end;function TTextPicture.GetHeight: Integer;
begin
  Result := 300;
end;function TTextPicture.GetWidth: Integer;
begin
  Result := 200;
end;procedure TTextPicture.LoadFromFile(const Filename: string);
begin
  FTextList.LoadFromFile(FileName);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenPictureDialog1.Filter := OpenPictureDialog1.Filter + '|Txt File|*.txt';
end;initialization
  TPicture.RegisterFileFormat('txt','txtPictureFile',TTextPicture);end.// TTextPicture 这个类没有完成，有很多成员函数要覆盖，只是为了说明随手写的一个例子。
// 网上有个TGifImage类，有源代码，可以查看一下。