Przekazywanie Paintbox'a do DLL - malowanie na nim.

Przekazywanie Paintbox'a do DLL - malowanie na nim.
SZ
  • Rejestracja:ponad 16 lat
  • Ostatnio:ponad 6 lat
  • Postów:107
0

Witajcie :)

Napisałem drobną bibliotekę dll, która ma za zadanie malować po canvasie komponentu Paintbox w głównej formie w pliku EXE.
W trakcie działania programu jest wszystko ok, ale po wyjściu dostaję dwa błędy Acces Violation.

Kod w DLL:

Kopiuj
library Project1;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses ShareMem, Windows, ExtCtrls, Graphics;

{$R *.res}


procedure Paint(Pb: TPaintbox); stdcall;
begin
  Pb.Canvas.Pen.Color := ClGreen;
  Pb.Canvas.Rectangle(Pb.ClientRect);
end;

exports
  Paint name 'Paint';

begin
end.

wywołanie w exe: (ShareMem jest pierwszą biblioteką w kodzie projektu (Project - View source))

Kopiuj
procedure Pnt(Pb:TPaintbox); stdcall external 'Project1.dll' name 'Paint';

(...)

Pnt(Paintbox1);

Próbowałem również przekazać obiekt przez referencję dopisując słówko var przed Pb:TPaintbox;.
Zauważyłem, że problem pojawia się wówczas, gdy próbuję edytować właściwości canvasu paintboxa np

Kopiuj
Pb.Canvas.Pen.Color := ...;
Pb.Canvas.Font.Color := ...;

Wywołanie samej metody Rectangle nie powoduje błędów.

Próbowałem również bawić się wskaźnikami, pointerami czy nawet przekazywać całą formę do dll i korzystać z FindComponent, lecz albo w ogóle procedura nic nie rysowała, albo rzucało z nowu wyjątkami.

Wpadłem na pomysł również, by malować na bitmapie stworzonej w dll a potem do exe przekazywać tą bitmapę, ale chciałbym uniknąć tego rozwiązania.

Jak będzie potrzeba to dodam również kod "sztuczek" które próbowałem.

Proszę o pomoc i wskazówki.

Pozdrawiam.

_13th_Dragon
  • Rejestracja:ponad 19 lat
  • Ostatnio:3 dni
0

Nie jest to wina DLL. Pewnie wywołujesz to w jakimś osobnym wątku.


Wykonuję programy na zamówienie, pisać na Priv.
Asm/C/C++/Pascal/Delphi/Java/C#/PHP/JS oraz inne języki.
olesio
  • Rejestracja:około 17 lat
  • Ostatnio:około 3 lata
  • Lokalizacja:Szczecin
  • Postów:4191
1

Od kiedyś nauczyłem się eksperymentując takim kodem DLL jak poniżej. Że należy w taki sposób tworzyć komponenty VCL w DLLce. A nie inaczej. Także może przy odwoływaniu się też trzeba odwołać się do Parenta coś w ten deseń. O ile też nie jest tak jak pisze poprzednik.

Kopiuj
library Project2;

uses
  Windows, Controls, Forms, StdCtrls, Graphics;

{$R *.res}

procedure TworzGroupBox(Komponent_Rodzic: TForm; Handle: HWND);
var
  GroupBox1 : TGroupBox;
begin
  with Komponent_Rodzic do
  begin
    GroupBox1 := TGroupBox.Create(Komponent_Rodzic);
    GroupBox1.ParentWindow := Handle;
    GroupBox1.Color := clBtnFace;
    GroupBox1.Name := 'Grp';
    GroupBox1.Caption := 'Test';
  end;
end;

exports
  TworzGroupBox;

begin
end.

Pozdrawiam.
_13th_Dragon
Przecież on nie tworzy kontrolki w DLL tylko rysuje po niej.
olesio
Zgadza się. Przecież widzę co czytam. Napisałem, że w ten deseń, a nie że ma tworzyć kontrolkę. Bo czy nie powinien odwoływać się też do parenta i poprzez with dopiero coś kombinować z przekazanym parametrem?
olesio
  • Rejestracja:około 17 lat
  • Ostatnio:około 3 lata
  • Lokalizacja:Szczecin
  • Postów:4191
1

Upewniłem się. Taki kod jak poniżej. A nawet i bez odwołania do rodzica i bez stdcall też działa. Jednak po zamknięciu programu sypie wyjątkiem av. Dlatego trzeba było by to dopracować. A i rysowanie akurat po PaintBoxie przez dllkę jest i tak trochę przekombinowane. Bo taka dllka nie jest uniwersalna poza Delphi raczej. Jak już tworzył bym dllką i cała kontrolkę na oknie o wskazanym uchwycie. Może wtedy i dalo by się uniknąć jakichś av, które mi się zdarzyły. A w które się nie zagłębiałem. Ja tam nie preferuję opasłych tymbardziej dllek. Wyrzeźbił bym to pod WinAPI i wykorzystywał pobrany HDC na podstawie HWND kontrolki. Niestety z HDC też jest i problem. Trzeba wszystko zwracać z powrotem, a i tak dochodzi do niewyjaśnionych zamazan grafiki, o czym przekonałem się w swoim pluginie wLX do odtwarzania modułów muzycznych dla Total Commandera. Nie pomogły modyfikacja dokonane przez Użytkownika @kAzek, który stwierdził pod GDIView, że wycieków być nie powinno, ale i tak są błędy. Wystarczy odtworzyć pod pluginem kilka tysięcy plików po sobie przez sekundę. Póki co projekt wisi w wersji 0.3 pod VCL, a ja głowię się w wolnym czasie jak to dopracować. Ale nie offtopicując, czasami lepiej spróbować wyrzeźbić pewne rzeczy pod WinAPI. Wiem, że obsługa Canvasa jest prostsza, a przynajmniej taka się może wydawać. Ale i typy HDC, HBRUSH czy HPEN po ogarnięciu dokumentacji na MSDN czy przykładów na necie, nie będą aż takie straszne.

Kopiuj
procedure CzaryMary(KomponentRodzic : TForm; PntBox : TPaintBox); stdcall;
begin
  with KomponentRodzic do
  begin
    PntBox.Canvas.Brush.Color := clRed;
    PntBox.Canvas.FillRect(PntBox.ClientRect);
  end;
end;

Pozdrawiam.
KA
  • Rejestracja:prawie 20 lat
  • Ostatnio:3 minuty
  • Lokalizacja:Gorlice
3

Przywróć stare właściwości czyli:

Kopiuj
procedure Paint(PB: TPaintBox); stdcall;
var
  OldColor: TColor;
begin
  OldColor:= Pb.Canvas.Pen.Color;
  Pb.Canvas.Pen.Color:= ClGreen;
  Pb.Canvas.Rectangle(Pb.ClientRect);
  Pb.Canvas.Pen.Color:= OldColor;
end;

Nie odpowiadam na PW w sprawie pomocy programistycznej.
Pytania zadawaj na forum, bo:
od tego ono jest ;) | celowo nie zawracasz gitary | przeczyta to więcej osób a więc większe szanse że ktoś pomoże.
_13th_Dragon
No rzesz :) Musi być możliwość dodania kilku plusów naraz.
SZ
  • Rejestracja:ponad 16 lat
  • Ostatnio:ponad 6 lat
  • Postów:107
0

Co do Twojego kodu Olesio, niestety jest bez zmian.
Sposób zaprezentowany przez kAzek jest dobry, ale już taki kod:

Kopiuj
 
var
  OldColor: TColor;
  OldColor2: TColor;
begin
  OldColor:= Pb.Canvas.Pen.Color;
  OldColor2:= Pb.Canvas.Brush.Color;
  Pb.Canvas.Pen.Color:= ClGreen;
  Pb.Canvas.Brush.Color := ClRed;
  Pb.Canvas.Rectangle(Pb.ClientRect);
  Pb.Canvas.Pen.Color:= OldColor;
  Pb.Canvas.Brsuh.Color := OldColor2;
end;

powoduje te same błędy.
Co do postu 13th_Dragon to żadnych wątków nie mam utworzonych.

Problem uważam nadal za otwarty. Jutro wieczorem pokombinuje jeszcze trochę z propozycją Olesio, gdyż dzisiaj nie dam rady już dokładnie wszystkiego przetestować.
Dziękuję wszystkim za udzielone posty.

Pozdrawiam.

abrakadaber
abrakadaber
  • Rejestracja:ponad 12 lat
  • Ostatnio:8 miesięcy
  • Postów:6610
1

do dllki należy przekazać HDC płótna paintboxa i po nim mazać a nie przekazywać całego paintboxa.


Chcesz pomocy - pokaż kod - abrakadabra źle działa z techniką.
KA
  • Rejestracja:prawie 20 lat
  • Ostatnio:3 minuty
  • Lokalizacja:Gorlice
2

A taki dziwny twór działa nawet nie próbuję wnikać dlaczego:

Kopiuj
procedure Paint(PB: TPaintBox); stdcall;
var
  TempPB: TPaintBox;
