🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: pl.comp.lang.delphi
Article #346044

Nie działa mi TImage tak jak powinien - moja indolencja z OOP?

#346044
From: Robert
Date: Sun, 10 Sep 2017 20:48
299 lines
9669 bytes
Witam Szanownych. 
To mój pierwszy raz tutaj a z Delphi (XE) zaczynam przygodę i mam problem chyba związany z nieznajomością OOP bo nie wierzę, że komponent TImage jest wadliwy.
Tak więc z góry przepraszam za trywialne pytanie ale walczę z problemem już na tyle długo, że musiałem sięgnąć po pomoc. 

Poniżej zamieściłem obcięte do minimum dwa moduły, z których wyrzuciłem wszystko co niezbędne i zostawiłem sama obsługę tworzenia obiektów i inicjacji obrazka. Funkcją tych modułów jest odczytanie i wyświetlenie danych z pliku w komponencie TVirtualStringTree. Z pliku odczytuję również pliki .jpg, które chcę wyświetlić w TImage w zależności od tego którą nodę kliknie się w Tree. 
Odczyt i prezentacja danych tekstowych przebiegają właściwe. Problemem jest pokazanie tych obrazków. Gdy tworzę i inicjuję obiekt TFilm, to tworzę również pole fPoster do którego chcę na starcie wczytać plik, nazwijmy go - początkowy. Później w trakcie czytania danych z pliku obrazek początkowy zastępowany jest tym odczytanym z pliku i ten drugi ma być prezentowany w TImage. Niestety, drugi obrazek jest pokazywany tylko wtedy, gdy przy tworzeniu obiektu TFilm NIE przypiszę nic do pola fPoster. Gdy dokonam przypisania to widoczny jest wyłącznie ten pierwszy obrazek.

Jestem pewien, że czytam obrazki z pliku w sposób właściwy. Gdy w vsTreeNodeClick dla testu zapisuję obrazek do pliku to pojawia się ten właściwy: (Filmy.FilmInd[Data.NrF].Poster.SaveToFile();)
Co więcej, gdy w tej samej procedurze zapisuję do pliku zawartość ImgPoster.Picture. to również zapisuje się właściwy obraz, lecz równocześnie na formie wyświetlany jest zły. Gdzie się przewróciłem? Proszę o pomoc.


type
  TRekordNody = record
                  NrF:         Integer;
                  R:           RFilm;
                  Wartosc:     AnsiString;
                  Zmieniony:   Boolean;
                end;

  PRekordNody = ^TRekordNody;


  TForm1 = class(TForm)
    vsTree: TVirtualStringTree;
    PopM: TPopupMenu;
    OpenD: TOpenDialog;
    ImgPoster: TImage;
    PMczytaj1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure PMCzytajClick(Sender: TObject);
    procedure vsTreeInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure vsTreeNodeClick(Sender: TBaseVirtualTree;
      const HitInfo: THitInfo);
  private
    { Private declarations }
  public
    { Public declarations }
    Filmy :TFilmy;
  end;

var
  Form1: TForm1;

