Вот так работает
Add(MainForm,11367671,91,147)
{
Left=20
Top=105
Width=459
Height=281
Ctl3D=0
Caption="Reader -- BMP, GIF, JPEG, ICO, WMF, EMF, PNG, XBM, ICO, TIFF"
BorderStyle=4
Position=1
}
Add(Button,12242450,91,105)
{
Left=195
Top=225
Width=70
Height=25
TabOrder=-1
Caption="Load Files"
link(onClick,13268199:doEvent1,[])
}
Add(StrList,5123957,252,126)
{
}
Add(Image,9768314,595,133)
{
@Hint=#1:1|
Left=10
Top=10
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(InlineCode,5016436,413,196)
{
WorkPoints=#6:doLoad|
EventPoints=#6:onLoad|
DataPoints=#5:Width|6:Height|
Code=#15:unit HiAsmUnit;|0:|9:interface|0:|47:uses Share,Debug,Windows,ActiveX,KOLComObj,KOL;|0:|5:const|0:|29: IMGCHG_SIZE = $0001;|29: IMGCHG_VIEW = $0002;|29: IMGCHG_COMPLETE = $0004;|29: IMGCHG_ANIMATE = $0008;|29: IMGCHG_MASK = $000F;|0:|33: IMGLOAD_NOTLOADED = $00100000;|33: IMGLOAD_LOADING = $00200000;|33: IMGLOAD_STOPPED = $00400000;|33: IMGLOAD_ERROR = $00800000;|33: IMGLOAD_COMPLETE = $01000000;|33: IMGLOAD_MASK = $01F00000;|0:|33: IMGBITS_NONE = $02000000;|33: IMGBITS_PARTIAL = $04000000;|33: IMGBITS_TOTAL = $08000000;|33: IMGBITS_MASK = $0E000000;|0:|33: IMGANIM_ANIMATED = $10000000;|33: IMGANIM_MASK = $10000000;|0:|33: IMGTRANS_OPAQUE = $20000000;|33: IMGTRANS_MASK = $20000000;|0:|33: DWN_COLORMODE = $0000003F;|33: DWN_DOWNLOADONLY = $00000040;|33: DWN_FORCEDITHER = $00000080;|33: DWN_RAWIMAGE = $00000100;|0:|4:type|0:|30: IImgCtx = interface(IUnknown)|46: ['{3050f3d7-98b5-11cf-bb82-00aa00bdce0b}']|38: // Initialization/Download methods|66: function Load(pszUrl:PWChar; dwFlags:DWORD): HResult; stdcall;|91: function SelectChanges(ulChgOn:DWORD; ulChgOff:DWORD; fSignal:DWORD): HResult; stdcall;|81: function SetCallback(pCallback:pointer; pUserData:pointer): HResult; stdcall;|42: function Disconnect: HResult; stdcall;|0:|17: // Query methods|93: function GetUpdateRects(prc:PRect; var prcImg:TRect; var pcrc:integer): HResult; stdcall;|102: function GetStateInfo(var pulState:DWORD; var pSize:TSize; fClearChanges:DWORD): HResult; stdcall;|62: function GetPalette(var phpal:HPalette): HResult; stdcall;|0:|24: // Rendering methods|67: function Draw(_hdc:HDC; var prcBounds:TRect): HResult; stdcall;|105: function Tile(_hdc:HDC; var pptBackOrg:TPoint; var prcClip:TRect; var psize:TSize): HResult; stdcall;|118: function StretchBlt(_hdc:HDC; dstX,dstY,dstXE,dstYE,srcX,srcY,srcXE,srcYE:integer; dwROP:DWORD): HResult; stdcall;|5: end;|0:|28: THiAsmClass = class(TDebug)|10: private|19: wsz : integer;|19: hsz : integer;|9: public|23: FImgCtx : IImgCtx;|23: hOK : THandle;|25: Width : THI_Event;|26: Height : THI_Event; |25: onLoad : THI_Event;|46: procedure doLoad(var dt:TData; idx:word);|5: end;|0:|14:implementation|0:|5:const|64: CLSID_IImgCtx:TGUID = '{3050f3d6-98b5-11cf-bb82-00aa00bdce0b}';|64: IID_IImgCtx:TGUID = '{3050f3d7-98b5-11cf-bb82-00aa00bdce0b}';|0:|73:function StringToWideString(const s: String; codePage: Word): WideString;|17:var l: integer;|5:begin|16: Result := '';|23: if s = '' then exit;|60: l := MultiByteToWideChar(CodePage, 0, @s[1], -1, nil, 0);|28: SetLength(Result, l - 1);|24: if l <= 1 then exit; |66: MultiByteToWideChar(CodePage, 0, @s[1], -1, @Result[1], l - 1);|27:end; { StringToWideString }|0:|0:|63:procedure MyCallback(pCtx:pointer; pUserData:pointer); stdcall;|23:var pCls:THiAsmClass;|17: stat:DWORD;|15: sz:TSize;|18: bmp:PBitmap;|5:begin|34: pCls := THiAsmClass(pUserData);|42: pCls.FImgCtx.GetStateInfo(stat, sz, 0);|72: if (sz.cx * 100) div sz.cy > (pCls.wsz * 100) div pCls.hsz then begin|75: bmp := NewDIBBitmap(pCls.wsz, (pCls.wsz * sz.cy) div sz.cx, pf32bit);|32: bmp.PixelFormat:= pf32bit;|124: pCls.FImgCtx.StretchBlt(bmp.Canvas.Handle, 0, 0, pCls.wsz, (pCls.wsz * sz.cy) div sz.cx, 0, 0, sz.cx, sz.cy, SRCCOPY);|17: end else begin|75: bmp := NewDIBBitmap((pCls.hsz * sz.cx) div sz.cy, pCls.hsz, pf32bit);|32: bmp.PixelFormat:= pf32bit;|124: pCls.FImgCtx.StretchBlt(bmp.Canvas.Handle, 0, 0, (pCls.hsz * sz.cx) div sz.cy, pCls.hsz, 0, 0, sz.cx, sz.cy, SRCCOPY);|7: end;|33: _hi_OnEvent(pCls.onLoad, bmp);|12: bmp.Free;|22: SetEvent(pCls.hOK);|4:end;|0:|29:procedure THiAsmClass.doLoad;|23:var wName:WideString;|16: s: string;|13: m:TMsg;|5:begin|43: hOK := CreateEvent(nil,false,false,nil);|32: wsz := ToIntegerEvent(Width);|35: hsz := ToIntegerEvent(Height); |41: if (wsz = 0) or (hsz = 0 ) then exit; |25: wName := ToString(dt);|21: s := ToString(dt);|34: if not FileExists(s) then exit;|36: wName := StringToWideString(s,3);|56: FImgCtx := CreateComObject(CLSID_IImgCtx) as IImgCtx;|34: FImgCtx.Load(PWChar(wName), 0);|51: FImgCtx.SetCallback(@MyCallback, pointer(Self));|46: FImgCtx.SelectChanges(IMGCHG_COMPLETE,0,1);|59: while WaitForSingleObject(hOK,0)<>WAIT_OBJECT_0 do begin|44: if not GetMessage(m,0,0,0) then break;|26: TranslateMessage(m);|25: DispatchMessage(m);|7: end;|20: CloseHandle(hOK);|4:end;|0:|14:initialization|21: CoInitialize(nil);|12:finalization|18: CoUninitialize;|0:|4:end.|
link(onLoad,3271382:doEvent,[])
link(Width,3405297:Value,[])
link(Height,15034556:Value,[])
}
Add(Memory,3405297,413,112)
{
Default=Integer(140)
}
Add(Memory,15034556,420,133)
{
Default=Integer(100)
}
Add(Image,10722084,595,217)
{
@Hint=#1:3|
Left=300
Top=10
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(ArrayEnum,3757719,266,189)
{
link(onItem,14385134:doEvent1,[])
link(Array,5123957:Array,[])
}
Add(Image,5295338,595,175)
{
@Hint=#1:2|
Left=155
Top=10
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(Image,14742910,595,343)
{
@Hint=#1:6|
Left=300
Top=115
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(Image,8735878,595,301)
{
@Hint=#1:5|
Left=155
Top=115
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(Image,4148320,595,259)
{
@Hint=#1:4|
Left=10
Top=115
Width=140
Height=100
Color=16777215
TabOrder=-1
ViewStyle=0
}
Add(IndexToChanel,3271382,483,196)
{
Count=6
Point(Index)
link(onEvent1,9768314:doLoad,[(555,202)(555,139)])
link(onEvent2,5295338:doLoad,[(555,209)(555,181)])
link(onEvent3,10722084:doLoad,[(555,216)(555,223)])
link(onEvent4,4148320:doLoad,[(555,223)(555,265)])
link(onEvent5,8735878:doLoad,[(555,230)(555,307)])
link(onEvent6,14742910:doLoad,[(555,237)(555,349)])
link(Index,9232864:Count,[])
}
Add(Hub,13268199,140,105)
{
OutCount=5
link(onEvent1,11978606:In,[])
link(onEvent2,9232864:doReset,[(462,118)(462,160)])
link(onEvent3,5123957:doClear,[(239,125)(239,139)])
link(onEvent4,6607378:doExecute,[])
link(onEvent5,3757719:doEnum,[(191,139)(191,195)])
}
Add(ODialog,6607378,196,126)
{
Filter="PNG, JPG files (*.png;*.jpg)|*.png;*.jpg|All files (*.*)|*.*"
StartDir=""
FileName=""
Select=1
link(onExecute,5123957:doAdd,[])
}
Add(Counter,9232864,483,140)
{
Min=-1
Max=6
Default=-1
}
Add(Hub,14385134,315,189)
{
link(onEvent1,9232864:doNext,[(415,195)(415,146)])
link(onEvent2,5016436:doLoad,[])
}
Add(Hub,5281720,483,252)
{
OutCount=6
link(onEvent1,9768314:doClear,[(555,258)(555,146)])
link(onEvent2,5295338:doClear,[(555,265)(555,188)])
link(onEvent3,10722084:doClear,[(555,272)(555,230)])
link(onEvent4,4148320:doClear,[(555,279)(555,272)])
link(onEvent5,8735878:doClear,[(555,286)(555,314)])
link(onEvent6,14742910:doClear,[(555,293)(555,356)])
}
Add(LineBreak,14109498,406,252)
{
Caption="Clear"
link(Out,5281720:doEvent1,[])
Primary=[11978606,-154,-147]
}
Теперь можно попытаться реализовать компонент ImageLoader для чтения из файлов большинства графических форматов
------------ Дoбавленo:
А случаем у этого Loader'a нет методов записи, но это вопрос уже к tsdime
------------ Дoбавленo:
Ха! А этот зоопарк в натуре отображает прозрачные PNG на любом контексте с рисунком.
Для дальнейшего решения необходимо знать, как отображать рисунок, сейчас он вписываетс в размер контекста с сохранением пропорций и что подать на выход. Я могу отрисовать на окне и выдать в поток Bitmap без изменения размера для дальнейшей обработки.
------------ Дoбавленo:
Еще вопрос
Кто может объяснить, почему ScreenShort снимает размер катинки на единицу меньше
#pas
// BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width-1,Bmp.Height-1,DC,0,0,SRCCOPY);
BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,DC,0,0,SRCCOPY);
Я работал со ScreenShort'ом и заметил, что при снятии образа, затем очистки изображения и повторного копирования в то же окно слева и снизу получаются темные линии, после исправления кода линии исчезли. Похоже на явную багу.
Вот пример для проверки. Какого там появляются две черные линии в исходном варианте при нажатии на кнопку
#sha
Add(MainForm,12493409,154,84)
{
Left=10
Top=10
Width=285
Height=317
Ctl3D=0
Position=1
}
Add(Image,5070384,224,84)
{
@Hint=#2:10|
Left=5
Top=5
Width=265
Height=205
Color=16777215
TabOrder=-1
Point(Handle)
}
Add(Button,5554210,154,140)
{
Left=110
Top=240
TabOrder=-1
link(onClick,12051042:doCapture,[])
}
Add(ScreenShort,12051042,231,140)
{
link(Handle,5070384:Handle,[])
link(onCapture,5070384:doLoad,[(275,146)(275,118)(212,118)(212,90)])
}