pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

* some fixes

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@142 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2014-12-03 10:59:01 +00:00
parent e37802a4d5
commit 6f8da34b33
4 changed files with 104 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Addons/mckCProgBar.pas
View File

@@ -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;

2
Addons/mckRarInfoBar.pas
View File

@@ -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;

2
Addons/mckRarProgBar.pas
View File

@@ -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;

141
Addons/tinyJPGGIFBMP.pas
View File

@@ -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.