UPS...

RTL skal læses som RTF -- sorry !

Hola

jeg har netop kæmpet med en løsning jeg tror du kan bruge. Den kan pt vise billeder, xlsx og pdf filer fra en database hvor de tidligere er blevet gemt og hive dem frem igen, mon ikke du kan modificere den til også at vise links.

Håber ikke det bliver for uoverskueligt.

På formen er bare en TPictureList, TImage og en TMemo.

Kodestart:
unit visfiler;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Imaging.GIFImg, Vcl.Imaging.PngImage, Vcl.Imaging.JPeg, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, AdvPanel, frmdmcont, DBAdvPicture, AdvPicture, Vcl.StdCtrls, PictureList,
  Data.DB, ShellApi, Vcl.ComCtrls, bdrutils, Bde.DBTables;

type
  TfrmVisFiler = class(TForm)
    AdvPanel1: TAdvPanel;
    AdvPanel2: TAdvPanel;
    PictureList: TPictureList;
    Memo1: TMemo;
    imageBig: TImage;
    procedure PictureListDblClick(Sender: TObject);
    procedure PictureListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    iEntry_Id: integer;
    procedure FillFileList;
    Procedure DestroyFileList;
  public
    { Public declarations }
    procedure Execute(sagsnr: integer);
  end;

var
  frmVisFiler: TfrmVisFiler;
  ListOfFiles: TList;

implementation

{$R *.dfm}

procedure TfrmVisFiler.DestroyFileList;
var
  i:integer;
begin
  if ListOfFiles.Count >0 then begin
    for I := 0 to ListOfFiles.Count-1 do begin
      TPicInfoClass(ListOfFiles.Items[i]).Free;
    end;
    ListOfFiles.Free;
  end;
end;

procedure TfrmVisFiler.Execute(sagsnr: integer);
begin
  iEntry_Id := sagsnr;
  FillFileList;
  ShowModal;
  DestroyFileList;
end;

procedure TfrmVisFiler.FillFileList;
var
  SqlTxt: string;
  Save_Cursor: TCursor;
  BlobStream: TStream;
  pngfile : TPngImage;
  bmpfile : TBitmap;
  giffile : TGifImage;
  jpgfile : TJPeGImage;
  picfile : TPicture;
  rscfile: string;
  tmpPicInfoClass: TPicInfoClass;
begin
  //Get image from DB
  Save_Cursor := Screen.Cursor;
  try
    try
      Screen.Cursor := crSQLWait;
      dmCont.qGetComboBoxFills.Active := false;
      dmCont.qGetComboBoxFills.SQL.Clear;
      SqlTxt := 'select * from bdrattachments where entry_id = '+inttostr(iEntry_Id)+' order by filenmb asc';
      dmCont.qGetComboBoxFills.SQL.Add(SqlTxt);
      dmCont.qGetComboBoxFills.Open;
      dmCont.qGetComboBoxFills.First;
      while(not dmCont.qGetComboBoxFills.Eof)do begin
        tmpPicInfoClass := TPicInfoClass.Create;
        tmpPicInfoClass.ext := dmCont.qGetComboBoxFills.FieldByName('extension').AsString;
        tmpPicInfoClass.caption := dmCont.qGetComboBoxFills.FieldByName('caption').AsString;
        tmpPicInfoClass.comment := dmCont.qGetComboBoxFills.FieldByName('comment').AsString;
        BlobStream := dmCont.qGetComboBoxFills.CreateBlobStream(dmCont.qGetComboBoxFills.FieldByName('filedata'),bmRead); //BlobStream; //Burde der være en .create here først
        tmpPicInfoClass.filedataraw := TMemoryStream.Create;
        tmpPicInfoClass.filedataraw.LoadFromStream(BlobStream);

        rscfile := tmpPicInfoClass.ext;
        Delete(rscfile,1,1); //remove . in .xxx
        if POS(Uppercase(tmpPicInfoClass.ext), '.JPEG .JPG .BMP .GIF .PNG')>0 then begin
          picfile := TPicture.Create;
          try
            try
              Picturelist.Thumbnails.Add;
              Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Caption := tmpPicInfoClass.caption;
              Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Source := tsPicture;

              if (Uppercase(rscfile) = 'JPG') or (Uppercase(rscfile) = 'JPEG') then begin
                jpgfile := TJpegImage.Create;
                try
                  jpgfile.LoadFromStream(tmpPicInfoClass.filedataraw);
                  picfile.Assign(jpgfile);
                  Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Picture := picfile;
                finally
                  jpgfile.Free;
                end;
              end
              else if Uppercase(rscfile) = 'BMP' then begin
                bmpfile := TBitMap.Create;
                try
                  bmpfile.LoadFromStream(tmpPicInfoClass.filedataraw);
                  picfile.Assign(bmpfile);
                  Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Picture := picfile;
                finally
                  bmpfile.Free;
                end;
              end
              else if Uppercase(rscfile) = 'GIF' then begin
                giffile := TGifImage.Create;
                try
                  giffile.LoadFromStream(tmpPicInfoClass.filedataraw);
                  picfile.Assign(giffile);
                  Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Picture := picfile;
                finally
                  giffile.Free;
                end;
              end
              else if Uppercase(rscfile) = 'PNG' then begin
                pngfile := TPngImage.Create;
                try
                  pngfile.LoadFromStream(tmpPicInfoClass.filedataraw);
                  picfile.Assign(pngfile);
                  Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Picture := picfile;
                finally
                  pngfile.Free;
                end;
              end;
            except on e:Exception do
              MessageDlg('Kunne ikke tilføje fil til fil-liste: '+e.Message, mtError, [mbOK], 0);
            end;
          finally
            picfile.Free;
          end;
        end
        else if POS(Uppercase(tmpPicInfoClass.ext), '.PDF .DOC .DOCX .XLS .XLSX')>0 then begin
          picfile := TPicture.Create;
          bmpfile:=TBitmap.Create;
          try
            try
              bmpfile.LoadFromResourceName(hInstance,rscfile);
              picfile.Bitmap := bmpfile;
              Picturelist.Thumbnails.Add;
              Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Picture := picfile;
              Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Caption := tmpPicInfoClass.caption;
              Picturelist.Thumbnails[PictureList.Thumbnails.Count-1].Source := tsPicture;
            except on e:Exception do
              MessageDlg('Kunne ikke tilføje fil til fil-liste: '+e.Message, mtError, [mbOK], 0);
            end;
          finally
            bmpfile.Free;
            picfile.Free;
          end;
        end;
        BlobStream.Free;
        ListOfFiles.Add(tmpPicInfoClass);
        dmCont.qGetComboBoxFills.Next;
      end;
      Picturelist.Refresh;
    except on E:Exception do
      begin
        MessageDlg('Problemer med at hente vedhæftede filer.  ' + E.Message, mtError, [mbOK], 0);
      end;
    end;
  finally
    dmCont.qGetComboBoxFills.Close;
    Screen.Cursor := Save_Cursor;
  end;
