Dmitry Stolyarov

Добрый день, подскажите как убрать рамку вокруг TabControl?

ZipTest.rar

В 25.08.2017 в 13:26, Mars M сказал:

Тема старая, но вот тоже понадобилось работать с запаролеными zip архивами в Windows.

Наткнулся на это http://www.uweraabe.de/Blog/2017/05/07/tzipfile-with-password-encryption-part-3/

Там статья из трех частей. Если кратко то в третьей части можно скачать конечный результат модуля, во второй, в комментах есть пример работы.

Все в сборе приаттачил к сообщению

Проверил, вроде работает. Из минусов если добавлять в архив папку с файлами(ZipDirectoryContents) то файлы не паролятся, ну это не проблема.

 

ZipTest.rar

Здравствуйте, посмотрел Ваш пример.. добавил чтение фалов в потоке (без пароля), все работает. Как только пытаюсь прочитать архив с паролем сразу вываливается ошибка..

procedure ExtractToFile2(
  const ZipFileName: string;
  const ZippedFileIndex: Integer;
  const ExtractedFileName: string
);
var
  ZipFile: TEncryptedZipFile;
  DownloadedStream, DecompressionStream, OutputStream: TStream;
  LocalHeader: TZipHeader;
  bmp: tBitmap;
begin
  bmp:= tBitmap.Create;
  DownloadedStream := TFileStream.Create(ZipFileName, fmOpenRead);
  try
    ZipFile := TEncryptedZipFile.Create(CSPassword);
    try
      ZipFile.Open(DownloadedStream, zmRead);
      ZipFile.Read(ZippedFileIndex, DecompressionStream, LocalHeader);
      try
        OutputStream := TMemoryStream.Create;
        try
          OutputStream.CopyFrom(DecompressionStream, DecompressionStream.Size);// тут все падает
          bmp.LoadFromStream(OutputStream);
          fmMain.Image1.Bitmap.Assign(bmp);
        finally
          OutputStream.Free;
          bmp.Free;
        end;
      finally
        DecompressionStream.Free;
      end;
    finally
      ZipFile.Free;
    end;
  finally
    DownloadedStream.Free;
  end;
end;

Подскажите, пжл, что делаю не так (проект во вложении)?

ps: Berlin 10.2

В 13.02.2018 в 09:22, ra.eremeev сказал:

Выкладываю решение. Надеюсь, кому-то будет полезно

Есть ощущение, что это очередной костыль, но работает.

Проблема - в необходимости перерисовки вручную добавленного TListItemImage после загрузки его Bitmap в потоке.

 

LoadBitmaps.zip

Добрый день!

Использую Ваш пример... и столкнулся с такой же траблой.. (в последнем приложенном файле та же трабла..)

Подскажите, пжл, куда копать..

procedure TForm1.FormCreate(Sender: TObject);
var
  sUrl: string;
  i: integer;
  item:TListViewItem;
begin
 with qLess do
  try
    if qLess.Active then Close;
    Open;
    while not eof do
     begin
      with ListView1 do
       begin
        Item:=listview1.Items.Add;
        Item.Text := qLessLESS_NAME.AsString;
        Item.Detail:= qLessLESS_DESC.AsString;
        Item.Data['URL'] := qLessIMG_URL.AsString;
        Item.Data['loading'] := 0; // даём знать, что можно загрузить картинку
       end;
       next;
     end;
  except
   //
  end;
 end;

procedure TForm1.ListView1Paint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var i:integer;
begin
  for i := 0 to ListView1.Items.Count-1 do
  begin
    if (i >= 0) and (i < ListView1.Items.Count) then
    begin
     if  ListView1.Items.Bitmap.Image<>NIL then
      if (ListView1.Items.Data['loading'].AsInteger = 0) then
      begin
        ListView1.Items.Data['loading']:= 1;
        ListView1.Items.Bitmap.LoadFromUrlToListViewItem(ListView1.Items.Data['URL'].AsString, ListView1);
      end;
    end;
  end;
end;

{ TBitmapHelper }

procedure TBitmapHelper.LoadFromUrlToListViewItem(AUrl: string;
  AListView: TListView);
var thread: TThread;
begin
  thread := TThread.CreateAnonymousThread(
  procedure
  var
  NetHTTPClient: TNetHTTPClient;
  Result: TMemoryStream;
  begin
    Result := TMemoryStream.Create;
    NetHTTPClient := TNetHTTPClient.Create(nil);
    try
      try
        NetHTTPClient.Get(AUrl, Result);
        TThread.Synchronize(TThread.CurrentThread,
        procedure()
        var
        tempBitMap: TBitmap;
        begin
          tempBitMap := TBitmap.Create;
          tempBitMap.LoadFromStream(Result);
          if not tempBitMap.IsEmpty then
          begin
            self.Assign(tempBitMap);
            AListView.Paint;
          end;
        end);
        except
        Result.Free;
      end;
      finally
      NetHTTPClient.Free;
    end;
  end);
  thread.FreeOnTerminate := true;
  thread.start;
end;

В Imagelist загружены 2 картинки. Странность заключается в том, что после цикла картинка выводится во всех итемах, но только последняя по циклу. Т.е. Если после обхода последняя установилась с индексом 1, то по всем итемам устанавливается картинка с индексом 2. 

Delphi Berlin 10.2

Добрый день, подскажите, пжл, новичку...

Есть ListView и ImageList с двумя картинками. В ListView Item добавлен Image. ListView заполняю из БД и пытаюсь вывести картинку в зависимости от значения поля БД, но в независимости от значения БД выводится одна и та же картинка.. Такое нельзя провернуть?

procedure TForm6.ListViewNAMEUpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
  var IItem:TListItemImage;
begin
 IItem:= aItem.Objects.FindDrawable('Image4') as TListItemImage;
if (IItem<>nil) then
with FDQuery1 do
 begin
 First;
 while not Eof do
  begin
   if FDQuery1FK_PRICE.AsInteger = 1 then begin
    IItem.ImageIndex:=1
   end else
      begin
         IItem.OwnsBitmap := True;
     IItem.ImageIndex:=0;
      end;
   Next;
  end;
 end;
end;