implementation
uses EdytorVSTree;
{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Filmy.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  try
    Filmy := TFilmy.Create;
  finally
    vsTree.RootNodeCount := Filmy.LiczbaFilmow;
    vsTree.NodeDataSize  := SizeOf(TRekordNody);
  end; {of finally}
end;

procedure TForm1.PMCzytajClick(Sender: TObject);
begin
 if OpenD.Execute = True then
   begin
     Filmy.Czytaj(OpenD.FileName);

     vsTree.RootNodeCount := Filmy.LiczbaFilmow;
     vsTree.NodeDataSize  := SizeOf(TRekordNody);
   end;
end;

procedure TForm1.vsTreeInitNode(Sender: TBaseVirtualTree; ParentNode,
  Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var Data :PRekordNody;
    i :Integer;
begin
  with Sender do begin
    Data := GetNodeData(Node);
    i := Node.Index+1;
    Data.R := Filmy.FilmInd[i].KompletneInfo;
    Data.NrF := i;
  end;
end;

procedure TForm1.vsTreeNodeClick(Sender: TBaseVirtualTree;
  const HitInfo: THitInfo);
var hit :THitInfo;
    P   :TPoint;
    Data:PRekordNody;
begin
 with Sender do
  begin
   P := ScreenToClient(Mouse.CursorPos);
   GetHitTestInfoAt(P.X, P.Y,True,hit);

   Data := GetNodeData(hit.HitNode);

{!!!!!!!!!!!!!!!!!!!!!!!}
{!!!!!!!!!!!!!!!!!!!!!!!}
{ TU POWINIEN WYŚWIETLIĆ ZAWARTOŚĆ A POKAZUJE CO INNEGO }
   ImgPoster.Picture.Assign(Filmy.FilmInd[Data.NrF].Poster);

  end;
end;



type
Gatunki = (___,akcja,biograficzny,czarna_komedia,dramat,familijny,fantasy,horror,komedia,na_faktach,metafizyka,obyczajowy,paradokument,przygodowy,sci_fi,społeczny,thriller,wojenny);

RFilm = record
   Poster    : TJPEGImage;
 end;

TFilm = class(TObject)
 private
   fPoster    : TJPEGImage;

   function  GetPoster: TJPEGImage;
   procedure SetPoster(const Value: TJPEGImage);
   function  GetDane: RFilm;
   procedure SetDane(const Value: RFilm);

 public
   constructor Create;
   destructor Destroy; override;

   property Poster   :TJPEGImage read GetPoster   write SetPoster;
   property KompletneInfo :RFilm read GetDane     write SetDane;

 end;

 TFlmArr = array of TFilm;  {tablica z obiektami opisu filmów}
 TIntArr = array of Integer;

 TFilmy = class(TObject)  {klasa obsługi katalogu filmów}
  private
    fTbFlm :TFlmArr;
    function  GetFilmInd(ind: Integer): TFilm;
    procedure SetFilmInd(ind: Integer; const Value: TFilm);
  public
   constructor Create;
   destructor  Destroy; override;
   procedure CzyscWszystko;
   procedure DodajNowy;
   procedure Czytaj(FileName:String);
   function LiczbaFilmow: Integer;

   property FilmInd[ind:Integer] :TFilm  read GetFilmInd write SetFilmInd;
  end;



implementation
uses BazaFilmowGlowny;
{TFilm}

constructor TFilm.Create;
var tmpBt :TBitmap;
begin
  try
    inherited;
    fPoster   := TJPEGImage.Create;

    tmpBt := TBitmap.Create;
    tmpBt.LoadFromResourceName(HInstance, 'PustyPoster');

{!!!!!!!!!!!!!!!!!!!}
{!!!!!!!!!!!!!!!!!!!}
{Gdy linia poniżej jest odkomentowana to pojawia się opisany problem}
{!!!!!!!!!!!!!!!!!!!}
  //  fPoster.Assign(tmpBt); 

  finally
    tmpBt.Free;
  end;
end;

destructor TFilm.Destroy;
begin
  fPoster.Free;
  inherited Destroy;
end;

function  TFilm.GetPoster: TJPEGImage;
begin
  Result := fPoster;
end;

procedure TFilm.SetPoster(const Value: TJPEGImage);
begin
  if Value <> fPoster then fPoster.Assign(Value);
end;

function  TFilm.GetDane: RFilm;
begin
  Result.Poster   := Poster;
end;

procedure TFilm.SetDane(const Value: RFilm);
begin
  if Value.Poster <> Poster then Poster.Assign(Value.Poster);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TFilmy }

constructor TFilmy.Create;
begin
  inherited Create;
  SetLength(fTbFlm,1);
  fTbFlm[0] := TFilm.Create;
 end;

destructor TFilmy.Destroy;
var i:Integer;
begin
  for i := High(fTbFlm) downto 0 do
    fTbFlm[i].Free;

  SetLength(fTbFlm,0);
  inherited Destroy;
end;

procedure TFilmy.CzyscWszystko;
var i:Integer;
begin
  for i := High(fTbFlm) downto 0 do
    fTbFlm[i].Free;

  SetLength(fTbFlm,1);
  fTbFlm[0] := TFilm.Create;
end;


procedure TFilmy.DodajNowy;
begin
  SetLength(fTbFlm, Length(fTbFlm)+1);
  fTbFlm[High(fTbFlm)] := TFilm.Create;
end;

function TFilmy.LiczbaFilmow: Integer;
begin
  Result := High(fTbFlm);
end;

function TFilmy.GetFilmInd(ind: Integer): TFilm;
begin
  Result := fTbFlm[ind]
end;

procedure TFilmy.SetFilmInd(ind: Integer; const Value: TFilm);
begin
  fTbFlm[ind] := Value;
end;

procedure TFilmy.Czytaj(FileName: String);
var FS :TFileStream;
    MS :TMemoryStream;
    i, tmpI, LiczFilmy :Integer;
    D :TFilm;

begin
  try
    FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    MS := TMemoryStream.Create;

    CzyscWszystko;
    D := TFilm.Create;

    FS.ReadBuffer(LiczFilmy, SizeOf(LiczFilmy));

    for i := 1 to LiczFilmy do
      begin
        {tu czytam cały rekord i przepisuję dane do obiektu D}

        DodajNowy;

        FS.ReadBuffer(tmpI, SizeOf(tmpI));
        MS.CopyFrom(FS,tmpI);
        MS.Position := 0;
        D.Poster.LoadFromStream(MS);
        MS.Clear ;

        FilmInd[i].KompletneInfo := D.KompletneInfo;
      end;

  finally
    D.Free;
    FS.Free;
    MS.Free;
  end;
end;
Technical Details
Message-ID: <ca539309-9239-463b-8e2a-642c67db76c2@googlegroups.com>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.icm.edu.pl!news.nask.pl!news.nask.org.pl!news.unit0.net!weretis.net!feeder6.news.weretis.net!feeder.usenetexpress.com!feeder-in1.iad1.usenetexpress.com!border1.nntp.dca1.giganews.com!border2.nntp.dca1.giganews.com!nntp.giganews.com!b1no889857qtc.1!news-out.google.com!c139ni2942itb.0!nntp.google.com!o200no1897048itg.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail

Show Full Headers
Complete Article Headers
X-Received: by 10.159.49.163 with SMTP id v32mr4908234uad.116.1505076510441;        Sun, 10 Sep 2017 13:48:30 -0700 (PDT)
X-Received: by 10.36.51.202 with SMTP id k193mr494125itk.14.1505076510379; Sun, 10 Sep 2017 13:48:30 -0700 (PDT)
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.icm.edu.pl!news.nask.pl!news.nask.org.pl!news.unit0.net!weretis.net!feeder6.news.weretis.net!feeder.usenetexpress.com!feeder-in1.iad1.usenetexpress.com!border1.nntp.dca1.giganews.com!border2.nntp.dca1.giganews.com!nntp.giganews.com!b1no889857qtc.1!news-out.google.com!c139ni2942itb.0!nntp.google.com!o200no1897048itg.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
Newsgroups: pl.comp.lang.delphi
Date: Sun, 10 Sep 2017 13:48:30 -0700 (PDT)
Complaints-To: groups-abuse@google.com
Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=91.123.188.253; posting-account=HGS5PQoAAAAApdzPVpOERkS_ZB4iSxSW
NNTP-Posting-Host: 91.123.188.253
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <ca539309-9239-463b-8e2a-642c67db76c2@googlegroups.com>
Subject: Nie działa mi TImage tak jak powinien - moja
 indolencja z OOP?
From: Robert <officedrr@gmail.com>
Injection-Date: Sun, 10 Sep 2017 20:48:30 +0000
Lines: 334
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit