如何将BMP图片利用内存映射功能映射到内存里面，然后在将映射文件以图片的形式画在paintbox上？ ( 积分: 100 )

如题，就是利用CreateFileMapping等一些函数，主要是后面的显示问题，对于映射进去的文件如何显示？

不是吧！高手都到哪里去了，郁闷！

unit BigImageOper;

interface

uses Windows, Classes, SysUtils, VFW_BigImage, Jpeg, Graphics, Forms, SyncObjs, Dialogs, ComObj,
Controls, ExtCtrls, Math;

Type
PDrawTextInfo=^TDrawTextInfo;
TDrawTextInfo=record
Drawed:Boolean;
Text:String;
Align:TAlign;
Pt:TPoint;

Charset: TFontCharset;
Color: TColor;
Height: Integer;
Name: TFontName;
Pitch: TFontPitch;
Size: Integer;
Style: TFontStyles;
end;

PRGBInfo=^TRGBInfo;
TRGBInfo=packed record
B,G,R:Byte;
end;

PDrawInfo=^TDrawInfo;
TDrawInfo=record
FileName:String;
DescRec:TRect;
Dataointer;
Transparent:Boolean;
end;

TDrawInfos=Array of TDrawInfo;

TRGBInfos=Array of TRGBInfo;

TBigImageOper=Class
private
FileName:String;

ViewHd:THandle;
ViewData,BmpDataointer;

Header:TBitmapInfoHeader;
bHeader:TBitmapInfoHeader;

bViewHd:THandle;
bViewData,bBmpDataointer;

dHd:HDRAWDIB;
FHeight: Integer;
FWidth: Integer;
FID:String;
FIsPic:Boolean;
CreateSize:Integer;
hMutex:THandle;
FDouble:Boolean;
TmpFileName:String;
CustomDraw:Boolean;

procedure BeginMapView(ImageFileName:String; Size:Int64; Var Hd:THandle; Var Dataointer; ID:String; IsPic:Boolean);
procedure EndMapView(Hd:THandle; Dataointer);
procedure SetMapView(FileName:String; IsPic:Boolean; ID:String; Var Hd:THandle; Var Dataointer);
function SetBmpInfo(vDataointer; var P: Pointer;
var Info: TBitmapInfoHeader):TBitmapFileHeader;
procedure SetBmpInfoEx(vDataointer; var P: Pointer;
var Info: TBitmapInfoHeader);
Function GetLine(Row:Integer; Dataointer; biHeight:Integer=0; biWidth:Integer=0; biBitCount:Integer=0)ointer;overload;
Function GetLine(Row:Integer)ointer;overload;
function GetScanLine(Row: Integer; Dataointer; biHeight:Integer=0; biWidth:Integer=0; biBitCount:Integer=0): Pointer;
procedure InternalDraw(Bmp: TBitmap; SelectRec: TRect; DrawDataointer; TransparentColor:TColor=-1);

function DrawImageMemory(Data,Descointer; SourceRect,DestRect:TRect; TransparentColor:TColor=-1):Boolean;
public
Constructor Create(FileName,ID:String; Width,Height:Integer; IsPic:Boolean=true; Double:Boolean=false);
Destructor Destroy;override;

procedure BeginDraw;
procedure EndDraw;

procedure DrawTo(DC:HDC; Rec:TRect; Offset:TPoint);overload;
procedure DrawTo(DC: HDC; DrawRec, SelectRect: TRect);overload;

procedure DrawTo(Bmp:TBitmap; BmpRec,DataRec:TRect; TransparentColor:TColor=-1);overload;
procedure DrawTo(Bmp:TBitmap; Rec:TRect; Offset:TPoint; TransparentColor:TColor=-1);overload;

procedure DrawTo(DescObj:TBigImageOper; SourceRect,DestRect:TRect; TransparentColor:TColor=-1);overload;

procedure Draw(ImageDataointer; ImageRec,DataRec:TRect; biHeight:Integer;
biWidth:Integer; biBitCount:Integer; TransparentColor:TColor=-1);overload;
procedure Draw(Bmp: TBitmap; SelectRec:TRect; TransparentColor:TColor=-1);overload;

procedure DrawBack(Bmp: TBitmap; SelectRec:TRect; TransparentColor:TColor=-1);
procedure ResotreBack(SelectRec:TRect; TransparentColor:TColor=-1);

function DrawText(Info: PDrawTextInfo; ContrastRec:TRect):TRect;

property Width:Integer read FWidth;
property Height:Integer read FHeight;

property ID:String read FID;

property Double:Boolean read FDouble;
end;

TAddDrawManager=Class;

TDrawThread=Class(TThread)
private
FAddManager:TAddDrawManager;
BigImageOper:TBigImageOper;
protected
procedure Execute;override;
public
Constructor Create(AddManager:TAddDrawManager; FileName,ID:String; Width,Height:Integer);
Destructor Destroy;override;
end;

TDrawManager=Class
private
OffLock:TCriticalSection;
FOffset:TPoint;

function GetOffset: TPoint;
procedure SetOffset(const Value: TPoint);
function ResotreRect(Rec: TRect): TRect;
protected
function InternalGetItemForPt(Pt:TPoint)ointer;virtual;abstract;
function InternalGetItemForRect(Rec:TRect)ointer;virtual;abstract;

function ConvertRect(Rec:TRect):TRect;
Function CheckRect(CheckRec,SourceRec: TRect):Boolean;
public
Constructor Create;
Destructor Destroy;override;

property Offset:TPoint read GetOffset write SetOffset;

function GetItem(Pt:TPoint)ointer;overload;
function GetItem(Rec:TRect)ointer;overload;
end;

TAddDrawManager=Class(TDrawManager)
private
Lock:TCriticalSection;
Event:TSimpleEvent;
List,GetList:TList;
Index:Integer;
Left,Top,ColumnCount,RowHeight,Spacing,ColumnWidth:Integer;
DrawThread:TDrawThread;
FMaxCount:Integer;
BigImageOper:TBigImageOper;

function AddDraw(dInfoDrawInfo)DrawInfo;
function GetDrawDrawInfo;

Function GetRect(Index:Integer):TRect;
protected
function InternalGetItemForPt(Pt:TPoint)ointer;override;
function InternalGetItemForRect(Rec:TRect)ointer;override;

public
Constructor Create(FileName,ID:String; Width,Height:Integer; IsPic:Boolean; Double:Boolean;
ColumnCount:Integer=6; Spacing:Integer=5);
Destructor Destroy;override;

Function Add(InfoDrawInfo; Index:Integer)DrawInfo;
procedure Clear;

property MaxCount:Integer read FMaxCount;

end;

PFlashInfo=^TFlashInfo;
TFlashInfo=record
Images:TImageList;
Indexs:Array of Integer;
Rec:TRect;
TimesWORD;
UpdateHandle:THandle;
ImageRec:TRect;
UpdateRect:TRect;
ID:String;
Dataointer;
Transparent:Boolean;

StartWORD;
Offset:TPoint;
CurIndex:Integer;
IsUse:Boolean;
end;

TFlashDrawManager=Class;

TFlashThread=Class(TThread)
private
FlashDrawManager:TFlashDrawManager;
BigImageOper:TBigImageOper;

InfoFlashInfo;
Bmp:TBitmap;
Rec:TRect;
ErrMsg:String;
procedure DoError;
function ConvertRect(Rec:TRect; Offset:TPoint):TRect;
Function CheckRect(Rec:TRect):Boolean;
protected
procedure Execute;override;
public
Constructor Create(FlashDrawManager:TFlashDrawManager);
Destructor Destroy;override;
end;

TFlashDrawManager=Class(TDrawManager)
private
HotIndex:Integer;
Lock:TCriticalSection;
Event:TSimpleEvent;
List:TList;
FlashThread:Array[0..2] of TFlashThread;

FileName,ID:String;
Width,Height:Integer;
IsPic,Double:Boolean;
FWait: DWORD;
Image:TImage;
MaxImages:Integer;
FMaxHots,FHotWidth,FHotHeight:Integer;

HotFileName:String;
BigImageOper:TBigImageOper;
TransparentColors:Array of TColor;

function GetHotRect(Index:Integer; Var TransparentColor:TColor):TRect;
function Get(Var Index:Integer)FlashInfo;
procedure Reset;
procedure SetWait(const Value: DWORD);

procedure DrawHot(HotIndex:Integer; DestRec:TRect; Dest:TBigImageOper; Transparent:Boolean);
function GetCount: Integer;
protected
function InternalGetItemForPt(Pt:TPoint)ointer;override;
function InternalGetItemForRect(Rec:TRect)ointer;override;

public
Constructor Create(Image:TImage; MaxHots,HotWidth,HotHeight:Integer; FileName,ID:String; Width,Height:Integer; IsPic:Boolean=true; Double:Boolean=false);
Destructor Destroy;override;

function Add(InfoFlashInfo)FlashInfo;
procedure Del(InfoFlashInfo);
procedure Clear;

procedure Invalidate;
procedure InvalidateFlash(Info: PFlashInfo);

property HotCount:Integer read GetCount;
function AddHot(HotBmp:TBitmap):Integer;

function GetHotCount:Integer;

property WaitWORD read FWait write SetWait;

property MaxHots:Integer read FMaxHots;
property HotWidth:Integer read FHotWidth;
property HotHeight:Integer read FHotheight;

end;

PCustomDrawInfo=^TCustomDrawInfo;
TCustomDrawInfo=record
FileName:String;
DrawRec,StretchRect:TRect;
ID:String;
Memory,Dataointer;
Transparent:Boolean;
TransparentColor:TColor;
DrawTextInfo:TDrawTextInfo;
end;

TCustomDrawManager=Class(TDrawManager)
private
Lock:TCriticalSection;
List:TList;
CustomFileName:String;