end;

procedure TfrmVisFiler.FormCreate(Sender: TObject);
begin
  ListOfFiles := TList.Create;
end;

procedure TfrmVisFiler.PictureListClick(Sender: TObject);
begin
  //Get image from DB
  imageBig.Picture := PictureList.Thumbnails[PictureList.ItemIndex].Picture;
  Memo1.Text := TPicInfoClass(ListOfFiles.Items[PictureList.ItemIndex]).comment; // Items[ListOfFiles.IndexOf(PictureList.ItemIndex)]. comment;
end;

procedure TfrmVisFiler.PictureListDblClick(Sender: TObject);
var
  SqlTxt, strTempFileName: string;
  Save_Cursor: TCursor;
  BlobStream: TStream;
begin
  //Get image from DB
  Save_Cursor := Screen.Cursor;
  try
    try
      Screen.Cursor := crSQLWait;
      dmCont.qGetComboBoxFills.Active := false;
      dmCont.qGetComboBoxFills.SQL.Clear;
      SqlTxt := 'select filedata from bdrattachments where entry_id = '+ inttostr(iEntry_Id)+ ' and filenmb = '''+ inttostr(PictureList.ItemIndex) +'''';
      dmCont.qGetComboBoxFills.SQL.Add(SqlTxt);
      dmCont.qGetComboBoxFills.Open;
      dmCont.qGetComboBoxFills.First;

      BlobStream := dmCont.qGetComboBoxFills.CreateBlobStream(dmCont.qGetComboBoxFills.FieldByName('filedata'),bmRead);
      BlobStream.Seek(0, soFromBeginning);

      //Gemmer filen i brugerens windows temp folder
      strTempFileName := SJWinTmpPath + 'bdrtmpfil'+ TPicInfoClass(ListOfFiles.Items[PictureList.ItemIndex]).ext;
      with TFileStream.Create(strTempFileName, fmCreate) do
        try
          CopyFrom(BlobStream, BlobStream.Size)
        finally
          Free
        end;
      if POS(Uppercase(TPicInfoClass(ListOfFiles.Items[PictureList.ItemIndex]).ext), '.JPEG .JPG .BMP .GIF .PNG')>0 then begin
        ShellExecute(
          0,
          'open',
          'c:\Windows\System32\rundll32.exe',
          PChar('c:\Windows\System32\shimgvw.dll,ImageView_Fullscreen ' + strTempFileName),
          nil,
          SW_NORMAL);
      end
      else if POS(Uppercase(TPicInfoClass(ListOfFiles.Items[PictureList.ItemIndex]).ext), '.PDF .DOC .DOCX .XLS .XLSX')>0 then begin
        ShellExecute(
          0,
          'open',
          PChar(strTempFileName),
          nil,
          nil,
          SW_NORMAL);
      end
      else
        MessageDlg('Du har ingen programmer installeret der kan vise denne filtype!', mtError, [mbOK], 0);

    except on E:Exception do
      MessageDlg('Problemer med at hente filen.', mtError, [mbOK], 0);
    end;
  finally
    BlobStream.Free;
    dmCont.qGetComboBoxFills.Active := false;
    Screen.Cursor := Save_Cursor;
  end;

end;

Var det noget du kunne bruge til noget eller blev det for snørklet? :)

Desværre, det var ikke lige det.

Men jeg har talt med "brugeren"; han er lidt utilfreds med resultatet, men har accepteret det (nødtvungent). (Og det er også begrænset hvad man kan få for 0,00 kr. i hyre.)

Så hvis der ikke er kommentarer (ønske om point etc. ) vil jeg lukke spm. i næste uge.

Kristian

LUKKER