Malowanie DBGrida – pomoc w przerobieniu

0

Cześć.
Potrzebuję pomocy w przerobieniu kodu. Teraz jest wszystko dobrze tylko chcę przerobić kod w miejscu wyświetlania obrazka w DBGrid. Chodzi mi by w wypadku braku obrazka wyświetlić brazek zastępczy pobierany z zasobów. Mam dwie ogólne metody, w tym: samo wczytanie które to chce podpiąć teraz w miejsce wyświetlania, a w nim jeszcze jedną metodę ładowanie z zasobów. A oto cześć kodu którą chcę przerobić: Na samym dole załączam działające całe malowanie DBGrida

  lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
  aDBGrid.canvas.StretchDraw(lRect, lImage);

próbowałam to przerobić tak jak niżej oraz na parę innych sposobów lecz nie skutecznie. W tym wypadku drugim parametrem StretchDraw musi być Vcl.Graphics.TGraphics więc na pewno jest to źle.

 LoadImage(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
  aDBGrid.canvas.StretchDraw(lRect, LoadImage);

Ogólna moje dwie metody:

procedure LoadImage(aFileName: string);
var
lImage: TJPEGImage;
begin
lImage := TJPEGImage.Create;
  try
    lImage.LoadFromFile(aFileName);
  except
    LoadDefaultImage('Brak_Zdjecia');
  end;
end;

procedure LoadDefaultImage(aPngName: string);
var
  lImage: TPngImage;
begin
  lImage := TPngImage.Create();
  try
    lImage.LoadFromResourceName(hInstance, aPngName);
  finally
    lImage.Free();
  end;
end;

Malowanie DBGrida

procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState; Sender: TObject;
  const Rect: TRect; DataCol: Integer);
var
  lRect: TRect;
  lImage: TJPEGImage;
  lPicturePath: string;
  lDataset: TclientDataSet;
  lIsFile: Boolean;

begin
  lDataset := TclientDataSet(aDBGrid.DataSource.DataSet);
  lPicturePath := extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString;
  lIsFile := fileexists(lPicturePath);
  if (Column.Field.FieldName <> aGraphicFieldName) or (not lIsFile) then
  begin
    if (gdSelected in State) and (TDBGrid(Sender).Focused) then
      TDBGrid(Sender).canvas.Brush.color := $E8E3A8
    else
      TDBGrid(Sender).canvas.Brush.color := clWhite;
    aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end
  else
  begin
    lRect.left := Rect.left + 1;
    lRect.Top := Rect.Top + 1;
    lRect.Right := Rect.Right - 1;
    lRect.Bottom := Rect.Bottom - 1;
    lImage := TJPEGImage.Create;
    try
      try
        lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
        aDBGrid.canvas.StretchDraw(lRect, lImage);
      except
        on e: exception do
        begin
          raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
              .AsString + ''#13'' + ''#10'' + e.Message);
        end;
      end;
    finally
      lImage.Free;
    end;
  end;
end;

1

procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState; Sender: TObject;
  const Rect: TRect; DataCol: Integer);
var
  lRect: TRect;
  lImage: TJPEGImage;
  lPicturePath: string;
  lDataset: TclientDataSet;
  lIsFile: Boolean;
  lRS: TResourceStream;

begin
  lDataset := TclientDataSet(aDBGrid.DataSource.DataSet);
  lPicturePath := extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString;
  lIsFile := fileexists(lPicturePath);
  if (Column.Field.FieldName <> aGraphicFieldName) then
  begin
    if (gdSelected in State) and (TDBGrid(Sender).Focused) then
      TDBGrid(Sender).canvas.Brush.color := $E8E3A8
    else
      TDBGrid(Sender).canvas.Brush.color := clWhite;
    aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end
  else
  begin
    lRect.left := Rect.left + 1;
    lRect.Top := Rect.Top + 1;
    lRect.Right := Rect.Right - 1;
    lRect.Bottom := Rect.Bottom - 1;
    lImage := TJPEGImage.Create;
    try
      try

        // rysowanie obrazka z pliku, a w przypadku braku pliku to z zasobu o nazwie 'Brak_zdjęcia'
        if lIsFile then
          lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString)
        else
        begin
          lRS := TResourceStream.Create(hInstance, 'Brak_zdjecia', RT_RCDATA);
          try
            lImage.LoadFromStream(lRS);
          finally
            lRS.Free;
          end;
        end;
        aDBGrid.canvas.StretchDraw(lRect, lImage);
        ///

      except
        on e: exception do
        begin
          raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
              .AsString + #13 + #10 + e.Message);
        end;
      end;
    finally
      lImage.Free;
    end;
  end;
