From 6f8da34b3327383854bf7184b5d1f4f389d7c9d4 Mon Sep 17 00:00:00 2001 From: dkolmck Date: Wed, 3 Dec 2014 10:59:01 +0000 Subject: [PATCH] * some fixes git-svn-id: https://svn.code.sf.net/p/kolmck/code@142 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07 --- Addons/mckCProgBar.pas | 2 +- Addons/mckRarInfoBar.pas | 2 +- Addons/mckRarProgBar.pas | 2 +- Addons/tinyJPGGIFBMP.pas | 141 ++++++++++++++++++++++++++++----------- 4 files changed, 104 insertions(+), 43 deletions(-) diff --git a/Addons/mckCProgBar.pas b/Addons/mckCProgBar.pas index 84efd6e..d098001 100644 --- a/Addons/mckCProgBar.pas +++ b/Addons/mckCProgBar.pas @@ -35,7 +35,6 @@ type procedure SetMax(M: integer); protected { Protected declarations } - procedure Paint; procedure WMPaint(var Msg: TMessage); message WM_PAINT; procedure WMSize (var Msg: TMessage); message WM_SIZE; procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW; @@ -45,6 +44,7 @@ type public { Public declarations } constructor Create(Owner: TComponent); override; + procedure Paint; override; published { Published declarations } property FColor: TColor read fFColor write SetFColor; diff --git a/Addons/mckRarInfoBar.pas b/Addons/mckRarInfoBar.pas index 62d619d..0429711 100644 --- a/Addons/mckRarInfoBar.pas +++ b/Addons/mckRarInfoBar.pas @@ -43,7 +43,6 @@ type procedure SetFilledSideColor2(C: TColor); protected { Protected declarations } - procedure Paint; procedure WMPaint(var Msg: TMessage); message WM_PAINT; procedure WMSize(var Msg: TMessage); message WM_SIZE; procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW; @@ -52,6 +51,7 @@ type public { Public declarations } constructor Create(Owner: TComponent); override; + procedure Paint; override; published { Published declarations } property Position: integer read FPosition write SetPos; diff --git a/Addons/mckRarProgBar.pas b/Addons/mckRarProgBar.pas index 38dab09..bc3e712 100644 --- a/Addons/mckRarProgBar.pas +++ b/Addons/mckRarProgBar.pas @@ -53,7 +53,6 @@ type procedure SetShadowColor(C: TColor); protected { Protected declarations } - procedure Paint; procedure WMPaint(var Msg: TMessage); message WM_PAINT; procedure WMSize(var Msg: TMessage); message WM_SIZE; procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW; @@ -62,6 +61,7 @@ type public { Public declarations } constructor Create(Owner: TComponent); override; + procedure Paint; override; published { Published declarations } property Position1: integer read FPosition1 write SetPos1; diff --git a/Addons/tinyJPGGIFBMP.pas b/Addons/tinyJPGGIFBMP.pas index 00109ce..a8f89c4 100644 --- a/Addons/tinyJPGGIFBMP.pas +++ b/Addons/tinyJPGGIFBMP.pas @@ -1,5 +1,4 @@ unit tinyJPGGIFBMP; - // file: tinyJPGGIFBMP.pas // file version: 0.35 // last modified: 05.01.06 @@ -7,44 +6,44 @@ unit tinyJPGGIFBMP; // author: Karpinskyj Alexandr aka homm // mailto: homm86@mail.ru // My humble Web-Page: http://www.homm86.narod.ru - - interface uses Windows, KOL, ActiveX; type - TBitmapmod = object( TBitMap ) + TBitmapmod = object(TBitMap) end; +const + IID_IPicture: TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}'; + procedure tinyLoadJPGGIFBMPFile(var TargetBitmap: PBitMap; FileName: String); procedure tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size: DWORD); procedure tinyLoadJPGGIFBMPResource(var TargetBitmap: PBitMap; Inst : HInst; ResName : PChar; ResType : PChar); +procedure tinyLoadJPGGIFBMPString(const s: String; out TargetBitmap: PBitMap); + + +function SHCreateStreamOnFileA(FileName: PChar; grfMode: DWORD; var stream: IStream): HResult; stdcall; external 'shlwapi.dll'; implementation -const - IID_IPicture:TGUID='{7BF80980-BF32-101A-8BBB-00AA00300CAB}'; - -function SHCreateStreamOnFileA(FileName: PChar; grfMode: DWORD;var stream: IStream): HResult; - external 'shlwapi.dll' name 'SHCreateStreamOnFileA'; - -procedure OleFree( Picta: IPicture ); +procedure OleFree(Picta: IPicture); {begin if Picta <> nil then Picta._Release;} asm - push eax - mov eax, esp - call System.@IntFClear - pop eax + push eax + mov eax, esp + call System.@IntFClear + pop eax end; procedure tinyLoadJPGGIFBMPFile(var TargetBitmap: PBitMap; FileName: String); -var Stream: IStream; - Picta: IPicture; - hh: THandle; +var + Stream: IStream; + Picta: IPicture; + hh: THandle; asm //[ebx] = PBitmap; //edi = FileName; @@ -109,34 +108,96 @@ asm end; procedure tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size: DWORD); -var Stream: IStream; - Picta: IPicture; - hh: THandle; +var + Stream: IStream; + Picta: IPicture; + hh: THandle; begin - TargetBitmap := nil; - if CreateStreamOnHGlobal(ptr, TRUE, Stream) <> S_OK then - exit; - if OleLoadPicture(Stream, Size, false, IID_IPicture, Picta) <> S_OK then - exit; + TargetBitmap := nil; + if CreateStreamOnHGlobal(ptr, TRUE, Stream) <> S_OK then + exit; + if OleLoadPicture(Stream, Size, false, IID_IPicture, Picta) <> S_OK then + exit; + Picta.get_Handle(hh); + Picta._AddRef; + TargetBitmap := NewBitmap(0, 0); + TargetBitmap.Handle := hh; + TargetBitmap.Add2AutoFreeEx(TObjectMethod(MakeMethod(Pointer(Picta), @OleFree))); +end; + +procedure tinyLoadJPGGIFBMPResource(var TargetBitmap: PBitMap; Inst : HInst; ResName : PChar; ResType : PChar); +var + G: Pointer; + Sz: DWORD; + Ptr: Pointer; + Resource: HRSRC; +begin + Resource := FindResource(Inst, ResName, ResType); + Sz := SizeofResource(Inst, Resource); + DWORD(G) := LoadResource(hinstance, Resource); + DWORD(Ptr) := LocalAlloc(GMEM_FIXED, Sz); + move(g^, Ptr^, Sz); + tinyLoadJPGGIFBMPMemory(TargetBitmap, DWORD(Ptr), Sz); +end; + +procedure tinyLoadJPGGIFBMPString(const s: String; out TargetBitmap: PBitMap); +var + hh: DWORD; + hPtr: DWORD; + len: Integer; + Stream: IStream; + Picta: IPicture; +begin + TargetBitmap := nil; + // global + len := Length(s); + if (len > 0) then begin + hPtr := GlobalAlloc(GPTR, len); + if (hPtr <> 0) then begin + CopyMemory(Pointer(hPtr), @s[1], len); + // create istream + if (CreateStreamOnHGlobal(hPtr, False, Stream) = S_OK) then begin + // oleload + if (OleLoadPicture(Stream, len, False, IID_IPicture, Picta) = S_OK) then begin + Picta.get_Handle(hh); + Picta._AddRef; + TargetBitmap := NewBitmap(0, 0); + TargetBitmap.Handle := hh; + TargetBitmap.Add2AutoFreeEx(TObjectMethod(MakeMethod(Pointer(Picta), @OleFree))); + end; + end; + GlobalFree(hPtr); + end; + end; +end; + +(*function OleLoadPictureFile(varFileName: OleVariant; var lpdispPicture: IPictureDisp): HResult; stdcall; external 'oleaut32.dll'; +function OleLoadPicturePath(szURLorPath: PWideChar; unkCaller: IUnknown; dwReserved: Integer; clrReserved: DWORD; const iid: TGUID; ppvRet: Pointer): HResult; stdcall; external 'oleaut32.dll'; + +procedure tinyLoadJPGGIFBMP_(const fn: String; out TargetBitmap: PBitMap); +var + hh: DWORD; + Picta: IPicture; + dispPicture: IPictureDisp; +begin + TargetBitmap := nil; + // load + {if (OleLoadPictureFile(fn, dispPicture) = S_OK) then begin + dispPicture.QueryInterface(IID_IPicture, Picta); Picta.get_Handle(hh); Picta._AddRef; TargetBitmap := NewBitmap(0, 0); TargetBitmap.Handle := hh; TargetBitmap.Add2AutoFreeEx(TObjectMethod(MakeMethod(Pointer(Picta), @OleFree))); -end; + end;} + if (OleLoadPicturePath(PWideChar(WideString(fn)), nil, 0, 0, IID_IPicture, @Picta) = S_OK) then begin + Picta.get_Handle(hh); + Picta._AddRef; + TargetBitmap := NewBitmap(0, 0); + TargetBitmap.Handle := hh; + TargetBitmap.Add2AutoFreeEx(TObjectMethod(MakeMethod(Pointer(Picta), @OleFree))); + end; +end;*) -procedure tinyLoadJPGGIFBMPResource(var TargetBitmap: PBitMap; Inst : HInst; ResName : PChar; ResType : PChar); -var G: Pointer; - Sz: DWORD; - Ptr: Pointer; - Resource: HRSRC; -begin - Resource := FindResource(Inst, ResName, ResType); - Sz := SizeofResource(Inst, Resource); - DWORD(G) := LoadResource(hinstance, Resource); - DWORD(Ptr) := LocalAlloc(GMEM_FIXED, Sz); - move(g^, Ptr^, Sz); - tinyLoadJPGGIFBMPMemory(TargetBitmap, DWORD(Ptr), Sz); -end; end.