В добавок !
Все таки стало интересно и решила проверить господина Козлова.
Как говороит один мой знакомый молотком можно не только забить гвоздь но и ....
(не буду продолжать)
-----------------------
"НЕРЕШАЕМАЯ ЗАДАЧА" - многопотоковый модуль работающий с библиотекой "mapacces.dll" (из состава ГИС Панорама)
который должен отображать участок карты на разные КЕНВЕС-ы
----------------
РЕЗУЛЬТАТ НИЖЕ(код - правда на Паскале, Си недолюбливаю):
если интересует рабочий модуль (скинь свои координаты мне на мыло uuof@mail.ru)
перекину КОД и ЕХЕ
PS: (программа запускается любое количество раз, в ней по 3-потока.ВРОДЕ ПРОБЛЕМ НЕТ, и exception-ов тоже)
КОД:
____________________________________________________________
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
// КЛАСС: стандартный поток Винды (Мой потомок)
//
TMyThread = class(TThread)
protected
IsDraw : boolean;
public
FDC : Cardinal;
ViewMap : boolean;
FMap : integer;
sName : string;
procedure Execute; override;
end;
// КЛАСС: стандартная форма
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton; // кнопка "Создать 3 потока"
Button2: TButton; // кнопка "Активировать прорисовку в потоках"
p1: TPanel; // будем использовать панель 1 как Кенвес для потока 1
p3: TPanel; // будем использовать панель 2 как Кенвес для потока 2
p2: TPanel; // будем использовать панель 3 как Кенвес для потока 3
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Threads : array[0..2]of TMyThread;
public
FMap : integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// ОПИСЫВАЕМ САМЫЕ НЕОБХОДИМЫЕ ФУНКЦИИ mapacces.dll ДЛЯ ПРИМЕРА
function mapOpenMap(Map: Pchar; mode: integer): integer; stdcall;
external 'mapacces.dll' name 'mapOpenMap';
procedure mapCloseMap(Map: integer); stdcall;
external 'mapacces.dll' name 'mapCloseMap';
// ... И ФУНКЦИЯ - "ПАРАЗИТ", КОТОРАЯ НЕ РИСУЕТ В НЕСКОЛЬКИХ ПОТОКАХ
procedure mapPaint95(Map: integer; DC : HDC;Erase:integer;var R : TRect); stdcall;
external 'mapacces.dll' name 'mapPaint95';
{ TMyThread }
// Запуск потока
procedure TMyThread.Execute;
var R : TRect;
begin
inherited FreeOnTerminate := TRUE;
FillChar(R,SizeOf(TRect),0);
R.Top :=100;
R.Left :=100;
R.Right :=300;
R.Bottom :=300;
try
while (not Terminated) do
try
// если еще не нарисовано И активировано -"НАРИСОВАТЬ" то:
if not IsDraw and ViewMap then
begin
// Рисуем по законам описанными в mapapi.h
SetViewportOrgEx(FDC,0,0,nil);
mapPaint95(FMap,FDC,1,R);
// устанавливаем флажек НАРИСОВАНО
IsDraw:=true;
end;
except
Terminate;
end;
finally
Terminate;
end;
end;
// КЛИК - зоздаються 3 потока
procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
Threads[i]:=TMyThread.Create(true);
Threads[i].sName := 'THREAD:'+IntToStr(i+1);
Threads[i].FMap := FMap;
Threads[i].ViewMap := false;
Threads[i].IsDraw := false;
end;
Threads[0].FDC:=GetDC(P1.Handle);
Threads[1].FDC:=GetDC(P2.Handle);
Threads[2].FDC:=GetDC(P3.Handle);
for i:=0 to 2 do
Threads[i].Resume;
Button1.Enabled:=false;
end;
// активация приложения (создание Формы)
procedure TForm1.FormCreate(Sender: TObject);
begin
// открываем карту
FMap:=mapOpenMap('C:\Panorama10\Data\Podolsk\PODOLSK.MAP', GENERIC_READ);
end;
// деактивация (разрушение) формы
procedure TForm1.FormDestroy(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
if Assigned(Threads[i]) then
Threads[i].terminate;
end;
ReleaseDC(P1.Handle,Threads[0].FDC); // каждому потоку вешается свой индивидуальный Кенвес
ReleaseDC(P2.Handle,Threads[1].FDC); // каждому потоку вешается свой индивидуальный Кенвес
ReleaseDC(P3.Handle,Threads[2].FDC); // каждому потоку вешается свой индивидуальный Кенвес
mapCloseMap(FMap);
end;
// клик другой кнопкой - выставляем флажки нарисавть карту на прикрепленный к потоку Кенвес
//
procedure TForm1.Button2Click(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
Threads[i].ViewMap:=true;
Sleep(1000); // обязательно должно успеть отработать !
end;
end;
end.
_______________________________
В директории с ЕХЕ-шником должны находиться:
mapacces.dll и CW3230.DLL
Все таки стало интересно и решила проверить господина Козлова.
Как говороит один мой знакомый молотком можно не только забить гвоздь но и ....
(не буду продолжать)
-----------------------
"НЕРЕШАЕМАЯ ЗАДАЧА" - многопотоковый модуль работающий с библиотекой "mapacces.dll" (из состава ГИС Панорама)
который должен отображать участок карты на разные КЕНВЕС-ы
----------------
РЕЗУЛЬТАТ НИЖЕ(код - правда на Паскале, Си недолюбливаю):
если интересует рабочий модуль (скинь свои координаты мне на мыло uuof@mail.ru)
перекину КОД и ЕХЕ
PS: (программа запускается любое количество раз, в ней по 3-потока.ВРОДЕ ПРОБЛЕМ НЕТ, и exception-ов тоже)
КОД:
____________________________________________________________
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
// КЛАСС: стандартный поток Винды (Мой потомок)
//
TMyThread = class(TThread)
protected
IsDraw : boolean;
public
FDC : Cardinal;
ViewMap : boolean;
FMap : integer;
sName : string;
procedure Execute; override;
end;
// КЛАСС: стандартная форма
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton; // кнопка "Создать 3 потока"
Button2: TButton; // кнопка "Активировать прорисовку в потоках"
p1: TPanel; // будем использовать панель 1 как Кенвес для потока 1
p3: TPanel; // будем использовать панель 2 как Кенвес для потока 2
p2: TPanel; // будем использовать панель 3 как Кенвес для потока 3
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Threads : array[0..2]of TMyThread;
public
FMap : integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// ОПИСЫВАЕМ САМЫЕ НЕОБХОДИМЫЕ ФУНКЦИИ mapacces.dll ДЛЯ ПРИМЕРА
function mapOpenMap(Map: Pchar; mode: integer): integer; stdcall;
external 'mapacces.dll' name 'mapOpenMap';
procedure mapCloseMap(Map: integer); stdcall;
external 'mapacces.dll' name 'mapCloseMap';
// ... И ФУНКЦИЯ - "ПАРАЗИТ", КОТОРАЯ НЕ РИСУЕТ В НЕСКОЛЬКИХ ПОТОКАХ
procedure mapPaint95(Map: integer; DC : HDC;Erase:integer;var R : TRect); stdcall;
external 'mapacces.dll' name 'mapPaint95';
{ TMyThread }
// Запуск потока
procedure TMyThread.Execute;
var R : TRect;
begin
inherited FreeOnTerminate := TRUE;
FillChar(R,SizeOf(TRect),0);
R.Top :=100;
R.Left :=100;
R.Right :=300;
R.Bottom :=300;
try
while (not Terminated) do
try
// если еще не нарисовано И активировано -"НАРИСОВАТЬ" то:
if not IsDraw and ViewMap then
begin
// Рисуем по законам описанными в mapapi.h
SetViewportOrgEx(FDC,0,0,nil);
mapPaint95(FMap,FDC,1,R);
// устанавливаем флажек НАРИСОВАНО
IsDraw:=true;
end;
except
Terminate;
end;
finally
Terminate;
end;
end;
// КЛИК - зоздаються 3 потока
procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
Threads[i]:=TMyThread.Create(true);
Threads[i].sName := 'THREAD:'+IntToStr(i+1);
Threads[i].FMap := FMap;
Threads[i].ViewMap := false;
Threads[i].IsDraw := false;
end;
Threads[0].FDC:=GetDC(P1.Handle);
Threads[1].FDC:=GetDC(P2.Handle);
Threads[2].FDC:=GetDC(P3.Handle);
for i:=0 to 2 do
Threads[i].Resume;
Button1.Enabled:=false;
end;
// активация приложения (создание Формы)
procedure TForm1.FormCreate(Sender: TObject);
begin
// открываем карту
FMap:=mapOpenMap('C:\Panorama10\Data\Podolsk\PODOLSK.MAP', GENERIC_READ);
end;
// деактивация (разрушение) формы
procedure TForm1.FormDestroy(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
if Assigned(Threads[i]) then
Threads[i].terminate;
end;
ReleaseDC(P1.Handle,Threads[0].FDC); // каждому потоку вешается свой индивидуальный Кенвес
ReleaseDC(P2.Handle,Threads[1].FDC); // каждому потоку вешается свой индивидуальный Кенвес
ReleaseDC(P3.Handle,Threads[2].FDC); // каждому потоку вешается свой индивидуальный Кенвес
mapCloseMap(FMap);
end;
// клик другой кнопкой - выставляем флажки нарисавть карту на прикрепленный к потоку Кенвес
//
procedure TForm1.Button2Click(Sender: TObject);
var i : integer;
begin
for i:=0 to 2 do
begin
Threads[i].ViewMap:=true;
Sleep(1000); // обязательно должно успеть отработать !
end;
end;
end.
_______________________________
В директории с ЕХЕ-шником должны находиться:
mapacces.dll и CW3230.DLL
Изменено: - 18.11.2015 15:21:35