MapHd:THandle;
ViewData,DrawDataointer;
procedure BeginMapView(ImageFileName: String; Size: Int64;
var Hd: THandle; var Data: Pointer; ID: String);
procedure EndMapView(Hd: THandle; Data: Pointer);
function Item(Index:Integer)CustomDrawInfo;
protected
function InternalGetItemForPt(Pt:TPoint)ointer;override;
function InternalGetItemForRect(Rec:TRect)ointer;override;
public
Constructor Create(Size:Integer);
Destructor Destroy;override;

function Add(InfoCustomDrawInfo):Integer;
procedure Delete(Index:Integer);
procedure Clear;
procedure Edit(Index:Integer);

function DrawTo(BigImageOper:TBigImageOper; Index:Integer):TRect;
procedure InvalidateText(InfoDrawTextInfo);
procedure Restore(BigImageOper:TBigImageOper; DrawRect:TRect);

function ConvertRect(Rect:TRect):TRect;
end;

function GetImageRect(Graphic:TGraphic):TRect;

implementation

{ TBigImageOper }

function GetBitmapTransparentColor(Bmp:TBitmap):TColor;
begin
if Bmp.Monochrome then
Result := clWhite
else
Result := Bmp.Canvas.Pixels[0, Bmp.Height - 1];
//Result := Result or $02000000;

end;

function GetImageRect(Graphic:TGraphic):TRect;
begin
Result:=Rect(0,0,Graphic.Width-1,Graphic.Height-1);
end;

function FileSizeByName(const AFilename: string): Int64;
Var
FileStream:TFileStream;
begin
FileStream:=TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
try
Result := FileStream.Size;
finally
FileStream.Free;
FileStream:=nil;
end;
end;

function TAddDrawManager.AddDraw(dInfoDrawInfo)DrawInfo;
Var
InfoDrawInfo;
begin
Lock.Acquire;
Try
New(Info);
Info.FileName:=dInfo.FileName;
Info.DescRec:=dInfo.DescRec;
Info.Data:=dInfo.Data;
Info.Transparent:=dInfo.Transparent;
List.Add(Info);
GetList.Add(Info);
Result:=Info;
Event.SetEvent;
Finally
Lock.Release;
end;
end;

procedure TAddDrawManager.Clear;
Var
i:Integer;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
Dispose(List.Items);
end;
List.Clear;
GetList.Clear;
Finally
Lock.Release;
end;
Index:=0;
end;

function TAddDrawManager.GetDrawDrawInfo;
begin
Lock.Acquire;
Try
Result:=nil;
if List.Count>0 then
begin
Result:=List.Items[0];
List.Delete(0);
end
else
Event.ResetEvent;
Finally
Lock.Release;
end;
end;

function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
begin
Dec(Alignment);
Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
Result := Result div 8;
end;

function TBigImageOper.SetBmpInfo(vDataointer; var P: Pointer;
var Info: TBitmapInfoHeader):TBitmapFileHeader;
Var
fInfo:TBitmapFileHeader;
MemoryChar;
begin
p:=nil;
if Not Assigned(vData) then
Exit;

FillChar(Info,SizeOf(Info),0);
Memory:=vData;
CopyMemory(@fInfo,Memory,SizeOf(fInfo));
Inc(Memory,sizeof(TBitmapFileHeader));
CopyMemory(@Info,Memory,SizeOf(Info));

Memory:=vData;
Inc(Memory,fInfo.bfOffBits);
P:=Memory;
Result:=fInfo;
end;

function TBigImageOper.GetScanLine(Row: Integer; Dataointer; biHeight,biWidth,biBitCount:Integer): Pointer;
begin
if biHeight=0 then
biHeight:=Header.biHeight;
if biWidth=0 then
biWidth:=Header.biWidth;
if biBitCount=0 then
biBitCount:=Header.biBitCount;
if (Row < 0) or (Row >= biHeight) then
Exit;
if biHeight > 0 then // bottom-up DIB
Row := biHeight - Row - 1;
Integer(Result) := Integer(Data) +
Row * BytesPerScanline(biWidth, biBitCount, 32);
end;

Function TBigImageOper.GetLine(Row:Integer; Dataointer; biHeight:Integer; biWidth:Integer; biBitCount:Integer)ointer;
begin
if Not Assigned(Data) then
Exit;
Result:=GetScanLine(Row,Data,biHeight,biWidth,biBitCount);

end;

constructor TBigImageOper.Create(FileName,ID: String; Width,Height:Integer; IsPic:Boolean; Double:Boolean);
Var
fInfo:TBitmapFileHeader;
begin
CustomDraw:=false;
TmpFileName:='';
Self.FileName:=FileName;
hMutex:=CreateMutex(nil,false,'{1AF607A8-468E-4BE7-A3B8-D9E1C69AF919}');
FDouble:=Double;
FIsPic:=IsPic;
FID:=ID;
dHd:=DrawDibOpen;
FHeight:=Height;
FWidth:=Width;
CreateSize:=Height*BytesPerScanline(Width,24,32);
if FDouble then
begin
TmpFileName:=ChangeFileExt(FileName,'')+'{4A8C8AE1-731E-47F9-B841-F4BFA686C95D}'+ExtractFileExt(FileName);

CreateSize:=FileSizeByName(FileName);
SetMapView(TmpFileName,false,ID,ViewHd,ViewData);
SetMapView(FileName,true,ChangeFileExt(ExtractFileName(FileName),'')+ID,bViewHd,bViewData);

end
else
SetMapView(FileName,IsPic,ID,ViewHd,ViewData);

if IsPic then
begin
if FDouble then
begin
fInfo:=SetBmpInfo(bViewData,bBmpData,bHeader);
Header:=bHeader;
BmpData:=PChar(ViewData)+fInfo.bfOffBits;
end
else
fInfo:=SetBmpInfo(ViewData,BmpData,Header);

FHeight:=Header.biHeight;
FWidth:=Header.biWidth;
end
else
begin
SetBmpInfoEx(ViewData,BmpData,Header);
if FDouble then
begin
bHeader:=Header;
bBmpData:=BmpData;
end;
end;
end;

destructor TBigImageOper.Destroy;
begin
CloseHandle(hMutex);
EndMapView(ViewHd,ViewData);
EndMapView(bViewHd,bViewData);
if (TmpFileName<>'') and FileExists(TmpFileName) then
DeleteFile(TmpFileName);
DrawDibClose(dHd);
inherited;
end;

procedure TBigImageOper.BeginMapView(ImageFileName:String; Size:Int64; var Hd: THandle;
var Data: Pointer; ID:String; IsPic:Boolean);
Var
FileStream:TFileStream;
begin
if (Not IsPic) and (Not FileExists(ImageFileName)) then
begin
FileStream:=TFileStream.Create(ImageFileName,fmCreate);
Try
FileStream.Size:=Size;
Finally
FileStream.Free;
FileStream:=nil;
end;
end;
FileStream:=TFileStream.Create(ImageFileName,fmOpenReadWrite or fmShareDenyNone);
Try
Hd:=CreateFileMapping(FileStream.Handle,nil,PAGE_READWRITE,0,0,PChar(ID));
if Hd<>0 then
Data:=MapViewOfFile(Hd,FILE_MAP_ALL_ACCESS,0,0,0);
Finally
FileStream.Free;
FileStream:=nil;
end;
end;

procedure TBigImageOper.EndMapView(Hd: THandle; Data: Pointer);
begin
UnmapViewOfFile(Data);
CloseHandle(Hd);
end;

procedure TBigImageOper.SetMapView(FileName: String; IsPic:Boolean; ID:String; Var Hd:THandle; Var Dataointer);
Var
Ext:String;
Jpg:TJpegImage;
Bmp:TBitmap;

begin
if FileExists(FileName) and IsPic then
begin
Ext:=UpperCase(ExtractFileExt(FileName));
if (Ext='.JPEG') or (Ext='.JPG') then
begin
Bmp:=TBitmap.Create;
Jpg:=TJpegImage.Create;
Try
Jpg.LoadFromFile(FileName);
Bmp.Assign(Jpg);
Bmp.SaveToFile(FileName);
Finally
Bmp.Free;
Jpg.Free;
end;
end
end;
BeginMapView(FileName,CreateSize,Hd,Data,ID,IsPic);
end;

procedure TBigImageOper.DrawTo(DC: HDC; Rec:TRect; Offset: TPoint);
Var
SelectRect:TRect;
begin
SelectRect:=Rect(Offset.X,Offset.Y,Offset.X+Rec.Right-Rec.Left,Offset.Y+Rec.Bottom-Rec.Top);
DrawTo(DC,Rec,SelectRect);
end;

procedure TBigImageOper.DrawTo(DC: HDC; DrawRec,SelectRect:TRect);
Var
DrawHeader:TBitmapInfoHeader;
Dataointer;
xRec:TRect;
begin
if Not CustomDraw then
WaitForSingleObject(hMutex,INFINITE);
Try
DrawDibDraw(dHd,DC,DrawRec.Left,DrawRec.Top,DrawRec.Right-DrawRec.Left,DrawRec.Bottom-DrawRec.Top,
@Header,BmpData,SelectRect.Left,SelectRect.Top,SelectRect.Right-SelectRect.Left,
SelectRect.Bottom-SelectRect.Top,DDF_HALFTONE);
Finally
if Not CustomDraw then
ReleaseMutex(hMutex);
end;
end;

procedure TBigImageOper.DrawTo(Bmp:TBitmap; Rec: TRect; Offset: TPoint; TransparentColor:TColor);
Var
SelectRect:TRect;
begin
SelectRect:=Rect(Offset.X,Offset.Y,Offset.X+Rec.Right-Rec.Left,Offset.Y+Rec.Bottom-Rec.Top);
DrawTo(Bmp,Rec,SelectRect,TransparentColor);
end;

procedure TBigImageOper.InternalDraw(Bmp:TBitmap; SelectRec:TRect; DrawDataointer; TransparentColor:TColor);
Var
i,Y:Integer;
Dataointer;
Descointer;
DrawBmp:TBitmap;
dBmp:TBitmap;
begin
WaitForSingleObject(hMutex,INFINITE);
Try
dBmp:=nil;
if Not ((Bmp.Width=SelectRec.Right-SelectRec.Left) and (Bmp.Height=SelectRec.Bottom-SelectRec.Top)) then
begin
dBmp:=TBitmap.Create;
dBmp.Width:=SelectRec.Right-SelectRec.Left;
dBmp.Height:=SelectRec.Bottom-SelectRec.Top;
dBmp.Canvas.StretchDraw(dBmp.Canvas.ClipRect,Bmp);
dBmp.PixelFormat:=pf24Bit;
DrawBmp:=dBmp;
end
else
begin
if Bmp.PixelFormat<>pf24Bit then
Bmp.PixelFormat:=pf24bit;
DrawBmp:=Bmp;
end;
Y:=SelectRec.Top;
For i:=0 to DrawBmp.Height-1 do
begin
Data:=DrawBmp.ScanLine;
Desc:=GetLine(Y,DrawData);
if DrawImageMemory(Data,Desc,Rect(0,0,bmp.Width-1,Bmp.Height-1),SelectRec,TransparentColor) then
Exit;
Inc(Y);
end;
if Assigned(dBmp) then
dBmp.Free;
Finally
ReleaseMutex(hMutex);
end;
end;

procedure TBigImageOper.SetBmpInfoEx(vDataointer; var P: Pointer;
var Info: TBitmapInfoHeader);
begin
P:=vData;
FillChar(Info,sizeof(Info),0);
Info.biSize:=sizeof(Info);
Info.biWidth:=Width;
Info.biHeight:=Height;
Info.biPlanes:=1;
Info.biBitCount:=24;
Info.biSizeImage:=CreateSize;
end;

procedure TBigImageOper.ResotreBack(SelectRec: TRect; TransparentColor:TColor);
Var
i:Integer;
Dataointer;
Descointer;
begin
if Not CustomDraw then
WaitForSingleObject(hMutex,INFINITE);
Try
For i:=SelectRec.Top to SelectRec.Bottom do
begin
Data:=GetLine(i,bBmpData);
Desc:=GetLine(i,BmpData);
if DrawImageMemory(Data,Desc,SelectRec,SelectRec,TransparentColor) then
Exit;
end;
Finally
if Not CustomDraw then
ReleaseMutex(hMutex);
end;
end;

procedure TBigImageOper.DrawBack(Bmp: TBitmap; SelectRec: TRect; TransparentColor:TColor);
begin
InternalDraw(Bmp,SelectRec,bBmpData,TransparentColor);
end;

procedure TBigImageOper.Draw(Bmp: TBitmap; SelectRec: TRect; TransparentColor:TColor);
begin
InternalDraw(Bmp,SelectRec,BmpData,TransparentColor);
end;

procedure TBigImageOper.DrawTo(DescObj: TBigImageOper; SourceRect,
DestRect: TRect; TransparentColor:TColor);
Var
i,Y:Integer;
Dataointer;
Source,Descointer;
begin
if Not CustomDraw then
WaitForSingleObject(hMutex,INFINITE);
Try
Y:=SourceRect.Top;
For i:=DestRect.Top to DestRect.Bottom do
begin
Desc:=DescObj.GetLine(i);
Data:=GetLine(Y);
if DrawImageMemory(Data,Desc,SourceRect,DestRect,TransparentColor) then
Exit;
Inc(Y);
end;
Finally
if Not CustomDraw then
ReleaseMutex(hMutex);
end;
end;

function TBigImageOper.GetLine(Row: Integer): Pointer;
begin
if Not Assigned(BmpData) then
Exit;
Result:=GetScanLine(Row,BmpData);
end;

procedure TBigImageOper.DrawTo(Bmp: TBitmap; BmpRec, DataRec: TRect; TransparentColor:TColor);
Var
i,Y:Integer;
Dataointer;
Source,Descointer;
begin
if Not CustomDraw then
WaitForSingleObject(hMutex,INFINITE);
Try
if Bmp.PixelFormat<>pf24Bit then
Bmp.PixelFormat:=pf24bit;
Y:=DataRec.Top;
if DataRec.Right>Width-1 then
DataRec.Right:=Width-1;
if DataRec.Bottom>Height-1 then
DataRec.Bottom:=Height-1;

if BmpRec.Left<0 then
BmpRec.Left:=0;
if BmpRec.Top<0 then
BmpRec.Top:=0;

if BmpRec.Right-BmpRec.Left+1>Bmp.Width then
BmpRec.Right:=Bmp.Width-1-BmpRec.Left;

For i:=BmpRec.Top to BmpRec.Bottom do
begin
if i>Bmp.Height-1 then
Exit;
Desc:=Bmp.ScanLine;
Data:=GetLine(Y,BmpData);
if DrawImageMemory(Data,Desc,DataRec,BmpRec,TransparentColor) then
Exit;
Inc(Y);
end;
Finally
if Not CustomDraw then
ReleaseMutex(hMutex);
end;
end;

procedure TBigImageOper.Draw(ImageData: Pointer; ImageRec,
DataRec: TRect; biHeight:Integer; biWidth:Integer; biBitCount:Integer; TransparentColor:TColor);
Var
i,Y:Integer;
Dataointer;
Source,Descointer;
begin
if Not CustomDraw then
WaitForSingleObject(hMutex,INFINITE);
Try
Y:=DataRec.Top;
For i:=ImageRec.Top to ImageRec.Bottom do
begin
Data:=GetLine(i,ImageData,biHeight,biWidth,biBitCount);
Desc:=GetLine(Y);
if DrawImageMemory(Data,Desc,ImageRec,DataRec,TransparentColor) then
Exit;
Inc(Y);
end;
Finally
if Not CustomDraw then
ReleaseMutex(hMutex);
end;
end;

procedure TBigImageOper.BeginDraw;
begin
WaitForSingleObject(hMutex,INFINITE);
CustomDraw:=true;

end;

procedure TBigImageOper.EndDraw;
begin
CustomDraw:=false;
ReleaseMutex(hMutex);
end;

function TBigImageOper.DrawImageMemory(Data, Desc: Pointer; SourceRect,DestRect:TRect;
TransparentColor:TColor): Boolean;
Var
i,X,R,G,B:Integer;

function CheckTransparentColor:Boolean;
Var
sColor,dColor:TColor;
begin
With TRGBInfos(Data) do
sColor:=r * 77 + g * 151 + b * 28;

dColor:=R * 77 + G * 151 + B * 28;
Result:=Abs(sColor-dColor) in [0,1,2];
end;
begin
Result:=(Data=nil) or (Desc=nil);

R:=GetRValue(TransparentColor);
G:=GetGValue(TransparentColor);
B:=GetBValue(TransparentColor);

if Not Result then
begin
if TransparentColor=-1 then
CopyMemory(@(TRGBInfos(Desc)[DestRect.Left]),@(TRGBInfos(Data)[SourceRect.Left]),
3*(SourceRect.Right-SourceRect.Left+1))
else
begin
X:=DestRect.Left;
For i:=SourceRect.Left to SourceRect.Right do
begin
Try
if CheckTransparentColor then
Continue;
TRGBInfos(Desc)[X]:=TRGBInfos(Data);
Finally
Inc(X);
end;
end;
end;
end;
Result:=false;
end;

function GetTextLenForRect(W,TextW:Integer; Text:String):String;
Var
Count:Integer;
begin
Count:=TextW div W;
Result:=Copy(Text,1,Count-3)+'...';
end;

function TBigImageOper.DrawText(Info: PDrawTextInfo; ContrastRec:TRect):TRect;
Var
W,H,xW:Integer;
Bmp:TBitmap;
X,Y:Integer;
Rec:TRect;
Text:String;
begin
Bmp:=TBitmap.Create;
Try
Text:=Info.Text;
Bmp.Canvas.Font.Name:=Info.Name;
Bmp.Canvas.Font.Charset:=Info.Charset;
Bmp.Canvas.Font.Color:=Info.Color;
Bmp.Canvas.Font.Height:=Info.Height;
Bmp.Canvas.Font.Name:=Info.Name;
Bmp.Canvas.Font.Pitch:=Info.Pitch;
Bmp.Canvas.Font.Size:=Info.Size;
Bmp.Canvas.Font.Style:=Info.Style;

xW:=Bmp.Canvas.TextWidth('A');
W:=Bmp.Canvas.TextWidth(Text);
H:=Bmp.Canvas.TextHeight(Text);
Bmp.Height:=H;
Bmp.Width:=W;
Bmp.PixelFormat:=pf24Bit;
Bmp.Canvas.Brush.Color:=clWhite;
Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
if Info.Pt.X=MaxInt then
Info.Pt.X:=ContrastRec.Left;
if Info.Pt.Y=MaxInt then
Info.Pt.Y:=ContrastRec.Top+((ContrastRec.Bottom-ContrastRec.Top-H) div 2);
With Info^ do
Case Info.Align of
alTop:
begin
X:=Pt.X;
Y:=ContrastRec.Top-H-3;
end;
alBottom:
begin
X:=Pt.X;
Y:=ContrastRec.Bottom+3;
end;
alLeft:
begin
X:=ContrastRec.Left-W-3;
Y:=Pt.Y;
end;
alRight:
begin
X:=ContrastRec.Right+3;
Y:=Pt.Y;
end;
end;

if (Y<0) or (Y>Width) or (X>Width) then
Exit;

Rec:=Rect(X,Y,X+W,Y+H);
if (X+W)>Width then
begin
W:=(Width-X);
Text:=GetTextLenForRect(xW,W,Text);
Bmp.Width:=W;
Rec.Right:=Rec.Left+Bmp.Canvas.TextWidth(Text);
end;

Result:=Rec;
Bmp.Canvas.TextOut(0,0,Text);

Draw(Bmp,Rec,clWhite);
Finally
Bmp.Free;
end;
end;

{ TDrawThread }

constructor TDrawThread.Create(AddManager:TAddDrawManager; FileName,ID:String; Width,Height:Integer);
begin
Inherited Create(True);
FAddManager:=AddManager;
FreeOnTerminate:=false;
BigImageOper:=AddManager.BigImageOper;
Resume;
end;

destructor TDrawThread.Destroy;
begin
BigImageOper.Free;
inherited;
end;

procedure TDrawThread.Execute;
Var
InfoDrawInfo;
Bmp,SourceBmp:TBitmap;
Ext:String;
Jpg:TJpegImage;
procedure SetBmpWH(gh:TGraphic);
begin
if gh.Width>gh.Height then
begin
Bmp.Width:=FAddManager.ColumnWidth;
Bmp.Height:=Round(Bmp.Width*3/4);
Info.DescRec.Top:=Info.DescRec.Top+((Info.DescRec.Bottom-Info.DescRec.Top-Bmp.Height) div 2);
Info.DescRec.Bottom:=Info.DescRec.Top+Bmp.Height;
end
else
begin
Bmp.Width:=FAddManager.ColumnWidth;
Bmp.Height:=FAddManager.RowHeight;
end;
end;
begin
While Not Terminated do
begin
FAddManager.Event.WaitFor(INFINITE);
if Terminated then
Exit;
Info:=FAddManager.GetDraw;
if Assigned(Info) then
begin
Bmp:=TBitmap.Create;
Try
Ext:=UpperCase(ExtractFileExt(Info.FileName));
if (Ext='.JPG') or (Ext='.JPEG') then
begin
Jpg:=TJpegImage.Create;
Try
Jpg.LoadFromFile(Info.FileName);
SetBmpWH(Jpg);
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,Jpg);
Finally
Jpg.Free;
end;
end
else if Ext='.BMP' then
begin
SourceBmp:=TBitmap.Create;
Try
SourceBmp.LoadFromFile(Info.FileName);
SetBmpWH(SourceBmp);
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,SourceBmp);
Finally
SourceBmp.Free;
end;
end
else
begin
//Dispose(Info);
Continue;
end;
Bmp.PixelFormat:=pf24Bit;
if Info.Transparent then
BigImageOper.Draw(Bmp,Info.DescRec,Bmp.TransparentColor)
else
BigImageOper.Draw(Bmp,Info.DescRec);
//Dispose(Info);
Finally
Bmp.Free;
end;
end;
end;
end;

{ TAddDrawManager }

Function TAddDrawManager.Add(InfoDrawInfo; Index:Integer)DrawInfo;
Var
b:Boolean;
Rec:TRect;
begin
Result:=nil;
b:=Index<FMaxCount;
if b then
begin
Rec:=GetRect(Index);
Inc(Index);
Info.DescRec:=Rec;
Result:=AddDraw(Info);
end;
end;

constructor TAddDrawManager.Create(FileName, ID: String; Width,
Height: Integer; IsPic:Boolean; Double:Boolean; ColumnCount, Spacing:Integer);
Var
Tmp:Integer;
begin
Inherited Create;
BigImageOper:=TBigImageOper.Create(FileName,ID,Width,Height,IsPic,Double);
Width:=BigImageOper.Width;
Height:=BigImageOper.Height;
Index:=0;
Self.ColumnCount:=ColumnCount;
Self.RowHeight:=RowHeight;
Self.Spacing:=Spacing;
Lock:=TCriticalSection.Create;
Event:=TSimpleEvent.Create;
GetList:=TList.Create;
List:=TList.Create;

ColumnWidth:=Width div (ColumnCount);
ColumnWidth:=ColumnWidth-Spacing;
RowHeight:=Round(ColumnWidth*(4/3));
Tmp:=Height mod (RowHeight+Spacing);
if Tmp>Spacing then
Top:=Spacing+((Tmp-Spacing) div 2)
else
Top:=Spacing;

Tmp:=Width mod ColumnCount;
if Tmp>Spacing then
Left:=Spacing+((Tmp-Spacing) div 2)
else
Left:=Spacing;
FMaxCount:=ColumnCount*(Height div (RowHeight+Spacing));
DrawThread:=TDrawThread.Create(Self,FileName,ID,Width,Height);
end;

destructor TAddDrawManager.Destroy;
begin
Clear;
DrawThread.Terminate;
Event.SetEvent;
DrawThread.WaitFor;
DrawThread.Free;
Lock.Free;
Event.Free;
List.Free;
GetList.Free;
inherited;
end;

function TAddDrawManager.GetRect(Index: Integer): TRect;
Var
Rows:Integer;
begin
Rows:=Index div ColumnCount;
if Rows=0 then
Result.Left:=Index*(ColumnWidth+Spacing)+Left
else
Result.Left:=(Index mod ColumnCount)*(ColumnWidth+Spacing)+Left;

Result.Top:=Top+Rows*(RowHeight+Spacing);
Result.Right:=Result.Left+ColumnWidth;
Result.Bottom:=Result.Top+RowHeight;
end;

function TAddDrawManager.InternalGetItemForPt(Pt: TPoint): Pointer;
Var
i:Integer;
InfoDrawInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to GetList.Count-1 do
begin
Info:=GetList.Items;
if PtInRect(Info.DescRec,Pt) then
begin
Result:=Info;
break;
end;
end;
Finally
Lock.Release;
end;
end;

function TAddDrawManager.InternalGetItemForRect(Rec: TRect): Pointer;
Var
i:Integer;
InfoDrawInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to GetList.Count-1 do
begin
Info:=GetList.Items;
if PtInRect(Info.DescRec,Rec.TopLeft) and PtInRect(Info.DescRec,Rec.BottomRight) then
begin
Result:=Info;
break;
end;
end;
Finally
Lock.Release;
end;
end;

{ TFlashDrawManager }

function TFlashDrawManager.Add(Info: PFlashInfo)FlashInfo;
Var
InfoXFlashInfo;
begin
Lock.Acquire;
Try
New(InfoX);
InfoX.Images:=Info.Images;
SetLength(InfoX.Indexs,Length(Info.Indexs));
InfoX.ImageRec:=Info.ImageRec;
InfoX.Transparent:=Info.Transparent;
InfoX.Indexs:=Info.Indexs;
InfoX.Rec:=Info.Rec;
InfoX.Start:=GetTickCount;
InfoX.Times:=Info.Times;
InfoX.CurIndex:=0;
InfoX.IsUse:=false;
InfoX.UpdateHandle:=Info.UpdateHandle;
InfoX.UpdateRect:=Info.UpdateRect;
InfoX.Offset:=GetOffset;
InfoX.ID:=Info.ID;
InfoX.Data:=Info.Data;
InfoX.Rec.Right:=InfoX.Rec.Left+HotWidth-1;
InfoX.Rec.Bottom:=InfoX.Rec.Top+HotHeight-1;
Result:=InfoX;
List.Add(InfoX);
Event.SetEvent;
Finally
Lock.Release;
end;
end;

function TFlashDrawManager.AddHot(HotBmp: TBitmap): Integer;
Var
Bmp:TBitmap;
Rec:TRect;
Tmp:TColor;
begin
Bmp:=TBitmap.Create;
Try
Result:=-1;
if HotIndex>MaxHots-1 then
Exit;
Bmp.Width:=HotWidth;
Bmp.Height:=HotHeight;
Bmp.PixelFormat:=pf24Bit;
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,HotBmp);

Rec:=GetHotRect(HotIndex,Tmp);
BigImageOper.Draw(Bmp,Rec);
Result:=HotIndex;
Inc(HotIndex);

Bmp.Transparent:=true;
SetLength(TransparentColors,Length(TransparentColors)+1);
TransparentColors[High(TransparentColors)]:=Bmp.TransparentColor;
Finally
Bmp.Free;
end;
end;

procedure TFlashDrawManager.Clear;
Var
i:Integer;
InfoFlashInfo;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
SetLength(Info.Indexs,0);
Dispose(Info);
end;
List.Clear;
Event.ResetEvent;
Finally
Lock.Release;
end;
end;

constructor TFlashDrawManager.Create(Image:TImage; MaxHots,HotWidth,HotHeight:Integer; FileName, ID: String; Width,
Height: Integer; IsPic, Double: Boolean);
Var
pId:String;
i:Integer;
begin
Inherited Create;
SetLength(TransparentColors,0);
HotIndex:=0;
FMaxHots:=MaxHots;
FHotWidth:=HotWidth;
FHotHeight:=HotHeight;
Self.Image:=Image;
Self.FileName:=FileName;
Self.ID:=ID;
Self.Width:=Width;
Self.Height:=Height;
Self.IsPic:=IsPic;
Self.Double:=Double;

pID:=CreateClassID;
HotFileName:=ExtractFilePath(Application.ExeName)+pID+'.~dat';
BigImageOper:=TBigImageOper.Create(HotFileName,pID,HotWidth,HotHeight*MaxHots,false,false);

Lock:=TCriticalSection.Create;
Event:=TSimpleEvent.Create;
List:=TList.Create;

FWait:=50;
For i:=Low(FlashThread) to High(FlashThread) do
FlashThread:=TFlashThread.Create(Self);
end;

procedure TFlashDrawManager.Del(Info: PFlashInfo);
Var
i:Integer;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
if Info=List.Items then
begin
SetLength(Info.Indexs,0);
Dispose(Info);
List.Delete(i);
break;
end;
end;
if List.Count<=0 then
Event.ResetEvent;
Finally
Lock.Release;
end;
end;

destructor TFlashDrawManager.Destroy;
Var
i:Integer;
begin
Clear;
For i:=Low(FlashThread) to High(FlashThread) do
begin
FlashThread.Terminate;
end;

Event.SetEvent;

For i:=Low(FlashThread) to High(FlashThread) do
begin
FlashThread.WaitFor;
FlashThread.Free;
end;
Lock.Free;
Event.Free;
List.Free;
BigImageOper.Free;
DeleteFile(HotFileName);
SetLength(TransparentColors,0);
inherited;
end;

procedure TFlashDrawManager.DrawHot(HotIndex: Integer; DestRec:TRect; Dest:TBigImageOper; Transparent:Boolean);
Var
SourceRec:TRect;
TransparentColor:TColor;
begin
SourceRec:=GetHotRect(HotIndex,TransparentColor);
if Transparent then
BigImageOper.DrawTo(Dest,SourceRec,DestRec,TransparentColor)
else
BigImageOper.DrawTo(Dest,SourceRec,DestRec,-1);
end;

function TFlashDrawManager.Get(Var Index:Integer): PFlashInfo;
Var
i:Integer;
InfoFlashInfo;
xRec:TRect;
Pt:TPoint;
begin
Lock.Acquire;
Try
Result:=nil;
Pt:=Offset;
xRec.Left:=0;
xRec.Top:=0;
xRec.Right:=Image.ClientWidth-1;
xRec.Bottom:=Image.ClientHeight-1;
if Index>List.Count-1 then
Index:=0;
For i:=Index to List.Count-1 do
begin
Info:=List.Items;
if Info.IsUse then
Continue;
if Not CheckRect(Info.Rec,xRec) then
Continue;
Result:=Info;
Info.IsUse:=true;
Index:=i+1;
Exit;
end;
Index:=0;
Finally
Lock.Release;
end;
end;

function TFlashDrawManager.GetCount: Integer;
begin
Result:=HotIndex-1;
end;

function TFlashDrawManager.GetHotCount: Integer;
begin
Result:=HotIndex;
end;

function TFlashDrawManager.GetHotRect(Index: Integer; Var TransparentColor:TColor): TRect;
begin
Result:=Rect(0,Index*HotHeight,HotWidth-1,(Index+1)*HotHeight-1);
if Index<=High(TransparentColors) then
TransparentColor:=TransparentColors[Index];
end;

function TFlashDrawManager.InternalGetItemForPt(Pt: TPoint): Pointer;
Var
i:Integer;
InfoFlashInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
if PtInRect(Info.Rec,Pt) then
begin
Result:=Info;
break;
end;
end;
Finally
Lock.Release;
end;
end;

function TFlashDrawManager.InternalGetItemForRect(Rec: TRect): Pointer;
Var
i:Integer;
InfoFlashInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
if PtInRect(Info.Rec,Rec.TopLeft) and PtInRect(Info.Rec,Rec.BottomRight) then
begin
Result:=Info;
break;
end;
end;
Finally
Lock.Release;
end;
end;

procedure TFlashDrawManager.Reset;
Var
i:Integer;
InfoFlashInfo;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
Info.IsUse:=false;
end;
Finally
Lock.Release;
end;
end;

procedure TFlashDrawManager.Invalidate;
Var
InfoFlashInfo;
i:Integer;
Rgn,tRgn,cRgn:HRGN;
xRec,yRec,tRec:TRect;
DrawRec,UpdateRec:TRect;
ParentOffset:TPoint;
begin
Lock.Acquire;
Try
DrawRec:=Image.ClientRect;
UpdateRec:=Image.BoundsRect;
ParentOffset:=Point(Image.Left,Image.Top);
xRec:=ConvertRect(DrawRec);
With xRec do
Rgn:=CreateRectRgn(Left,Top,Right,Bottom);
With UpdateRec do
cRgn:=CreateRectRgn(Left,Top,Right,Bottom);
Try
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
if PtInRegion(Rgn,Info.Rec.Left,Info.Rec.Top) or
PtInRegion(Rgn,Info.Rec.Right,Info.Rec.Top) or
PtInRegion(Rgn,Info.Rec.Left,Info.Rec.Bottom) or
PtInRegion(Rgn,Info.Rec.Right,Info.Rec.Bottom) then
begin
yRec:=Info.Rec;
if Info.Rec.Left<xRec.Left then
yRec.Left:=xRec.Left;
if Info.Rec.Right>xRec.Right then
yRec.Right:=xRec.Right;
if Info.Rec.Top<xRec.Top then
yRec.Top:=xRec.Top;
if Info.Rec.Bottom>xRec.Bottom then
yRec.Bottom:=xRec.Bottom;

yRec:=ResotreRect(yRec);
tRec:=yRec;
With yRec do
begin
Left:=Left+ParentOffset.X;
Right:=Left+tRec.Right-tRec.Left;
Top:=Top+ParentOffset.Y;
Bottom:=Top+tRec.Bottom-tRec.Top;
tRgn:=CreateRectRgn(Left,Top,Right,Bottom);
end;
Try
CombineRgn(cRgn,cRgn,tRgn,RGN_XOR);
Finally
DeleteObject(tRgn);
end;
end;
end;

InvalidateRgn(Image.Parent.Handle,cRgn,false);
Finally
DeleteObject(Rgn);
DeleteObject(cRgn);
end;
Finally
Lock.Release;
end;
end;

procedure TFlashDrawManager.InvalidateFlash(InfoFlashInfo);
Var
i:Integer;
Rgn,tRgn:HRGN;
xRec,yRec,tRec:TRect;
DrawRec:TRect;
ParentOffset:TPoint;
begin
Lock.Acquire;
Try
DrawRec:=Image.ClientRect;
ParentOffset:=Point(Image.Left,Image.Top);
xRec:=ConvertRect(DrawRec);
With xRec do
Rgn:=CreateRectRgn(Left,Top,Right,Bottom);
Try
if PtInRegion(Rgn,Info.Rec.Left,Info.Rec.Top) or
PtInRegion(Rgn,Info.Rec.Right,Info.Rec.Top) or
PtInRegion(Rgn,Info.Rec.Left,Info.Rec.Bottom) or
PtInRegion(Rgn,Info.Rec.Right,Info.Rec.Bottom) then
begin
yRec:=Info.Rec;
if Info.Rec.Left<xRec.Left then
yRec.Left:=xRec.Left;
if Info.Rec.Right>xRec.Right then
yRec.Right:=xRec.Right;
if Info.Rec.Top<xRec.Top then
yRec.Top:=xRec.Top;
if Info.Rec.Bottom>xRec.Bottom then
yRec.Bottom:=xRec.Bottom;

yRec:=ResotreRect(yRec);
tRec:=yRec;
With yRec do
begin
Left:=Left+ParentOffset.X;
Right:=Left+tRec.Right-tRec.Left;
Top:=Top+ParentOffset.Y;
Bottom:=Top+tRec.Bottom-tRec.Top;
tRgn:=CreateRectRgn(Left,Top,Right,Bottom);
end;
Try
InvalidateRgn(Image.Parent.Handle,tRgn,false);
Finally
DeleteObject(tRgn);
end;
end;

Finally
DeleteObject(Rgn);
end;
Finally
Lock.Release;
end;
end;

procedure TFlashDrawManager.SetWait(const Value: DWORD);
begin
FWait := Value;
end;

{ TFlashThread }

function TFlashThread.CheckRect(Rec: TRect): Boolean;
Var
xRec:TRect;
Pt:TPoint;
begin
Result:=false;
Pt:=FlashDrawManager.Offset;
xRec.Left:=Pt.X;
xRec.Top:=Pt.Y;
xRec.Right:=xRec.Left+FlashDrawManager.Image.ClientWidth;
xRec.Bottom:=xRec.Top+FlashDrawManager.Image.ClientHeight;

Result:=PtInRect(xRec,Point(Rec.Left,Rec.Top))
or PtInRect(xRec,Point(Rec.Left,Rec.Bottom))
or PtInRect(xRec,Point(Rec.Right,Rec.Top))
or PtInRect(xRec,Point(Rec.Right,Rec.Bottom));

end;

function TFlashThread.ConvertRect(Rec: TRect; Offset:TPoint): TRect;
Var
Pt:TPoint;
begin
Pt:=FlashDrawManager.Offset;
Result.Left:=Rec.Left+(Offset.X-Pt.X);
Result.Right:=Result.Left+Rec.Right-Rec.Left;
Result.Top:=Rec.Top+(Offset.Y-Pt.Y);
Result.Bottom:=Result.Top+Rec.Bottom-Rec.Top;
end;

constructor TFlashThread.Create(FlashDrawManager: TFlashDrawManager);
begin
Inherited Create(True);
Self.FlashDrawManager:=FlashDrawManager;
FreeOnTerminate:=false;
BigImageOper:=TBigImageOper.Create(FlashDrawManager.FileName,FlashDrawManager.ID,FlashDrawManager.Width,
FlashDrawManager.Height,FlashDrawManager.IsPic,FlashDrawManager.Double);
Resume;
end;

destructor TFlashThread.Destroy;
begin

inherited;
end;

procedure TFlashThread.DoError;
begin
ShowMessage(ErrMsg);
end;

