Текущий архив: 2006.04.02;
Скачать: CL | DM;

Вниз

TBitmap в kol + asm   Найти похожие ветки 

← →
UFO   (2005-08-14 22:58) [0]

Часть 1.
Нужно вызвать из асемблерной вставки TBitMap.SetHandle. В дебагере паскальной версии прямо так и пишится, но при компиляции выдает, что нет у битмапа такого метода, что в принцепе не удевительно т.к. он Protected. Выхода собственно 2
1) модифицировать KOL.pas, переместив процедуру SetHandle в секцию Public.
2) Создать наследника :

...
interface

   TBitmapmod = object( TBitMap )
   protected
   public
       procedure SetHandle(const Value: HBitmap);
   end;

implementation

procedure TBitMapMod.SetHandle;
begin
inherited SetHandle( Value);
end;

...



Может кто знает как без такого рода извращений все-таки присвоить Handle из ассемблера (Вызов функции SetHandle обязателен, явно или нет).

Часть 2.
Это касается работы с интерфейсами. Помнится в MASM можно вызывать методы так:

call (IPicture PTR[edx]).get_Handle


Может и в Delphi есть аналог, а то не очень красиво получается:

call dword ptr [edx+$0c]


---

← →
thaddy   (2005-08-15 01:30) [1]

If you study kol.pas, you will see you can obtain the same elegance ;)
And there is no need to make it public, you can simply cast it through this:
PHackedBitmap = ^THackedBitmap;
THackedBitmap = object(Tbitmap)
end;

PHackedBitam(Mybitmap).sethandle....

---

← →
UFO   (2005-08-15 22:25) [2]

many thanks, thaddy

Если кому интересно, то все эти заморочки были нужны для модуля загрузки картинок JPG GIF и BMP без встроенного в программу декодера, а через интерфейс IPicture из OLE. Вот листинг ...

unit KolOlePicture;

interface

uses Windows, Kol, ActiveX;

type
   PBitMapmod = ^TBitMapmod;
   TBitmapmod = object( TBitMap )
   protected
       fPicta: IPicture;
       destructor Destroy; {-}virtual;{+}{++}(*override;*){--}
   end;

function SHCreateStreamOnFileA (FileName: PChar; grfMode: DWORD;var stream: IStream):HResult; stdcall;
procedure KOLNewOLEBitMap(var BitMap: PBitMap;FileName:String);

implementation

function SHCreateStreamOnFileA;         external "shlwapi.dll" name "SHCreateStreamOnFileA";

destructor TBitmapmod.Destroy;
begin
   if fPicta<>nil then
       fPicta._Release;
   inherited;
end;

procedure DummyDetachCanvas( Sender: PBitmap );
begin
end;

procedure KOLNewOLEBitMap;
var     Stream: IStream;
       Picta: IPicture;
       hh: THandle;
const IID_IPicture:TGUID="{7BF80980-BF32-101A-8BBB-00AA00300CAB}";

   Function _NewBitMapmod ( Picta:Pointer ):PBitmapmod;
   begin
       New (Result, Create);
       Result.fDetachCanvas := DummyDetachCanvas;
       Result.fPicta := IPicture(Picta);
   end;
asm
   //[ebx] = PBitmap;
   //edi = FileName;
   push ebx
   push edi
   mov ebx, eax
   mov edi, edx
   //BitMap := nil;
   xor eax, eax
   mov [ebx], eax
   //SHCreateStreamOnFileA(PChar(FileName), 0, Stream);
   lea eax, [Stream]
       push eax
       push $00
       push edi //FileName
       call SHCreateStreamOnFileA
   //if Stream=nil then exit;
   cmp Dword ptr [Stream], $00
   jz @@EXIT
   //OleLoadPicture(Stream, FileSize(FileName), false, IID_IPicture, Picta);
   lea eax, [Picta]
       push eax
       push offset IID_IPicture
       push $00
   mov eax, edi //FileName
   call KOL.FileSize
       push eax
   mov eax, [Stream]
       push eax
       call ActiveX.OleLoadPicture
   //if Picta = nil then exit;
   cmp Dword ptr [Picta], $00
   jz @@EXIT
   //Picta.get_Handle(hh);
   lea eax, [hh]
       push eax
   mov edx, [Picta]
       push edx
   mov eax, [edx]
       call dword ptr [eax+$0c]
   //BitMap := _NewBitMapmod(Picta);
   mov eax, [Picta]
   call _NewBitMapmod
   mov [ebx], eax
   //BitMap.Handle := hh;
   mov edx, [hh]
   call TBitMapMod.SetHandle

@@EXIT:
   lea eax, [Stream]
   call System.@IntFClear
   lea eax, [Picta]
   call System.@IntFClear

   pop edi
   pop ebx
end;

end.


А более глобальная цель - написание пакетного ресайзере для картинок. Удевительно, сколько всего можно засунуть в 23 кило...

<a href="http://www.homm86.narod.ru/ets_src.zip" >ets_src.zip</a>

---

← →
thaddy   (2005-08-16 01:17) [3]

;) Good code!

---

Страницы: 1 вся ветка

Текущий архив: 2006.04.02;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.043 c