TVirtualDrawtree

[mia]

example will be very handy . i play too much with list view still dont know how to do alot of stuff , what do you mean

draw a text over a default image on it.

[mrmarman]

- Whether or not the Image exists, there will be a ListView Item on the list for each user isn't it ?
- So you may decide a default avatar image for all users which image not exists. OR you may put USERNAME over to where the Image will be place. I wanted to say, a mini/tiny Text like placeholder for USER IMAGE

[mia]

i try to work around , i dont get how to draw the item first , also you mention to draw the item over image until its load thats will looks weird

[mia]

i tried to bring the drawing text first in listview then draw image still listview show empty until image download is finish

Kod: Tümünü seç

    xOff := Rect.Left;
    for i := 1 to TListView(sender).Columns.Count-1 do // 1,2,3,4,5,6
    begin
      xOff := xOff + TListView(Sender).Columns[i-1].Width;
      yOff := Rect.Top + ((ImageList1.Height-Canvas.TextHeight('H')) div 2);
      if xboolBlink or ( Item.SubItems[2] = '' )
        then sender.canvas.font.color := clgray
        else sender.canvas.font.color := clred;
      TextOut( xOff, yOff, Item.SubItems[i-1] 

[mrmarman]

this is subitem text drawing on canvas routines.
every drawing operations paints over previous paintings. So you must be careful this painting queue. May be you paint right but after painting covers the right one in wrong queue.

[mia]

as always spend time to try and no success for second day showing some codes will help a lot

[mrmarman]

maybe a couple days more help you to understand canvas painting issues.
I'm now a festival for TV shooting. It will take sone time. I didn't belong my computer

[mia]

here is what i tried so far

added new thread called

TDownloadThread , to try to avoide freezing but its seems i cannot download any image any more or i did threading part very wrong , adding item first totally get more complicated ,

i know you are busy more important stuff i hope only to help me when you have a free time

here is the project of workaround

[mia]

day 5 and did not get any solve by my self , i tried to work around by doing threading for download image

Kod: Tümünü seç

type
  TURLDownload = class(TThread)
  private
    FMs: TMemoryStream;
    FURL: String;
    procedure UpdateVisual;
    function DownloadToStream: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(Suspended: Boolean);
    destructor Destroy; override;
  public
    property URL: String read FURL write FURL;
  end;

constructor TURLDownload.Create(Suspended: Boolean);
begin
  inherited Create(Suspended);
  FMs := TMemoryStream.Create;
end;

destructor TURLDownload.Destroy;
begin
  FMs.Free;
  inherited Destroy;
end;

function TURLDownload.DownloadToStream: Boolean;
var
  hSession     : HINTERNET;
  hService     : HINTERNET;
  lpBuffer     : array[0..1023] of Byte;
  dwBytesRead  : DWORD;
  dwBytesAvail : DWORD;
  dwTimeOut    : DWORD;
begin
  Result := False;
  hSession := InternetOpen('sessioname', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(hSession) then Exit;
  try
    hService := InternetOpenUrl(hSession, PChar(FUrl), nil, 0, 0, 0);
    if hService = nil then
      Exit;
    try
      dwTimeOut := 60000;
      InternetSetOption(hService, INTERNET_OPTION_RECEIVE_TIMEOUT, @dwTimeOut, SizeOf(dwTimeOut));
      if InternetQueryDataAvailable(hService, dwBytesAvail, 0, 0) then
      repeat
        if not InternetReadFile(hService, @lpBuffer[0], SizeOf(lpBuffer), dwBytesRead) then
          Break;
        if dwBytesRead <> 0 then
          FMs.WriteBuffer(lpBuffer[0], dwBytesRead);
      until dwBytesRead = 0;
      Result := FMS.Size > 0;
    finally
      InternetCloseHandle(hService);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

procedure TURLDownload.Execute;
begin
  if DownloadToStream then
    UpdateVisual;
end;

had troube with activex or i still doing it wrong , i strongly need help

[mrmarman]

thread is neither hard nor you are wrong. It's just a traffic issue.
is that code work normally on sepatated any project?

(1) start a new project that counts from 1 to 100 and show actual counter on a label by 1 second interval.
(2) while it is counting, a button that you put on the form will start a file download when you press that button.
(3) when download finishes, another label announce you the operation success.

download operation will be under thread. While threafing operation, you must see the counter is counting in your interval.
First you prepare this project to understand the mechanism.

This is not lego brick game which using my or others code like a module.

[mia]

ok this problem i can get ride of it , what about the empty list view i had no equation for it what ever i tried textout canvas but i totally failed i can get coding help with this part

[mrmarman]

that is easy part, you handle the thread thing first. If no avatar, that may be empty for now. If incoming avatar successfully downloaded, it became visible on the canvas when the TObject subitem filled by you.

[mia]

i added the thread in exe its works why its not working in activex ? here is the projects check on button 3 in activex

Kod: Tümünü seç

  URLDownload := TURLDownload.Create(false);
  URLDownload.URL := 'http://www.cyberengineeringservices.com/wp-content/uploads/2014/09/panda.bmp';
  URLDownload.FreeOnTerminate := True;

my thread looks lik ethis

Kod: Tümünü seç

  type
  TURLDownload = class(TThread)
  private
    FMs: TMemoryStream;
    FURL: String;
    procedure UpdateVisual;
    function DownloadToStream: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(Suspended: Boolean);
    destructor Destroy; override;
  public
    property URL: String read FURL write FURL;
  end;

Kod: Tümünü seç

procedure TURLDownload.Execute;
begin
  if DownloadToStream then
    UpdateVisual;
end;

procedure TURLDownload.UpdateVisual;
begin
  FMS.Position := 0;
  testthreading.Image1.Picture.Bitmap.LoadFromStream(FMS);
end;

[mia]

i tried to add timer with CheckSynchronize

Kod: Tümünü seç

procedure Ttestthreading.Timer2Timer(Sender: TObject);
begin
CheckSynchronize;
end;

also cannot get thread work in activex

[mrmarman]

Today I have a little time to bootup my computer but no time to download and check your code...
I build a basic code and there is no problem, it works at first look. Details build over it...
You check it out..

ActiveX Side... a TBitBtn, a TImage, aTMemo

Kod: Tümünü seç

procedure TThreadFormX.BitBtn1Click(Sender: TObject);
begin
  With TURLDownload.Create( Image1 ) do
  begin
    Memo1.Lines.Add(' Image Download Thread...  @ThreadID = ' + IntToStr( ThreadID ) );
    URL := 'http://www.cyberengineeringservices.com/wp-content/uploads/2014/09/panda.bmp';
    Resume;
  end;
end;

a basic Thread unit

Kod: Tümünü seç

unit Unit1;

interface

USES Classes, ExtCtrls, Windows, SysUtils, IdHttp, Graphics;

type
  TURLDownload = class(TThread)
  private
    FImage : TImage;
    FMs    : TMemoryStream;
    FURL   : String;
    procedure UpdateVisual;
    function DownloadToStream: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create( aImage:TImage );
    destructor Destroy; override;
  public
    property URL: String read FURL write FURL;
  end;

implementation

{ TURLDownload }
constructor TURLDownload.Create(aImage: TImage);
begin
  inherited Create(Suspended);
  FImage := aImage;
  FMS    := TMemoryStream.Create;
end;

destructor TURLDownload.Destroy;
begin
  FMs.Free;
  inherited Destroy;
end;


function TURLDownload.DownloadToStream: Boolean;
Var
  aIdHTTP : TIdHttp;
begin
  aIdHTTP := TIdHTTP.Create(nil);
  try
    aIdHTTP.Get(Url, FMS);
  finally
    aIdHTTP.Free;
    Result  := True;
  end;
end;

procedure TURLDownload.Execute;
begin
  FreeOnTerminate := True;
  if DownloadToStream
    then UpdateVisual;
end;

procedure TURLDownload.UpdateVisual();
begin
  FMS.Position := 0;
  FImage.Picture.Bitmap.LoadFromStream(FMS);
end;

end.