procedure TFlashThread.Execute;
Var
Index:Integer;
xRec:TRect;
begin
Index:=0;
While Not Terminated do
begin
Try
FlashDrawManager.Event.WaitFor(INFINITE);
if Terminated then
Exit;
FlashDrawManager.Reset;
Info:=FlashDrawManager.Get(Index);
if Assigned(Info) then
begin
if Info.CurIndex>High(Info.Indexs) then
Info.CurIndex:=0;

if Info.Times<>-1 then
begin
if GetTickCount-Info.Start>Info.Times then
begin
//BigImageOper.BeginDraw;
Try
BigImageOper.ResotreBack(Info.Rec);
Rec:=ConvertRect(Info.ImageRec,Infffset);
BigImageOper.DrawTo(FlashDrawManager.Image.Picture.Bitmap,Rec,Info.Rec);
Rec:=ConvertRect(Info.UpdateRect,Infffset);
Finally
//BigImageOper.EndDraw;
end;
// InvalidateRect(Info.UpdateHandle,@Info.UpdateRect,false);
FlashDrawManager.InvalidateFlash(Info);
FlashDrawManager.Del(Info);
Continue;
end;
end;
if CheckRect(Info.Rec) then
begin
//BigImageOper.BeginDraw;
Try
BigImageOper.ResotreBack(Info.Rec);
Rec:=ConvertRect(Info.ImageRec,Infffset);
xRec:=Info.Rec;
if Rec.Left<0 then
begin
xRec.Left:=xRec.Left-Rec.Left;
Rec.Left:=0;
end;
if Rec.Top<0 then
begin
xRec.Top:=xRec.Top-Rec.Top;
Rec.Top:=0;
end;
FlashDrawManager.DrawHot(Info.Indexs[Info.CurIndex],Info.Rec,BigImageOper,Info.Transparent);
BigImageOper.DrawTo(FlashDrawManager.Image.Picture.Bitmap,Rec,xRec);
Finally
//BigImageOper.EndDraw;
end;
// Rec:=ConvertRect(Info.UpdateRect,Infffset);
// InvalidateRect(Info.UpdateHandle,@Rec,false);
FlashDrawManager.InvalidateFlash(Info);
end;
Inc(Info.CurIndex);
end;

Sleep(FlashDrawManager.Wait);
Except
On E:Exception do
begin
ErrMsg:=E.Message;
Synchronize(DoError);
end;
end;
end;
end;

{ TDrawManager }

function TDrawManager.CheckRect(CheckRec,SourceRec: TRect): Boolean;
Var
Pt:TPoint;
begin
Result:=false;
SourceRec:=ConvertRect(SourceRec);
Result:=PtInRect(SourceRec,Point(CheckRec.Left,CheckRec.Top))
or PtInRect(SourceRec,Point(CheckRec.Left,CheckRec.Bottom))
or PtInRect(SourceRec,Point(CheckRec.Right,CheckRec.Top))
or PtInRect(SourceRec,Point(CheckRec.Right,CheckRec.Bottom));
end;

function TDrawManager.ConvertRect(Rec: TRect): TRect;
Var
Pt:TPoint;
begin
Pt:=Offset;
Result.Left:=Rec.Left+Pt.X;
Result.Right:=Result.Left+Rec.Right-Rec.Left;
Result.Top:=Rec.Top+Pt.Y;
Result.Bottom:=Result.Top+Rec.Bottom-Rec.Top;
end;

function TDrawManager.ResotreRect(Rec: TRect): TRect;
Var
Pt:TPoint;
begin
Pt:=Offset;
Result.Left:=Rec.Left-Pt.X;
Result.Right:=Result.Left+Rec.Right-Rec.Left;
Result.Top:=Rec.Top-Pt.Y;
Result.Bottom:=Result.Top+Rec.Bottom-Rec.Top;
end;

constructor TDrawManager.Create;
begin
OffLock:=TCriticalSection.Create;
end;

destructor TDrawManager.Destroy;
begin
OffLock.Free;
inherited;
end;

function TDrawManager.GetItem(Pt: TPoint): Pointer;
begin
Pt:=Point(Pt.X+FOffset.X,Pt.Y+FOffset.Y);
Result:=InternalGetItemForPt(Pt);
end;

function TDrawManager.GetItem(Rec: TRect): Pointer;
Var
W,H:Integer;
begin
W:=Rec.Right-Rec.Left;
H:=Rec.Bottom-Rec.Top;
Rec.Left:=Rec.Left+FOffset.X;
Rec.Top:=Rec.Top+FOffset.Y;
Rec.Right:=Rec.Left+W;
Rec.Bottom:=Rec.Top+H;
Result:=InternalGetItemForRect(Rec);
end;

function TDrawManager.GetOffset: TPoint;
begin
OffLock.Acquire;
Try
Result:=FOffSet;
Finally
OffLock.Release;
end;
end;

procedure TDrawManager.SetOffset(const Value: TPoint);
begin
OffLock.Acquire;
Try
FOffset := Value;
Finally
OffLock.Release;
end;
end;

{ TCustomDrawManager }

constructor TCustomDrawManager.Create(Size:Integer);
Var
ID:String;
begin
Inherited Create;
Lock:=TCriticalSection.Create;
List:=TList.Create;
ID:=CreateClassID;
CustomFileName:=ExtractFilePath(Application.ExeName)+ID+'.Cus';
BeginMapView(CustomFileName,Size,MapHd,ViewData,ID);
DrawData:=ViewData;
end;

destructor TCustomDrawManager.Destroy;
begin
Clear;
Lock.Free;
List.Free;
EndMapView(MapHd,ViewData);
DeleteFile(CustomFileName);
inherited;
end;

procedure TCustomDrawManager.BeginMapView(ImageFileName:String; Size:Int64; var Hd: THandle;
var Data: Pointer; ID:String);
Var
FileStream:TFileStream;
begin
FileStream:=TFileStream.Create(ImageFileName,fmCreate);
Try
FileStream.Size:=Size;
Finally
FileStream.Free;
FileStream:=nil;
end;
FileStream:=TFileStream.Create(ImageFileName,fmOpenReadWrite or fmShareDenyNone);
Try
Hd:=CreateFileMapping(FileStream.Handle,nil,PAGE_READWRITE,0,0,PChar(ID));
if Hd<>0 then
Data:=MapViewOfFile(Hd,FILE_MAP_ALL_ACCESS,0,0,0);
Finally
FileStream.Free;
FileStream:=nil;
end;
end;

procedure TCustomDrawManager.EndMapView(Hd: THandle; Data: Pointer);
begin
UnmapViewOfFile(Data);
CloseHandle(Hd);
end;

function TCustomDrawManager.InternalGetItemForPt(Pt: TPoint): Pointer;
Var
i:Integer;
dInfoCustomDrawInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to List.Count-1 do
begin
dInfo:=List.Items;
if PtInRect(dInfo.DrawRec,Pt) then
begin
Result:=dInfo;
break;
end;
end;
Finally
Lock.Release;
end;
end;

function TCustomDrawManager.InternalGetItemForRect(Rec: TRect): Pointer;
Var
i:Integer;
dInfoCustomDrawInfo;
begin
Lock.Acquire;
Try
Result:=nil;
For i:=0 to List.Count-1 do
begin
dInfo:=List.Items;
if PtInRect(dInfo.DrawRec,Rec.TopLeft) and PtInRect(dInfo.DrawRec,Rec.BottomRight) then
begin
Result:=dInfo;
break;
end;
end;
Finally
Lock.Release;
end;
end;

function TCustomDrawManager.Add(Info: PCustomDrawInfo): Integer;
Var
Bmp,xBmp:TBitmap;
dInfoCustomDrawInfo;
Stream:TMemoryStream;

Function GetBmp:TBitmap;
Var
Ext:String;
Jpg:TJpegImage;

begin
Ext:=UpperCase(ExtractFileExt(Info.FileName));
if (Ext='.JPEG') or (Ext='.JPG') then
begin
Result:=TBitmap.Create;
Jpg:=TJpegImage.Create;
Try
Jpg.LoadFromFile(Info.FileName);
Result.Assign(Jpg);
Finally
Jpg.Free;
end;
end
else if Ext='.BMP' then
begin
Result:=TBitmap.Create;
Result.LoadFromFile(Info.FileName)
end
else
Result:=nil;
end;
Var
bm:Windows.TBitmap;
begin
Lock.Acquire;
Try
Bmp:=GetBmp;
if Not Assigned(Bmp) then
Exit;

xBmp:=TBitmap.Create;
xBmp.Width:=Info.StretchRect.Right-Info.StretchRect.Left;
xBmp.Height:=Info.StretchRect.Bottom-Info.StretchRect.Top;
xBmp.PixelFormat:=pf24Bit;

xBmp.Canvas.StretchDraw(xBmp.Canvas.ClipRect,Bmp);
if Assigned(Bmp) then
Bmp.Free;

New(dInfo);
dInfo.FileName:=Info.FileName;
dInfo.DrawRec:=Info.DrawRec;
dInfo.Transparent:=Info.Transparent;

dInfo.DrawRec:=ConvertRect(dInfo.DrawRec);
dInfo.StretchRect:=Info.StretchRect;
dInfo.ID:=Info.ID;
dInfo.Data:=Info.Data;

GetObject(xBmp.Handle, sizeof(Windows.TBITMAP),@bm);
CopyMemory(DrawData,bm.bmBits,bm.bmWidthBytes*bm.bmHeight);
dInfo.StretchRect.Right:=bm.bmWidth-1;
dInfo.StretchRect.Bottom:=bm.bmHeight-1;
dInfo.Memory:=DrawData;
Inc(PChar(DrawData),bm.bmWidthBytes*bm.bmHeight);
dInfo.TransparentColor:=GetBitmapTransparentColor(xBmp);

dInfo.DrawTextInfo:=Info.DrawTextInfo;
xBmp.Free;