end;

BTW.. procedury LoadDefaultImage oraz LoadImage są bez sensu
LoadDefaultImage lokalnie tworzy obiekt klasy TPngImage, ładuje do niego obrazek po czym obiekt jest zwalniany
LoadImage podobnie jak poprzednia procedura lokalnie tworzy obiekt klasy TJPEGImage i ładuje do niego obrazek nie zwalniając obiektu przez co masz wyciek pamięci
Można powiedzieć że z punktu widzenia aplikacji procedury nic nie robią bo operują wyłącznie na lokalnych obiektach graficznych

próbowałam to przerobić tak jak niżej oraz na parę innych sposobów lecz nie skutecznie. W tym wypadku drugim parametrem StretchDraw musi być Vcl.Graphics.TGraphics więc na pewno jest to źle.

    LoadImage(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
    aDBGrid.canvas.StretchDraw(lRect, LoadImage);

żle bo drugim parametrem metody aDBGrid.canvas.StretchDraw jest wskaźnik do obiektu TJPEGImage a Ty podstawiasz nazwę procedury

0

Dziękuję za pomoc :) i dobre wytłumaczenie. Mam jeszcze z tym mały problem, gdyż wywala mi wyjątek ale już wiem chyba dlaczego - lImage jest obiektem TJPEGImage a mój plik jest formatem graficznym .png ale z tym sobie już poradzę o ile to jest to

0

Tzn. do TJPEGImage nie uda Ci się bezpośrednio załadować obrazu z pliku .png, więc to na pewno musisz poprawić.

CzrnaOwca napisał(a):

Mam jeszcze z tym mały problem, gdyż wywala mi wyjątek ale już wiem chyba dlaczego […]

Cała biblioteka standardowa i komponentów działają w oparciu o wyjątki, więc jeśli otrzymujesz wyjątek to koniecznie podaj dokładne informacje o nim, czyli typ klasy wyjątku, jego treść oraz linijkę kodu, która powoduje jego utworzenie. W przeciwnym razie pozostanie jedynie zgadywanie tego skąd się wziął.

0

też mam z tym problem

0

@sigmasig: czyli z czym?

0

Cześć. Mam nie gniewajcie się za wznowienie tematu. Kilka pytań w temacie

Pierwsze: Jak zrobić poprawnie by w DBGrid mogły współistnieć pliki JPEG i PNG(tylko z zasobów, jako obraz zastępczy) Ja zrobiłam jak poniżej i chyba źle gdyż przesuwając kursor po tabelce(strzałkami) przeźroczystość na PNG(na obrazie zastępczym, gdy nie ma obrazka,tylko na nim ) się nadmalowuje kolorem obrazka który jest niżej lub wyżej, obrazek w komórce zmienia barwy to co ma przezroczystość i to co nie ma.(Mam tylko jeden plik .png jako obraz zastępczy w kodzie jako: Brak_Zdjecia reszta to jpeg)

Drugie pytanie czy i jeśli tak to jak wkomponować tu wyświetlanie obrazka coś na zasadzie właściwości proportional w kontrolce TImage (aby obrazek dopasował się do wielkości komórki)

I w końcu trzecie pytanie: Czy da się z tego kodu zrobić ogólną metodę tak by pozostawiać tylko malowanie kursora, gdyż przez RadioGroup mam wybór jakie dane będą wyświetlone w jednych są obrazki w drugich nie ma ich wcale co powoduję błąd. Czy pozostaje stworzenie oddzielnego kod?

A oto kod:

procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState; Sender: TObject;
  const Rect: TRect; DataCol: Integer);
