Код:
unit unitDarkOrbitMiniMapDrawer;
interface
uses
Types, Classes, SysUtils,Graphics, ExtCtrls, unitDarkOrbitClient,
unitDarkOrbitClientConsts,unitDarkOrbitClientTypes, ResImages;
type
TDarkOrbitMiniMap = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure ImgUP;
public
FMapImages: TResImages;
FMapW,
FMapH: Integer;
FWork: TBitmap;
fx,fy: Word;
Client: TDarkOrbitClient;
Image: TImage;
constructor Create;
destructor Destroy; override;
function ScaledRect(aX, aY, aW, aH: Cardinal; fX,fY: Word): TRect;
end;
implementation
uses formmain;
function TDarkOrbitMiniMap.ScaledRect(aX, aY, aW, aH: Cardinal; fX,fY: Word): TRect;
begin
Result:=Rect(
Round(aX / fX),
Round(aY / fY),
Round((aX+aW) / fX),
Round((aY+aH) / fY)
)
end;
constructor TDarkOrbitMiniMap.Create;
begin
inherited Create(True);
FWork:=TBitmap.Create;
FMapImages:=TResImages.Create;
FMapImages.Load(ExtractFilePath(ParamStr(0))+'images.xdb');
FMapW:=420;
FMapH:=270;
fx:=50;
fy:=50;
end;
destructor TDarkOrbitMiniMap.Destroy;
begin
FWork.Free;
FMapImages.Free;
inherited;
end;
procedure TDarkOrbitMiniMap.Execute;
var
map, station: Word;
data: TDarkOrbitClientData;
changed: Boolean;
begin
FWork.Width:=FMapW;
FWork.Height:=FMapH;
map:=0;
station:=0;
while Terminated = False do
with Client do
begin
if Flag(DOC_Connected) = True then
begin
changed:=False;
data:=ClientData;
if data.MapInfo.id<>map then changed:=True;
if data.StationInfo.id<>station then changed:=True;
if changed = True then
begin
Form1.ThreadsLog('Требуется перерисовка фона');
if Flag(DOC_Map) = True then
begin
map:=data.MapInfo.id;
FWork.Canvas.StretchDraw(Rect(0,0,FMapW,FMapH),FMapImages.ImageByID['map'+IntToStr(map)]);
Form1.ThreadsLog('Нарисовал фон');
end;
if Flag(DOC_Station) = True then
begin
station:=data.StationInfo.id;
FWork.Canvas.StretchDraw(ScaledRect(data.StationInfo.right-2000,data.StationInfo.top-2000, 4000, 4000, fx, fy),FMapImages.ImageByID['station'+IntToStr(station)]);
Form1.ThreadsLog('Нарисовал карту');
end;
//$D8D8D8
FWork.Canvas.Brush.Color:=clLime;
FWork.Canvas.FrameRect(Rect(0,0,FMapW,FMapH));
FWork.Canvas.FrameRect(Rect(1,1,FMapW-1,FMapH-1));
end;
Synchronize(ImgUp);
end;
Sleep(100);
end;
end;
procedure TDarkOrbitMiniMap.ImgUP;
begin
Image.Picture.Bitmap.Canvas.Draw(0,0,FWork);
Image.Invalidate;
end;
end.
Подскажите пожалуйста, что не так в этом потоке со стороны графики? Немного поработав он вылетает вот с этим (исходя из информации EurekaLog)
Код:
; Graphics.GDIError (Line=0 - Offset=0)
; -------------------------------------
004CAAB0 test esp, edi
004CAAB2 std
004CAAB3 DB $FF, $FF //
004CAAB5 lea edx, [ebp+$FFFFFE00]
004CAABB mov ecx, $00000100 ; ''...
004CAAC0 call doClientLogin.System._UStrFromWArray
004CAAC5 mov ecx, [ebp+$FFFFFDFC]
004CAACB mov dl, $01
004CAACD mov eax, dword ptr [Classes.Classes]
004CAAD2 call SysUtils.Exception.Create
004CAAD7 call doClientLogin.System._RaiseExcept ; <-- EXCEPTION
004CAADC jmp Graphics.GDIError
004CAADE call Graphics.OutOfResources
004CAAE3 xor eax, eax
004CAAE5 pop edx
004CAAE6 pop ecx
004CAAE7 pop ecx
004CAAE8 mov fs:[eax], edx
004CAAEB push $004CAB03 ; '[‹е]ГS‹Ш…Ыu.иLяяя‹Г[ГU‹мѓДМSVW‹т'...
004CAAF0 lea eax, [ebp+$FFFFFDFC]
004CAAF6 call doClientLogin.System._UStrClr
Для отрисовки используется самодельное хранилище графики, успешно используемое в другом проекте, просто подключил модуль и заюзал как говориться. Для отрисовки maps используются изображения 2100х1350. Для отрисовки station используются картинки 2000х2000.
Судя по логам, да и заведомо верным и синхронизированным данным карта и станция рисуются всего 1 раз, но ресурсы текут.
Что не верно? Сегодня весь день ушел в поисках решения... Пробовал и с потоками и без...
P.S.
Нормальной работы я достигал только в потоках, идеальную не утекающую картинку к сожалению получил только 1 раз, обрадоваться успел(