begin
  TempPB:= TPaintBox.Create(nil);
  try
  TempPB.Width:= PB.Width;
  TempPB.Height:= PB.Height;
  TempPB.Canvas.Handle:= PB.Canvas.Handle;
  TempPB.Canvas.Pen.Color:= ClGreen;
  TempPB.Canvas.Brush.Color:= ClRed;
  TempPB.Canvas.Rectangle(TempPB.ClientRect);
  TempPB.Canvas.Font.Size:= Random(30) + 10;
  TempPB.Canvas.Font.Color:= clBlue;
  TempPB.Canvas.TextOut(Random(100), Random(100), 'Test');
  finally
  TempPB.Free;
  end;
end;

Nie odpowiadam na PW w sprawie pomocy programistycznej.
Pytania zadawaj na forum, bo:
od tego ono jest ;) | celowo nie zawracasz gitary | przeczyta to więcej osób a więc większe szanse że ktoś pomoże.
SZ
  • Rejestracja:ponad 16 lat
  • Ostatnio:ponad 6 lat
  • Postów:107
0

za wskazówką użytkownika **abrakadaber ** skleiłem następujący kod:

Kopiuj
procedure Paint(H: HDC); stdcall;
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := H;
    Canvas.Pen.Color := ClGreen;
    Canvas.Brush.Color := ClRed;
    Canvas.Rectangle(0, 0, 200, 200);
    Canvas.Font.Size := Random(20) + 10;
    Canvas.Font.Color := clBlue;
    Canvas.TextOut(Random(100), Random(100), 'Test');
  finally
    Canvas.Free;
  end;
end;

Czy o to dokładnie chodziło? Kod działa pięknie, nie wywala av.

Zaklepałem odpowiedź jako rozwiązanie problemu, niektórzy podostawali plusy.
Jeżeli ktoś wpadnie na jakieś inne rozwiązanie, będzie miał inną propozycję to proszę śmiało pisać, gdyż na pewno wezmę ją pod uwagę i w ostatecznej wersji zastosuje to co mi bardziej podejdzie.

Jak pojawią się jakieś problemy, to będę pisał jeszcze w tym temacie.

Pozdrawiam i dziękuję wszystkim udzielającym się za odpowiedzi.

abrakadaber
abrakadaber
  • Rejestracja:ponad 12 lat
  • Ostatnio:8 miesięcy
  • Postów:6610
0

przed przypisaniem hdc do płótna powinieneś "stare" gdzieś zapamiętać i przywrócić je przed zwolnieniem płótna


Chcesz pomocy - pokaż kod - abrakadabra źle działa z techniką.
KA
  • Rejestracja:prawie 20 lat
  • Ostatnio:3 minuty
  • Lokalizacja:Gorlice
0

@abrakadaber łatwo powiedzieć zapamiętać tylko jak bo:

Kopiuj
procedure Paint(H: HDC); stdcall;
var
  Canvas: TCanvas;
  OldH: HDC;
begin
  Canvas := TCanvas.Create;
  try
    OldH:= Canvas.Handle; //<-- wystarczy ta linia nawet bez przywracania i mamy wyjątek Canvas does not allow drawing
    Canvas.Handle := H;
    Canvas.Pen.Color := ClGreen;
    Canvas.Brush.Color := ClRed;
    Canvas.Rectangle(0, 0, 200, 200);
    Canvas.Font.Size := Random(20) + 10;
    Canvas.Font.Color := clBlue;
    Canvas.TextOut(Random(100), Random(100), 'Test');
    Canvas.Handle:= OldH;
  finally
    Canvas.Free;
  end;
end;

powoduje błąd "Canvas does not allow drawing" nie potrafię wyjaśnić dlaczego po prostu ten cały Canvas jest dziwny i trzeba by przeglądnąć źródła aby ogarnąć niektóre jego zachowania.
Sprawdzałem GDIView http://www.nirsoft.net/utils/gdi_handles.html i niby wycieku zasobów nie ma nawet bez tego przywracania więc chyba jest w porządku. Jeżeli nie zwolnię tego utworzonego Canvas wtedy program pokazuje wyciek.

EDIT//
Pomyślałem chwilę przy kawie i zatrybiłem, że taki świeżo upieczony Canvas raczej nie ma uchwytu DC bo niby czego jak nie jest przypisany do żadnego okna czyli na pewno nie trzeba nic zapamiętywać i i przywracać.
Dlaczego taki wyjątek to nie wiem niby nie próbuję nic rysować a tylko pobrać HDC . Wg mnie przy tym wyjątku nie powinno być co najwyżej zwrócić 0 ale VCL już tak ma że jak coś nie pójdzie rzuca wyjątkami a ten pewnie jest "domyślny".


Nie odpowiadam na PW w sprawie pomocy programistycznej.
Pytania zadawaj na forum, bo:
od tego ono jest ;) | celowo nie zawracasz gitary | przeczyta to więcej osób a więc większe szanse że ktoś pomoże.
edytowany 2x, ostatnio: kAzek

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.