List.Add(dInfo);
Result:=List.Count-1;
Finally
Lock.Release;
end;
end;

procedure TCustomDrawManager.Clear;
Var
i:Integer;
dInfoCustomDrawInfo;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
Dispose(List.Items);
end;
List.Clear;
DrawData:=ViewData;
Finally
Lock.Release;
end;
end;

procedure TCustomDrawManager.Delete(Index: Integer);
Var
dInfoCustomDrawInfo;
begin
Lock.Acquire;
Try
Finally
Lock.Release;
end;
end;

procedure TCustomDrawManager.Edit(Index: Integer);
Var
dInfoCustomDrawInfo;
begin
Lock.Acquire;
Try
Finally
Lock.Release;
end;
end;

function TCustomDrawManager.DrawTo(BigImageOper: TBigImageOper;
Index: Integer):TRect;
Var
Rec:TRect;
InfoCustomDrawInfo;
begin
if Index>List.Count-1 then
Exit;
Info:=Item(Index);
if Info.Transparent then
BigImageOper.Draw(Info.Memory,Info.StretchRect,Info.DrawRec,
Info.StretchRect.Bottom-Info.StretchRect.Top+1,
Info.StretchRect.Right-Info.StretchRect.Left+1,24,Info.TransparentColor)
else
BigImageOper.Draw(Info.Memory,Info.StretchRect,Info.DrawRec,
Info.StretchRect.Bottom-Info.StretchRect.Top+1,
Info.StretchRect.Right-Info.StretchRect.Left+1,24);
Rec:=BigImageOper.DrawText(@Info.DrawTextInfo,Info.DrawRec);
Result:=ResotreRect(Rec);
end;

function TCustomDrawManager.Item(Index: Integer): PCustomDrawInfo;
begin
Result:=List.Items[Index];
end;

procedure TCustomDrawManager.Restore(BigImageOper: TBigImageOper; DrawRect:TRect);
Var
i:Integer;
InfoCustomDrawInfo;
begin
Lock.Acquire;
Try
For i:=0 to List.Count-1 do
begin
Info:=List.Items;
if CheckRect(Info.DrawRec,DrawRect) then
begin
DrawTo(BigImageOper,i);
end;
end;
Finally
Lock.Release;
end;
end;

function TCustomDrawManager.ConvertRect(Rect: TRect): TRect;
begin
Result:=Inherited ConvertRect(Rect);
end;

procedure TCustomDrawManager.InvalidateText(Info: PDrawTextInfo);
begin

end;

end.

VFW_BigImage就是vfw单元，随便找一个就可以，这个文件是我为一个操纵大的位图文件编写的，你可以直接使用。当年我用它读入显示300M的位图依然很快。

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ExtDlgs, ImgList, Jpeg, ComObj;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
OpenDialog1: TOpenDialog;
Button8: TButton;
Button9: TButton;
ImageList1: TImageList;
Button10: TButton;
Button12: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Button11: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
LabeledEdit1: TLabeledEdit;
Button13: TButton;
FontDialog1: TFontDialog;
Label1: TLabel;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
private
FlashIndex:Integer;
X,Y:Integer;
DrawLine:Boolean;
OldRec,SelectRect:TRect;
bWait:Boolean;

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses BigImageOper;

{$R *.dfm}

Var
ImageOper:TBigImageOper;
Draw:TAddDrawManager;
Flash:TFlashDrawManager;
Custom:TCustomDrawManager;

procedure TForm1.Button1Click(Sender: TObject);
begin
if ImageOper<>nil then
ImageOper.Free;
if OpenDialog1.Execute then
begin
ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{29BD3BB3-B9AF-4C39-B2E6-AE9CF9129851}',0,0);
ScrollBar1.Max:=ImageOper.Width-Image1.Width;
ScrollBar2.Max:=ImageOper.Height-Image1.Height;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
Rec:TRect;
begin
if ImageOper.Double then
begin
ImageOper.ResotreBack(Rect(X,Y,X+Image1.Width,Y+Image1.Height));
end;
Rec:=GetImageRect(Image1.Picture.Bitmap);

ImageOper.DrawTo(Image1.Picture.Bitmap,Rec,Point(0,0));
Image1.Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Self.DoubleBuffered:=true;
FlashIndex:=0;
Randomize();
OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
OpenDialog1.FileName:='长春地图.bmp';
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
Image1.Picture.Bitmap.PixelFormat:=pf24Bit;
end;

procedure TForm1.ScrollBar2Change(Sender: TObject);
Var
Rec:TRect;
begin
//ImageOper.BeginDraw;
Try
Y:=ScrollBar2.Position;
if Y>ScrollBar2.Max then
Y:=ScrollBar2.Max;
if Flash<>nil then
Flash.Offset:=Point(X,Y);
if Custom<>nil then
Custom.Offset:=Point(X,Y);
if Y<=ScrollBar2.Max then
begin
if ImageOper.Double then
ImageOper.ResotreBack(Rect(X,Y,X+Image1.ClientWidth,Y+Image1.ClientHeight));
if Assigned(Custom) then
Custom.Restore(ImageOper,Image1.ClientRect);
ImageOper.DrawTo(Image1.Picture.Bitmap,GetImageRect(Image1.Picture.Bitmap),Point(X,Y));
if Assigned(Flash) then
begin
Flash.Invalidate;
end
else
Image1.Repaint;
end;
Finally
//ImageOper.EndDraw;
end;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
//ImageOper.BeginDraw;
Try
X:=ScrollBar1.Position;
if X>ScrollBar1.Max then
X:=ScrollBar1.Max;
if Flash<>nil then
Flash.Offset:=Point(X,Y);
if Custom<>nil then
Custom.Offset:=Point(X,Y);
if X<=ScrollBar1.Max then
begin
if ImageOper.Double then
ImageOper.ResotreBack(Rect(X,Y,X+Image1.ClientWidth,Y+Image1.ClientHeight));
if Assigned(Custom) then
Custom.Restore(ImageOper,Image1.ClientRect);
ImageOper.DrawTo(Image1.Picture.Bitmap,GetImageRect(Image1.Picture.Bitmap),Point(X,Y));
if Assigned(Flash) then
begin
Flash.Invalidate;
end
else
Image1.Repaint;
end;
Finally
//ImageOper.EndDraw;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
Var
Rec:TRect;
begin
Rec:=GetImageRect(Image1.Picture.Bitmap);
Rec.Right:=Rec.Right;
ImageOper.DrawTo(Image1.Canvas.Handle,Rec,Point(X,Y));
Image1.Repaint;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Image1.Repaint;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ImageOper.DrawTo(Image1.Canvas.Handle,GetImageRect(Image1.Picture.Bitmap),Rect(X,Y,X+100,Y+100));
Image1.Repaint;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
OpenDialog1.InitialDir:='C:/';
OpenDialog1.FileName:='cjgcpmt 拷贝.bmp';
if Not OpenDialog1.Execute then
Exit;

if Draw<>nil then
Draw.Free;
Draw:=TAddDrawManager.Create(OpenDialog1.FileName,'{29BD3BB3-B9AF-4C39-B2E6-AE9CF9129851}',6000,8000,true,true,30);

if ImageOper<>nil then
ImageOper.Free;
ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{29BD3BB3-B9AF-4C39-B2E6-AE9CF9129851}',6000,8000,true,true);
ScrollBar1.Max:=ImageOper.Width-Image1.Width;
ScrollBar2.Max:=ImageOper.Height-Image1.Height;
end;

procedure TForm1.Button7Click(Sender: TObject);
Var
i:Integer;
Info:TDrawInfo;
begin
OpenDialog1.InitialDir:='E:/新图片';
OpenDialog1.FileName:='';
if OpenDialog1.Execute then
begin
For i:=0 to OpenDialog1.Files.Count-1 do
begin
Info.FileName:=OpenDialog1.Files.Strings;
Draw.Add(@Info,i);
end;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Draw<>nil then
Draw.Free;

if ImageOper<>nil then
ImageOper.Free;

if Flash<>nil then
Flash.Free;

if Custom<>nil then
Custom.Free;
end;

procedure TForm1.Button8Click(Sender: TObject);
Var
i:Integer;
Bmp:TBitmap;
Function GetBmp:TBitmap;
Var
Ext:String;
Jpg:TJpegImage;
Ico:TICON;

begin
Ext:=UpperCase(ExtractFileExt(OpenDialog1.Files.Strings));
if (Ext='.JPEG') or (Ext='.JPG') then
begin
Result:=TBitmap.Create;
Jpg:=TJpegImage.Create;
Try
Jpg.LoadFromFile(OpenDialog1.Files.Strings);
Result.Assign(Jpg);
Finally
Jpg.Free;
end;
end
else if Ext='.BMP' then
begin
Result:=TBitmap.Create;
Result.LoadFromFile(OpenDialog1.Files.Strings)
end
else if (Ext='.ICO') or (Ext='.ICON') then
begin
Result:=TBitmap.Create;
Ico:=TICON.Create;
Try
Ico.LoadFromFile(OpenDialog1.Files.Strings);
Result.Width:=Ico.Width;
Result.Height:=Ico.Height;
Result.PixelFormat:=pf24Bit;
Result.Canvas.Draw(0,0,Ico);
Finally
Ico.Free;
end;
end
else
Result:=nil;
end;
begin
OpenDialog1.InitialDir:='D:/图标/图标/B/B/24024';
OpenDialog1.FileName:='';
if OpenDialog1.Execute then
begin
For i:=0 to OpenDialog1.Files.Count-1 do
begin
Bmp:=GetBmp;
Try
if Assigned(bmp) then
Flash.AddHot(Bmp);
Finally
if Assigned(bmp) then
Bmp.Free;
end;
end;
end;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
OpenDialog1.InitialDir:='C:/';
OpenDialog1.FileName:='cjgcpmt 拷贝.bmp';
if Not OpenDialog1.Execute then
Exit;

if Flash<>nil then
Flash.Free;
Flash:=TFlashDrawManager.Create(Image1,100,75,100,OpenDialog1.FileName,'{ACB49EA1-7D2E-434F-83AF-DFC5F937F76D}',0,0,true,true);

if ImageOper<>nil then
ImageOper.Free;
ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{ACB49EA1-7D2E-434F-83AF-DFC5F937F76D}',0,0,true,true);
ScrollBar1.Max:=ImageOper.Width-Image1.Width;
ScrollBar2.Max:=ImageOper.Height-Image1.Height;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawRec(Rec:TRect);
begin
Image1.Canvas.Pen.Mode:=pmXor;
Image1.Canvas.Pen.Color:=clBlue;
Image1.Canvas.MoveTo(Rec.Left,Rec.Top);
Image1.Canvas.LineTo(Rec.Right,Rec.Top);
Image1.Canvas.LineTo(Rec.Right,Rec.Bottom);
Image1.Canvas.LineTo(Rec.Left,Rec.Bottom);
Image1.Canvas.LineTo(Rec.Left,Rec.Top);
Image1.Canvas.Pen.Mode:=pmBlack;
end;
begin
{
if DrawLine then
begin
if Not EqualRect(OldRec,Rect(0,0,0,0)) then
DrawRec(OldRec);
OldRec:=Rect(dX,dY,x,y);
DrawRec(OldRec);
end;
}
end;

procedure TForm1.Image1Click(Sender: TObject);
Var
fInfoFlashInfo;
cInfoCustomDrawInfo;
InfoDrawInfo;
Pt:TPoint;
begin

if Draw<>nil then
begin
GetCursorPos(Pt);
Pt:=Image1.ScreenToClient(Pt);
Info:=Draw.GetItem(Pt);
if Info<>nil then
begin
ShowMessage(Info.FileName);
Exit;
end;
end;
if Flash<>nil then
begin
GetCursorPos(Pt);
Pt:=Image1.ScreenToClient(Pt);
fInfo:=Flash.GetItem(Pt);
if fInfo<>nil then
begin
ShowMessage(fInfo.ID);
Exit;
end;
end;
if Custom<>nil then
begin
GetCursorPos(Pt);
Pt:=Image1.ScreenToClient(Pt);
cInfo:=Custom.GetItem(Pt);
if cInfo<>nil then
begin
ShowMessage(cInfo.ID);
end;
end;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
OpenDialog1.InitialDir:='C:/';
OpenDialog1.FileName:='cjgcpmt 拷贝.bmp';
if Not OpenDialog1.Execute then
Exit;

if Flash<>nil then
Flash.Free;
Flash:=TFlashDrawManager.Create(Image1,100,32,32,OpenDialog1.FileName,'{ACB49EA1-7D2E-434F-83AF-DFC5F937F76D}',0,0,true,true);

if Custom<>nil then
Custom.Free;
Custom:=TCustomDrawManager.Create(30*1024*1024);

if ImageOper<>nil then
ImageOper.Free;
ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{ACB49EA1-7D2E-434F-83AF-DFC5F937F76D}',0,0,true,true);
ScrollBar1.Max:=ImageOper.Width-Image1.Width;
ScrollBar2.Max:=ImageOper.Height-Image1.Height;

end;

procedure TForm1.Button12Click(Sender: TObject);
begin
OpenDialog1.InitialDir:='C:/';
OpenDialog1.FileName:='cjgcpmt 拷贝.bmp';
if Not OpenDialog1.Execute then
Exit;

if Custom<>nil then
Custom.Free;
Custom:=TCustomDrawManager.Create(30*1024*1024);

if ImageOper<>nil then
ImageOper.Free;
ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{29BD3BB3-B9AF-4C39-B2E6-AE9CF9129851}',6000,8000,true,true);
ScrollBar1.Max:=ImageOper.Width-Image1.Width;
ScrollBar2.Max:=ImageOper.Height-Image1.Height;
end;

procedure TForm1.Image1DblClick(Sender: TObject);
Var
i,Index:Integer;
Rec:TRect;
Info:TFlashInfo;
cInfo:TCustomDrawInfo;
Pt:TPoint;
ppt:TPoint;
IsShift:Boolean;
vKey:Integer;
TextRect:TRect;
begin
vKey:=GetKeyState(VK_SHIFT);
IsShift:=vkey and $80000000<>0;

if RadioButton3.Checked then
Exit;

GetCursorPos(ppt);
ppt:=Image1.ScreenToClient(ppt);
if RadioButton2.Checked and (Custom<>nil) then
begin
OpenDialog1.InitialDir:='E:/新图片';
OpenDialog1.FileName:='';
if OpenDialog1.Execute then
begin
cInfo.FileName:=OpenDialog1.FileName;
cInfo.DrawRec:=Rect(ppt.X,ppt.Y,ppt.X+113,ppt.Y+150);
cInfo.StretchRect:=Rect(0,0,113,150);
cInfo.ID:=CreateClassID;
cInfo.Data:=nil;
cInfo.DrawTextInfo.Drawed:=false;
cInfo.Transparent:=CheckBox1.Checked;
With cInfo.DrawTextInfo do
begin
Drawed:=CheckBox2.Checked;
Text:=LabeledEdit1.Text;
Case ComboBox1.ItemIndex of
0:Align:=alLeft;
1:Align:=alRight;
2:Align:=alTop;
3:Align:=alBottom;
end;

Pt:=Point(MaxInt,MaxInt);
Charset:=FontDialog1.Font.Charset;
Color:=FontDialog1.Font.Color;
Height:=FontDialog1.Font.Height;
Name:=FontDialog1.Font.Name;
Pitch:=FontDialog1.Font.Pitch;
Size:=FontDialog1.Font.Size;
Style:=FontDialog1.Font.Style;
end;
Index:=Custom.Add(@cInfo);
TextRect:=Custom.DrawTo(ImageOper,Index);
Pt:=Point(ppt.X+113,ppt.Y+150);

if Pt.X>Image1.Picture.Bitmap.Width-1 then
Pt.X:=Image1.Picture.Bitmap.Width-1;

if Pt.Y>Image1.Picture.Bitmap.Height-1 then
Pt.Y:=Image1.Picture.Bitmap.Height-1;
Rec:=Rect(ppt.X,ppt.Y,Pt.X,Pt.Y);

ImageOper.DrawTo(Image1.Picture.Bitmap,Rec,Custom.ConvertRect(cInfo.DrawRec));
ImageOper.DrawTo(Image1.Picture.Bitmap,TextRect,Custom.ConvertRect(TextRect));
Rec.TopLeft:=Image1.Parent.ScreenToClient(Image1.ClientToScreen(Rec.TopLeft));
Rec.BottomRight:=Image1.Parent.ScreenToClient(Image1.ClientToScreen(Rec.BottomRight));
InvalidateRect(Image1.Parent.Handle,@Rec,false);
TextRect.TopLeft:=Image1.Parent.ScreenToClient(Image1.ClientToScreen(TextRect.TopLeft));
TextRect.BottomRight:=Image1.Parent.ScreenToClient(Image1.ClientToScreen(TextRect.BottomRight));
InvalidateRect(Image1.Parent.Handle,@TextRect,false);
end;
Exit;
end;

if RadioButton1.Checked and Assigned(Flash) then
begin
if Flash.HotCount<=0 then
Exit;
SelectRect:=Rect(ScrollBar1.Position+ppt.X,ScrollBar2.Position+ppt.Y,0,0);
if Assigned(Flash) then
begin
Info.Images:=ImageList1;
SetLength(Info.Indexs,Flash.HotCount);
For i:=0 to High(Info.Indexs) do
begin
Info.Indexs:=Random(Flash.GetHotCount-1);
end;
Rec:=Rect(ppt.X,ppt.Y,ppt.X+Flash.HotWidth,ppt.Y+Flash.HotHeight);
Info.ImageRec:=Rec;
Info.Transparent:=CheckBox1.Checked;
Rec.TopLeft:=Image1.ClientToScreen(Rec.TopLeft);
Rec.TopLeft:=Image1.Parent.ScreenToClient(Rec.TopLeft);
Rec.BottomRight:=Image1.ClientToScreen(Rec.BottomRight);
Rec.BottomRight:=Image1.Parent.ScreenToClient(Rec.BottomRight);
Info.UpdateHandle:=Image1.Parent.Handle;
Info.UpdateRect:=Rec;
Info.Rec:=SelectRect;
if IsShift then
Info.Times:=1000*10
else
Info.Times:=DWORD(-1);
Info.ID:='标识号:'+IntToStr(FlashIndex);
Inc(FlashIndex);
Flash.Add(@Info);
end;
end;
DrawLine:=false;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
bWait:=Not bWait;
if bWait then
ImageOper.BeginDraw
else
ImageOper.EndDraw;
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
FontDialog1.Execute;
end;

end.

wokao,大哥，你太猛了吧，这么长，看的我都蒙了，能不能大概说一下哪几个函数和我这个关系比较大，比如：哪个实现将bmp图映射进内存？哪个又将映射进去的画出来？，谢谢！大概提示一下就行
（我所操作的图片可没有你的大，也就十几M）

ImageOper:=TBigImageOper.Create(OpenDialog1.FileName,'{29BD3BB3-B9AF-4C39-B2E6-AE9CF9129851}',0,0);//建立
ImageOper.DrawTo(Image1.Picture.Bitmap,GetImageRect(Image1.Picture.Bitmap),Point(X,Y));//画到image上
其他的你自己测试吧

成功，谢谢了