Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме 15-35 тыс рублей в месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.01.2011, 22:47   #1
STRELOK-2007
Форумчанин
 
Регистрация: 06.08.2009
Сообщений: 144
Вопрос Отрисовка изображения в потоке

Код:
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 раз, обрадоваться успел(
STRELOK-2007 вне форума Ответить с цитированием
Ответ
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
отрисовка updown edik Компоненты Delphi 0 27.12.2009 12:39
отрисовка локации Juffin Общие вопросы Delphi 4 21.04.2009 13:26
Отрисовка компонентов Dr.Badnezz Компоненты Delphi 1 04.01.2009 16:50
Отрисовка CheckListBox. NikLik Компоненты Delphi 0 21.09.2008 20:58
Чтение изображения из базы данных, Вместо изображения - "System.Byte[]" ruelCrow Общие вопросы .NET 3 10.07.2008 22:29