var
  lRect: TRect;
  lImage: TJPEGImage;
  lImage2: TPNGimage;
  lPicturePath: string;
  lDataset: TclientDataSet;
  lIsFile: Boolean;
  lRS: TResourceStream;

begin
  lDataset := TclientDataSet(aDBGrid.DataSource.DataSet);
  lPicturePath := extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString;
  lIsFile := fileexists(lPicturePath);
  if (Column.Field.FieldName <> aGraphicFieldName) then
  begin
    if (gdSelected in State) and (TDBGrid(Sender).Focused) then
      TDBGrid(Sender).canvas.Brush.color := $E8E3A8
    else
      TDBGrid(Sender).canvas.Brush.color := clWhite;
    aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end
  else
  begin
    lRect.left := Rect.left + 1;
    lRect.Top := Rect.Top + 1;
    lRect.Right := Rect.Right - 1;
    lRect.Bottom := Rect.Bottom - 1;
    lImage := TJPEGImage.Create;
    lImage2:= TPNGImage.Create;
    try
      try
        if lIsFile then
          lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString)
        else
        begin
          lRS := TResourceStream.Create(hInstance, 'Brak_Zdjecia', RT_RCDATA);
          try
            lImage2.LoadFromStream(lRS);
            aDBGrid.canvas.StretchDraw(lRect, lImage2)
          finally
            lRS.Free;
          end;
        end;
          aDBGrid.canvas.StretchDraw(lRect, lImage);
          aDBGrid.canvas.StretchDraw(lRect, lImage2);
      except
        on e: exception do
        begin
          raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
              .AsString + #13 + #10 + e.Message);
        end;
      end;
    finally
      lImage.Free;
    end;
  end;
end;

0

masz źle poukładane w kodzie wywołania metody aDBGrid.canvas.StretchDraw

procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState;
  Sender: TObject; const Rect: TRect; DataCol: Integer);
var
  lRect: TRect;
  lImage: TJPEGImage;
  lImage2: TPNGimage;
  lPicturePath: string;
  lDataset: TclientDataSet;
  lIsFile: Boolean;
  lRS: TResourceStream;

begin
  lDataset := TclientDataSet(aDBGrid.DataSource.DataSet);
  lPicturePath := extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString;
  lIsFile := fileexists(lPicturePath);
  if (Column.Field.FieldName <> aGraphicFieldName) then
  begin
    if (gdSelected in State) and (TDBGrid(Sender).Focused) then
      TDBGrid(Sender).canvas.Brush.color := $E8E3A8
    else
      TDBGrid(Sender).canvas.Brush.color := clWhite;
    aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end
  else
  begin
    lRect.left := Rect.left + 1;
    lRect.Top := Rect.Top + 1;
    lRect.Right := Rect.Right - 1;
    lRect.Bottom := Rect.Bottom - 1;
    lImage := TJPEGImage.Create;
    lImage2 := TPNGimage.Create;
    try
      try
        if lIsFile then
        begin
          lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName)
              .AsString);
          aDBGrid.canvas.StretchDraw(lRect, lImage); /// --- tutaj zmiana 
        end
        else
        begin
          lRS := TResourceStream.Create(hInstance, 'Brak_Zdjecia', RT_RCDATA);
          try
            lImage2.LoadFromStream(lRS);
            aDBGrid.canvas.StretchDraw(lRect, lImage2);
          finally
            lRS.Free;
          end;
        end;
        // aDBGrid.canvas.StretchDraw(lRect, lImage);  ///  - dwa błędne wywołania metody 
        // aDBGrid.canvas.StretchDraw(lRect, lImage2); ///
      except
        on e: exception do
        begin
          raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
              .AsString + #13 + #10 + e.Message);
        end;
      end;
    finally
      lImage.Free;
      lImage2.Free;   /// --- brakowało zwolnienia obiektu lImage2
    end;
  end;
end;

0

@grzegorz_so dziękuję za pomoc ale dalej nadrysowuję i nie umiem wpaść na pomysł dlaczego, sam obraz się nie zmienia ale zmienia kolory to jest związane coś z przeźroczystością, raz ona jest drugim jej nie ma i wtedy coś się miesza w komórce

Malowanie DBGrida – pomoc w przerobieniu

CzrnaOwca napisał(a):

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami