paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 13:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache

Browse Source 
git-svn-id: trunk@5769 -
This commit is contained in:
mattias 2004-08-11 20:57:09 +00:00
parent b884614dd5
commit 581bef95fc
15 changed files with 617 additions and 546 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1366,7 +1366,6 @@ lcl/interfaces/win32/win32wsstdctrls.pp svneol=native#text/pascal
lcl/interfaces/win32/win32wstoolwin.pp svneol=native#text/pascal
lcl/interfaces/win32/winext.pas svneol=native#text/pascal
lcl/intfgraphics.pas svneol=native#text/pascal
lcl/intfstrconsts.pas svneol=native#text/pascal
lcl/languages/lcl.ca.po svneol=native#text/plain
lcl/languages/lcl.de.po svneol=native#text/plain
lcl/languages/lcl.es.po svneol=native#text/plain
@ -1387,6 +1386,7 @@ lcl/lclicons.lrs svneol=native#text/pascal
lcl/lclintf.pas svneol=native#text/pascal
lcl/lclmemmanager.pas svneol=native#text/pascal
lcl/lclproc.pas svneol=native#text/pascal
lcl/lclrescache.pas svneol=native#text/pascal
lcl/lclstrconsts.pas svneol=native#text/pascal
lcl/lcltype.pp svneol=native#text/pascal
lcl/lmessages.pp svneol=native#text/pascal

4
lcl/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/07/25]
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/08/08]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos
@ -263,7 +263,7 @@ endif
endif
override TARGET_DIRS+=interfaces
override TARGET_UNITS+=alllclunits
override TARGET_IMPLICITUNITS+=actnlist arrow avglvltree buttons calendar checklst clipbrd clistbox comctrls commctrl controls dbctrls dbgrids dialogs dynamicarray dynhasharray editbtn extctrls extdlgs extendedstrings extgraphics filectrl forms fpcadds graphics graphmath graphtype grids imglist inipropstorage interfacebase lazlinkedlist lclintf lclmemmanager lclproc lclstrconsts lcltype lmessages lresources maskedit menus pairsplitter postscriptprinter printers propertystorage spin stdactns stdctrls stringhashlist textstrings toolwin utrace xmlpropstorage vclglobals
override TARGET_IMPLICITUNITS+=actnlist arrow avglvltree buttons calendar checklst clipbrd clistbox comctrls commctrl controls dbactns dbctrls dbgrids dialogs dynamicarray dynhasharray editbtn extctrls extdlgs extendedstrings extgraphics filectrl forms fpcadds graphics graphmath graphtype grids imglist inipropstorage interfacebase lazlinkedlist lclintf lclmemmanager lclproc lclreschache lclstrconsts lcltype lmessages lresources maskedit menus pairsplitter postscriptprinter printers propertystorage spin stdactns stdctrls stringhashlist textstrings toolwin utrace xmlpropstorage vclglobals
override TARGET_RSTS+=lclstrconsts
override CLEAN_FILES+=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) $(wildcard ./units/*$(OEXT)) $(wildcard ./units/*$(PPUEXT)) $(wildcard ./units/*$(RSTEXT)) $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
override COMPILER_OPTIONS+=-gl

1
lcl/Makefile.fpc
View File

@ -48,6 +48,7 @@ implicitunits= \
lclintf \
lclmemmanager \
lclproc \
lclreschache \
lclstrconsts \
lcltype \
lmessages \

5
lcl/alllclunits.pp
View File

@ -35,7 +35,7 @@ uses
FPCAdds, LazLinkedList, DynHashArray, LCLMemManager, AvgLvlTree,
StringHashList, ExtendedStrings, DynamicArray, UTrace, TextStrings,
// base types and base functions
LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages,
LCLProc, LCLType, LCLResCache, GraphMath, VCLGlobals, FileCtrl, LMessages,
// the interface base
InterfaceBase,
{$IFNDEF DisableFPImage}IntfGraphics,{$ENDIF}
@ -63,6 +63,9 @@ end.
{ =============================================================================
$Log$
Revision 1.18 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.17 2004/08/03 10:01:22 mattias
added DBActns from Michael VC

1
lcl/forms.pp
View File

@ -1330,6 +1330,7 @@ begin
Application.Free;
Application:=nil;
FreeAllClipBoards;
CallInterfaceFinalizationHandlers;
InterfaceObject.Free;
InterfaceObject:=nil;
end;

62
lcl/graphics.pp
View File

@ -42,11 +42,8 @@ uses
{$IFNDEF DisableFPImage}
FPImage, FPReadPNG, FPWritePNG, FPReadBMP, FPWriteBMP, IntfGraphics,
{$ENDIF}
{$IFDEF UseSimpleJpeg}
FPReadJpeg,FPWriteJpeg,
{$ENDIF}
LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLIntf, LResources,
GraphType, GraphMath;
LCLStrConsts, vclGlobals, LCLType, LCLProc, LMessages, LCLIntf, LResources,
LCLResCache, GraphType, GraphMath;
type
PColor = ^TColor;
@ -106,13 +103,6 @@ type
pmNotMask, pmXor, pmNotXor
);
TPenData = record
Handle: HPen;
Color: TColor;
Width: Integer;
Style: TPenStyle;
end;
TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal,
bsBDiagonal, bsCross, bsDiagCross);
@ -371,9 +361,9 @@ type
TIcon = class; // ico
TPortableNetworkGraphic = class; // png
{$IFDEF UseSimpleJpeg}
{$error will be added to the LCL, when fpc 2.0 is released. Use the jpeg package in the components/jpeg directory instead. }
// MG: will be added to the LCL, when fpc 2.0 is released
// but then with the advanced features of the existing package
TJpegImage = class; // jpg
{$ENDIF}
@ -393,7 +383,7 @@ type
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{ TFont }
@ -457,11 +447,26 @@ type
{ TPen }
TPenData = record
Handle: HPen;
Color: TColor;
Width: Integer;
Style: TPenStyle;
end;
TPenHandleCache = class(TBlockResourceCache)
protected
procedure RemoveItem(Item: TResourceCacheItem); override;
public
constructor Create;
end;
TPen = class(TGraphicsObject)
private
FPenData: TPenData;
FMode: TPenMode;
FPenHandleCached: boolean;
procedure FreeHandle;
protected
function GetHandle: HPEN;
@ -469,7 +474,7 @@ type
procedure SetColor(Value: TColor);
procedure SetMode(Value: TPenMode);
procedure SetStyle(Value: TPenStyle);
procedure Setwidth(value: Integer);
procedure SetWidth(value: Integer);
public
constructor Create;
destructor Destroy; override;
@ -1115,18 +1120,6 @@ type
end;
{$IFDEF UseSimpleJpeg}
{ TJpegImage }
TJpegImage = class(TFPImageBitmap)
public
class function GetFileExtensions: string; override;
class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
end;
{$ENDIF}
{ TIcon }
{
TIcon reads and writes .ICO file format.
@ -1223,6 +1216,8 @@ function ReadXPMSize(XPM: PPChar; var Width, Height, ColorCount: integer
var
{ Stores information about the current screen }
ScreenInfo: TLMScreenInit;
PenResourceCache: TPenHandleCache;
const
FontCharsets: array[0..18] of TIdentMapEntry = (
@ -1680,13 +1675,21 @@ begin
end;
{$ENDIF}
procedure InterfaceFinal;
begin
//debugln('Graphics.InterfaceFinal');
FreeAndNil(PenResourceCache);
end;
initialization
PicClipboardFormats:=nil;
PicFileFormats:=nil;
OnLoadGraphicFromClipboardFormat:=nil;
OnSaveGraphicToClipboardFormat:=nil;
PenResourceCache:=TPenHandleCache.Create;
RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
RegisterInterfaceFinalizationHandler(@InterfaceFinal);
finalization
GraphicsFinalized:=true;
@ -1701,6 +1704,9 @@ end.
{ =============================================================================
$Log$
Revision 1.140 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.139 2004/05/25 21:50:32 mattias
TCustomNotebook now allows pageclass descendents
@ -2406,4 +2412,4 @@ end.
Finished the TColorDialog added to comDialog example. MAH
}
}

4
lcl/include/brush.inc
View File

@ -149,6 +149,7 @@ var
begin
if FBrushData.Handle = 0
then begin
FillChar(LogBrush,SizeOf(LogBrush),0);
with LogBrush do
begin
if FBrushData.Bitmap <> nil
@ -195,6 +196,9 @@ end;
{ =============================================================================
$Log$
Revision 1.8 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.7 2004/04/10 17:58:56 mattias
implemented mainunit hints for include files

38
lcl/include/pen.inc
View File

@ -16,6 +16,23 @@
* *
*****************************************************************************
}
{ TPenHandleCache }
procedure TPenHandleCache.RemoveItem(Item: TResourceCacheItem);
begin
//debugln('TPenHandleCache.RemoveItem ',HexStr(Cardinal(Item.Handle),8));
DeleteObject(Item.Handle);
inherited RemoveItem(Item);
end;
constructor TPenHandleCache.Create;
begin
inherited Create(SizeOf(TPenData));
end;
{ TPen }
{------------------------------------------------------------------------------
Method: TPen.SetColor
Params: Value: the new value
@ -166,16 +183,26 @@ const
PS_SOLID,PS_DASH,PS_DOT,PS_DASHDOT,PS_DASHDOTDOT,PS_NULL,PS_INSIDEFRAME);
var
LogPen: TLogPen;
CachedPen: TBlockResourceCacheDescriptor;
begin
if FPenData.Handle = 0
then begin
FillChar(LogPen,SizeOf(LogPen),0);
with LogPen do
begin
lopnStyle := PEN_STYLES[FPenData.Style];
lopnWidth.X := FPenData.Width;
lopnColor := FPenData.Color;
end;
FPenData.Handle := CreatePenIndirect(LogPen);
CachedPen:=PenResourceCache.FindDescriptor(@LogPen);
if CachedPen<>nil then begin
CachedPen.Item.IncreaseRefCount;
FPenData.Handle := CachedPen.Item.Handle;
end else begin
FPenData.Handle := CreatePenIndirect(LogPen);
PenResourceCache.AddResource(FPenData.Handle,@LogPen);
end;
FPenHandleCached:=true;
end;
Result := FPenData.Handle;
@ -194,7 +221,11 @@ begin
then begin
// Changing triggers deselecting the current handle
Changing;
DeleteObject(FPenData.Handle);
if FPenHandleCached then begin
PenResourceCache.FindItem(FPenData.Handle).DecreaseRefCount;
FPenHandleCached:=false;
end else
DeleteObject(FPenData.Handle);
FPenData.Handle := 0;
end;
end;
@ -202,6 +233,9 @@ end;
{ =============================================================================
$Log$
Revision 1.10 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.9 2004/04/10 17:58:57 mattias
implemented mainunit hints for include files

10
lcl/interfacebase.pp
View File

@ -33,8 +33,8 @@ interface
{$endif}
uses
Classes, SysUtils, Math, FPCAdds, LCLType, LCLProc, VCLGlobals, LMessages,
GraphType, GraphMath, IntfStrConsts;
Classes, SysUtils, Math, FPCAdds, LCLStrConsts, LCLType, LCLProc, VCLGlobals,
LMessages, GraphType, GraphMath;
type
@ -51,7 +51,8 @@ type
procedure AppInit; virtual; abstract;
procedure AppTerminate; virtual; abstract;
function InitHintFont(HintFont: TObject): Boolean; virtual;
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: pointer): integer; virtual; abstract;
function IntSendMessage3(LM_Message: Integer; Sender: TObject;
Data: pointer): integer; virtual; abstract;
// create and destroy
function CreateComponent(Sender : TObject): THandle; virtual; abstract;
@ -113,6 +114,9 @@ end.
{
$Log$
Revision 1.47 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.46 2004/03/19 00:53:34 marc
* Removed all ComponentCreateHandle routines

409
lcl/interfaces/gtk/gtkfontcache.pas
View File

@ -19,126 +19,9 @@ unit GtkFontCache;
interface
uses
Classes, SysUtils, FPCAdds, LCLProc, LCLType, AvgLvlTree, gdk, gtkdef;
Classes, SysUtils, FPCAdds, LCLProc, LCLType, AvgLvlTree, gdk, gtkdef,
LCLResCache;
type
TResourceCache = class;
TResourceCacheDescriptor = class;
{ TResourceCacheItem }
TResourceCacheItem = class
private
FReferenceCount: integer;
public
Handle: THandle;
Cache: TResourceCache;
FirstDescriptor, LastDescriptor: TResourceCacheDescriptor;
Next, Prev: TResourceCacheItem;
constructor Create(TheCache: TResourceCache; TheHandle: THandle);
destructor Destroy; override;
procedure IncreaseRefCount;
procedure DecreaseRefCount;
procedure AddToList(var First, Last: TResourceCacheItem);
procedure RemoveFromList(var First, Last: TResourceCacheItem);
procedure WarnReferenceHigh; virtual;
public
property ReferenceCount: integer read FReferenceCount;
end;
TResourceCacheItemClass = class of TResourceCacheItem;
{ TResourceCacheDescriptor }
TResourceCacheDescriptor = class
public
Item: TResourceCacheItem;
Cache: TResourceCache;
Next, Prev: TResourceCacheDescriptor;
constructor Create(TheCache: TResourceCache; TheItem: TResourceCacheItem);
destructor Destroy; override;
procedure AddToList(var First, Last: TResourceCacheDescriptor);
procedure RemoveFromList(var First, Last: TResourceCacheDescriptor);
end;
TResourceCacheDescriptorClass = class of TResourceCacheDescriptor;
{ TResourceCache }
TResourceCache = class
protected
FItems: TAvgLvlTree;
FDescriptors: TAvgLvlTree;
FDestroying: boolean;
FResourceCacheDescriptorClass: TResourceCacheDescriptorClass;
FResourceCacheItemClass: TResourceCacheItemClass;
FMaxUnusedItem: integer; // how many freed resources to keep
FFirstUnusedItem, FLastUnusedItem: TResourceCacheItem;
FUnUsedItemCount: integer;
procedure RemoveItem(Item: TResourceCacheItem); virtual;
procedure RemoveDescriptor(Desc: TResourceCacheDescriptor); virtual;
procedure ItemUsed(Item: TResourceCacheItem);
procedure ItemUnused(Item: TResourceCacheItem);
function ItemIsUsed(Item: TResourceCacheItem): boolean;
public
constructor Create;
destructor Destroy; override;
function CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer): integer; virtual;
function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; virtual; abstract;
procedure ConsistencyCheck;
public
property MaxUnusedItem: integer read FMaxUnusedItem
write FMaxUnusedItem;
property ResourceCacheItemClass: TResourceCacheItemClass
read FResourceCacheItemClass;
property ResourceCacheDescriptorClass: TResourceCacheDescriptorClass
read FResourceCacheDescriptorClass;
end;
{ THandleResourceCache }
THandleResourceCache = class(TResourceCache)
public
function FindItem(Handle: THandle): TResourceCacheItem;
end;
{ TBlockResourceCacheDescriptor }
TBlockResourceCacheDescriptor = class(TResourceCacheDescriptor)
public
Data: Pointer;
destructor Destroy; override;
end;
{ TBlockResourceCache }
TBlockResourceCache = class(THandleResourceCache)
private
FDataSize: integer;
protected
FOnCompareDescPtrWithDescriptor: TListSortCompare;
public
constructor Create(TheDataSize: integer);
function FindDescriptor(DescPtr: Pointer): TBlockResourceCacheDescriptor;
function AddResource(Handle: THandle; DescPtr: Pointer
): TBlockResourceCacheDescriptor;
function CompareDescriptors(Tree: TAvgLvlTree;
Desc1, Desc2: Pointer): integer; override;
public
property DataSize: integer read FDataSize;
property OnCompareDescPtrWithDescriptor: TListSortCompare
read FOnCompareDescPtrWithDescriptor;
end;
function ComparePHandleWithResourceCacheItem(HandlePtr: PHandle;
Item: TResourceCacheItem): integer;
function CompareDescPtrWithBlockResDesc(DescPtr: Pointer;
Item: TBlockResourceCacheDescriptor): integer;
type
TGdkFontCacheDescriptor = class;
@ -202,19 +85,6 @@ type
end;
PLogFontAndName = ^TLogFontAndName;
function ComparePHandleWithResourceCacheItem(HandlePtr: PHandle;
Item: TResourceCacheItem): integer;
begin
Result:=CompareHandles(HandlePtr^,Item.Handle);
end;
function CompareDescPtrWithBlockResDesc(DescPtr: Pointer;
Item: TBlockResourceCacheDescriptor): integer;
begin
Result:=CompareMemRange(DescPtr,Item.Data,
TBlockResourceCache(Item.Cache).DataSize);
end;
function LogFontToString(const LogFont: TLogFont): string;
var
i: Integer;
@ -241,281 +111,6 @@ begin
end;
{ TResourceCacheItem }
constructor TResourceCacheItem.Create(TheCache: TResourceCache;
TheHandle: THandle);
begin
Cache:=TheCache;
Handle:=TheHandle;
end;
destructor TResourceCacheItem.Destroy;
begin
Cache.RemoveItem(Self);
inherited Destroy;
end;
procedure TResourceCacheItem.IncreaseRefCount;
begin
inc(FReferenceCount);
if FReferenceCount=1 then
Cache.ItemUsed(Self);
if (FReferenceCount=100) or (FReferenceCount=1000) then
WarnReferenceHigh;
end;
procedure TResourceCacheItem.DecreaseRefCount;
begin
if FReferenceCount=0 then
RaiseGDBException('TResourceCacheItem.DecreaseRefCount=0');
dec(FReferenceCount);
if FReferenceCount=0 then
Cache.ItemUnused(Self);
end;
procedure TResourceCacheItem.AddToList(var First, Last: TResourceCacheItem
);
// add as last
begin
Next:=nil;
Prev:=Last;
Last:=Self;
if First=nil then First:=Self;
if Prev<>nil then Prev.Next:=Self;
end;
procedure TResourceCacheItem.RemoveFromList(var First,Last: TResourceCacheItem);
begin
if First=Self then First:=Next;
if Last=Self then Last:=Prev;
if Next<>nil then Next.Prev:=Prev;
if Prev<>nil then Prev.Next:=Next;
Next:=nil;
Prev:=nil;
end;
procedure TResourceCacheItem.WarnReferenceHigh;
begin
debugln('WARNING: TResourceCacheItem.IncreaseRefCount ',dbgs(FReferenceCount));
end;
{ TResourceCacheDescriptor }
constructor TResourceCacheDescriptor.Create(TheCache: TResourceCache;
TheItem: TResourceCacheItem);
begin
Cache:=TheCache;
Item:=TheItem;
Item.IncreaseRefCount;
AddToList(Item.FirstDescriptor,Item.LastDescriptor);
end;
destructor TResourceCacheDescriptor.Destroy;
begin
Cache.RemoveDescriptor(Self);
inherited Destroy;
end;
procedure TResourceCacheDescriptor.AddToList(
var First, Last: TResourceCacheDescriptor);
// add as last
begin
Next:=nil;
Prev:=Last;
Last:=Self;
if First=nil then First:=Self;
if Prev<>nil then Prev.Next:=Self;
end;
procedure TResourceCacheDescriptor.RemoveFromList(
var First, Last: TResourceCacheDescriptor);
begin
if First=Self then First:=Next;
if Last=Self then Last:=Prev;
if Next<>nil then Next.Prev:=Prev;
if Prev<>nil then Prev.Next:=Next;
Next:=nil;
Prev:=nil;
end;
{ TResourceCache }
procedure TResourceCache.RemoveItem(Item: TResourceCacheItem);
begin
if FDestroying then exit;
while Item.FirstDescriptor<>nil do Item.FirstDescriptor.Free;
FItems.Remove(Item);
end;
procedure TResourceCache.RemoveDescriptor(Desc: TResourceCacheDescriptor);
begin
if FDestroying then exit;
Desc.RemoveFromList(Desc.Item.FirstDescriptor,Desc.Item.LastDescriptor);
FDescriptors.Remove(Desc);
if Desc.Item.FirstDescriptor=nil then
Desc.Item.Free;
end;
procedure TResourceCache.ItemUsed(Item: TResourceCacheItem);
// called after creation or when Item is used again
begin
if not ItemIsUsed(Item) then begin
Item.RemoveFromList(FFirstUnusedItem,FLastUnusedItem);
dec(FUnUsedItemCount);
end;
end;
procedure TResourceCache.ItemUnused(Item: TResourceCacheItem);
// called when Item is not used any more
begin
if not ItemIsUsed(Item) then
raise Exception.Create('TResourceCache.ItemUnused');
Item.AddToList(FFirstUnusedItem,FLastUnusedItem);
inc(FUnUsedItemCount);
if FUnUsedItemCount>FMaxUnusedItem then
// maximum unused resources reached -> free the oldest
FFirstUnusedItem.Free;
end;
function TResourceCache.ItemIsUsed(Item: TResourceCacheItem): boolean;
begin
Result:=(FFirstUnusedItem<>Item) and (Item.Next=nil)
and (Item.Prev=nil)
end;
constructor TResourceCache.Create;
begin
FMaxUnusedItem:=100;
FItems:=TAvgLvlTree.CreateObjectCompare(@CompareItems);
FDescriptors:=TAvgLvlTree.CreateObjectCompare(@CompareDescriptors);
FResourceCacheItemClass:=TResourceCacheItem;
FResourceCacheDescriptorClass:=TResourceCacheDescriptor;
end;
destructor TResourceCache.Destroy;
begin
FDestroying:=true;
FItems.FreeAndClear;
FItems.Free;
FItems:=nil;
FDescriptors.FreeAndClear;
FDescriptors.Free;
FDescriptors:=nil;
inherited Destroy;
end;
function TResourceCache.CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer
): integer;
begin
Result:=CompareHandles(TResourceCacheItem(Item1).Handle,
TResourceCacheItem(Item2).Handle);
end;
procedure TResourceCache.ConsistencyCheck;
var
ANode: TAvgLvlTreeNode;
Item: TResourceCacheItem;
begin
if (FFirstUnusedItem=nil) xor (FLastUnusedItem=nil) then
RaiseGDBException('');
// check items
ANode:=FItems.FindLowest;
while ANode<>nil do begin
Item:=TResourceCacheItem(ANode.Data);
if Item.FirstDescriptor=nil then
RaiseGDBException('');
if Item.LastDescriptor=nil then
RaiseGDBException('');
ANode:=FItems.FindSuccessor(ANode);
end;
end;
{ THandleResourceCache }
function THandleResourceCache.FindItem(Handle: THandle): TResourceCacheItem;
var
ANode: TAvgLvlTreeNode;
begin
ANode:=FItems.FindKey(@Handle,@ComparePHandleWithResourceCacheItem);
if ANode<>nil then
Result:=TResourceCacheItem(ANode.Data)
else
Result:=nil;
end;
{ TBlockResourceCache }
constructor TBlockResourceCache.Create(TheDataSize: integer);
begin
inherited Create;
FDataSize:=DataSize;
FResourceCacheDescriptorClass:=TBlockResourceCacheDescriptor;
FOnCompareDescPtrWithDescriptor:=@CompareDescPtrWithBlockResDesc;
end;
function TBlockResourceCache.FindDescriptor(DescPtr: Pointer
): TBlockResourceCacheDescriptor;
var
ANode: TAvgLvlTreeNode;
begin
ANode:=FDescriptors.FindKey(DescPtr,FOnCompareDescPtrWithDescriptor);
if ANode<>nil then
Result:=TBlockResourceCacheDescriptor(ANode.Data)
else
Result:=nil;
end;
function TBlockResourceCache.AddResource(Handle: THandle; DescPtr: Pointer
): TBlockResourceCacheDescriptor;
var
Item: TResourceCacheItem;
procedure RaiseDescriptorAlreadyAdded;
var
Msg: String;
i: Integer;
begin
Msg:='TBlockResourceCache.AddResource Descriptor Already Added '#13;
for i:=0 to DataSize-1 do
Msg:=Msg+hexstr(ord(PChar(DescPtr)[i]),2);
raise Exception.Create(Msg);
end;
begin
Result:=FindDescriptor(DescPtr);
if Result<>nil then
RaiseDescriptorAlreadyAdded;
Item:=FindItem(Handle);
if Item=nil then begin
Item:=FResourceCacheItemClass.Create(Self,Handle);
FItems.Add(Item);
end;
Result:=TBlockResourceCacheDescriptor(
FResourceCacheDescriptorClass.Create(Self,Item));
ReAllocMem(Result.Data,DataSize);
System.Move(DescPtr^,Result.Data^,DataSize);
FDescriptors.Add(Result);
end;
function TBlockResourceCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1,
Desc2: Pointer): integer;
begin
Result:=CompareMemRange(TBlockResourceCacheDescriptor(Desc1).Data,
TBlockResourceCacheDescriptor(Desc2).Data,
DataSize);
end;
{ TBlockResourceCacheDescriptor }
destructor TBlockResourceCacheDescriptor.Destroy;
begin
ReAllocMem(Data,0);
inherited Destroy;
end;
{ TGdkFontCache }
function CompareGdkFontWithResItem(Font: PGDKFont;

94
lcl/intfstrconsts.pas
View File

@ -1,94 +0,0 @@
{ $Id$ }
{
/***************************************************************************
intfstrconsts.pas
-----------------------
This unit contains all resource strings of the interface
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
{
Note: All resource strings should be prefixed with 'ifs' (InterFace String)
}
unit IntfStrConsts;
{$mode objfpc}{$H+}
interface
resourcestring
// I'm not sure if in all languages the Dialog texts for a button
// have the same meaning as a key
// So every VK gets its own constant
ifsVK_UNKNOWN = 'Unknown';
ifsVK_LBUTTON = 'Mouse Button Left';
ifsVK_RBUTTON = 'Mouse Button Right';
ifsVK_CANCEL = 'Cancel'; //= dlgCancel
ifsVK_MBUTTON = 'Mouse Button Middle';
ifsVK_BACK = 'Backspace';
ifsVK_TAB = 'Tab';
ifsVK_CLEAR = 'Clear';
ifsVK_RETURN = 'Return';
ifsVK_SHIFT = 'Shift';
ifsVK_CONTROL = 'Control';
ifsVK_MENU = 'Menu';
ifsVK_PAUSE = 'Pause key';
ifsVK_CAPITAL = 'Capital';
ifsVK_KANA = 'Kana';
ifsVK_JUNJA = 'Junja';
ifsVK_FINAL = 'Final';
ifsVK_HANJA = 'Hanja';
ifsVK_ESCAPE = 'Escape';
ifsVK_CONVERT = 'Convert';
ifsVK_NONCONVERT = 'Nonconvert';
ifsVK_ACCEPT = 'Accept';
ifsVK_MODECHANGE = 'Mode Change';
ifsVK_SPACE = 'Space key';
ifsVK_PRIOR = 'Prior';
ifsVK_NEXT = 'Next';
ifsVK_END = 'End';
ifsVK_HOME = 'Home';
ifsVK_LEFT = 'Left';
ifsVK_UP = 'Up';
ifsVK_RIGHT = 'Right';
ifsVK_DOWN = 'Down'; //= dlgdownword
ifsVK_SELECT = 'Select'; //= lismenuselect
ifsVK_PRINT = 'Print';
ifsVK_EXECUTE = 'Execute';
ifsVK_SNAPSHOT = 'Snapshot';
ifsVK_INSERT = 'Insert';
ifsVK_DELETE = 'Delete'; //= dlgeddelete
ifsVK_HELP = 'Help';
ifsVK_LWIN = 'left windows key';
ifsVK_RWIN = 'right windows key';
ifsVK_APPS = 'application key';
ifsVK_NUMPAD = 'Numpad %d';
ifsVK_NUMLOCK = 'Numlock';
ifsVK_SCROLL = 'Scroll';
implementation
end.

26
lcl/lclproc.pas
View File

@ -69,6 +69,7 @@ type
TSendMessageToInterfaceFunction =
function(LM_Message: Integer; Sender: TObject; data: pointer): integer
of object;
var
SendApplicationMessageFunction: TSendApplicationMessageFunction;
@ -78,9 +79,12 @@ var
function SendApplicationMessage(Msg: Cardinal; WParam: WParam; LParam: LParam):Longint;
procedure OwnerFormDesignerModified(AComponent: TComponent);
function OffsetRect(var ARect: TRect; dx,dy: Integer): Boolean;
procedure FreeThenNil(var AnObject: TObject);
procedure RegisterInterfaceFinalizationHandler(p: TProcedure);
procedure CallInterfaceFinalizationHandlers;
function OffsetRect(var ARect: TRect; dx,dy: Integer): Boolean;
procedure MakeMinMax(var i1, i2: integer);
procedure CalculateLeftTopWidthHeight(X1,Y1,X2,Y2: integer;
var Left,Top,Width,Height: integer);
@ -134,6 +138,9 @@ function DbgS(const i1,i2,i3,i4: integer): string;
implementation
var
InterfaceFinalizationHandlers: TList;
Function DeleteAmpersands(var Str : String) : Longint;
// Replace all &x with x
@ -332,6 +339,19 @@ begin
end;
end;
procedure RegisterInterfaceFinalizationHandler(p: TProcedure);
begin
InterfaceFinalizationHandlers.Add(p);
end;
procedure CallInterfaceFinalizationHandlers;
var
i: Integer;
begin
for i:=0 to InterfaceFinalizationHandlers.Count-1 do
TProcedure(InterfaceFinalizationHandlers[i])();
end;
{ TMethodList }
function TMethodList.GetItems(Index: integer): TMethod;
@ -770,6 +790,10 @@ end;
initialization
SendApplicationMessageFunction:=nil;
OwnerFormDesignerModifiedProc:=nil;
InterfaceFinalizationHandlers:=TList.Create;
finalization
InterfaceFinalizationHandlers.Free;
InterfaceFinalizationHandlers:=nil;
end.

441
lcl/lclrescache.pas Normal file
View File

@ -0,0 +1,441 @@
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
Types and methods to cache interface resources.
See graphics.pp for examples.
}
unit LCLResCache;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FPCAdds, LCLProc, AvgLvlTree;
type
TResourceCache = class;
TResourceCacheDescriptor = class;
{ TResourceCacheItem }
TResourceCacheItem = class
private
FReferenceCount: integer;
public
Handle: THandle;
Cache: TResourceCache;
FirstDescriptor, LastDescriptor: TResourceCacheDescriptor;
Next, Prev: TResourceCacheItem;
constructor Create(TheCache: TResourceCache; TheHandle: THandle);
destructor Destroy; override;
procedure IncreaseRefCount;
procedure DecreaseRefCount;
procedure AddToList(var First, Last: TResourceCacheItem);
procedure RemoveFromList(var First, Last: TResourceCacheItem);
procedure WarnReferenceHigh; virtual;
public
property ReferenceCount: integer read FReferenceCount;
end;
TResourceCacheItemClass = class of TResourceCacheItem;
{ TResourceCacheDescriptor }
TResourceCacheDescriptor = class
public
Item: TResourceCacheItem;
Cache: TResourceCache;
Next, Prev: TResourceCacheDescriptor;
constructor Create(TheCache: TResourceCache; TheItem: TResourceCacheItem);
destructor Destroy; override;
procedure AddToList(var First, Last: TResourceCacheDescriptor);
procedure RemoveFromList(var First, Last: TResourceCacheDescriptor);
end;
TResourceCacheDescriptorClass = class of TResourceCacheDescriptor;
{ TResourceCache }
TResourceCache = class
protected
FItems: TAvgLvlTree;
FDescriptors: TAvgLvlTree;
FDestroying: boolean;
FResourceCacheDescriptorClass: TResourceCacheDescriptorClass;
FResourceCacheItemClass: TResourceCacheItemClass;
FMaxUnusedItem: integer; // how many freed resources to keep
FFirstUnusedItem, FLastUnusedItem: TResourceCacheItem;
FUnUsedItemCount: integer;
procedure RemoveItem(Item: TResourceCacheItem); virtual;
procedure RemoveDescriptor(Desc: TResourceCacheDescriptor); virtual;
procedure ItemUsed(Item: TResourceCacheItem);
procedure ItemUnused(Item: TResourceCacheItem);
function ItemIsUsed(Item: TResourceCacheItem): boolean;
public
constructor Create;
destructor Destroy; override;
function CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer): integer; virtual;
function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; virtual; abstract;
procedure ConsistencyCheck;
public
property MaxUnusedItem: integer read FMaxUnusedItem
write FMaxUnusedItem;
property ResourceCacheItemClass: TResourceCacheItemClass
read FResourceCacheItemClass;
property ResourceCacheDescriptorClass: TResourceCacheDescriptorClass
read FResourceCacheDescriptorClass;
end;
{ THandleResourceCache }
THandleResourceCache = class(TResourceCache)
public
function FindItem(Handle: THandle): TResourceCacheItem;
end;
{ TBlockResourceCacheDescriptor }
TBlockResourceCacheDescriptor = class(TResourceCacheDescriptor)
public
Data: Pointer;
destructor Destroy; override;
end;
{ TBlockResourceCache }
TBlockResourceCache = class(THandleResourceCache)
private
FDataSize: integer;
protected
FOnCompareDescPtrWithDescriptor: TListSortCompare;
public
constructor Create(TheDataSize: integer);
function FindDescriptor(DescPtr: Pointer): TBlockResourceCacheDescriptor;
function AddResource(Handle: THandle; DescPtr: Pointer
): TBlockResourceCacheDescriptor;
function CompareDescriptors(Tree: TAvgLvlTree;
Desc1, Desc2: Pointer): integer; override;
public
property DataSize: integer read FDataSize;
property OnCompareDescPtrWithDescriptor: TListSortCompare
read FOnCompareDescPtrWithDescriptor;
end;
function ComparePHandleWithResourceCacheItem(HandlePtr: PHandle;
Item: TResourceCacheItem): integer;
function CompareDescPtrWithBlockResDesc(DescPtr: Pointer;
Item: TBlockResourceCacheDescriptor): integer;
implementation
function ComparePHandleWithResourceCacheItem(HandlePtr: PHandle;
Item: TResourceCacheItem): integer;
begin
Result:=CompareHandles(HandlePtr^,Item.Handle);
end;
function CompareDescPtrWithBlockResDesc(DescPtr: Pointer;
Item: TBlockResourceCacheDescriptor): integer;
begin
Result:=CompareMemRange(DescPtr,Item.Data,
TBlockResourceCache(Item.Cache).DataSize);
end;
{ TResourceCacheItem }
constructor TResourceCacheItem.Create(TheCache: TResourceCache;
TheHandle: THandle);
begin
Cache:=TheCache;
Handle:=TheHandle;
end;
destructor TResourceCacheItem.Destroy;
begin
Cache.RemoveItem(Self);
inherited Destroy;
end;
procedure TResourceCacheItem.IncreaseRefCount;
begin
inc(FReferenceCount);
if FReferenceCount=1 then
Cache.ItemUsed(Self);
if (FReferenceCount=100) or (FReferenceCount=1000) then
WarnReferenceHigh;
end;
procedure TResourceCacheItem.DecreaseRefCount;
begin
if FReferenceCount=0 then
RaiseGDBException('TResourceCacheItem.DecreaseRefCount=0');
dec(FReferenceCount);
if FReferenceCount=0 then
Cache.ItemUnused(Self);
end;
procedure TResourceCacheItem.AddToList(var First, Last: TResourceCacheItem
);
// add as last
begin
Next:=nil;
Prev:=Last;
Last:=Self;
if First=nil then First:=Self;
if Prev<>nil then Prev.Next:=Self;
end;
procedure TResourceCacheItem.RemoveFromList(var First,Last: TResourceCacheItem);
begin
if First=Self then First:=Next;
if Last=Self then Last:=Prev;
if Next<>nil then Next.Prev:=Prev;
if Prev<>nil then Prev.Next:=Next;
Next:=nil;
Prev:=nil;
end;
procedure TResourceCacheItem.WarnReferenceHigh;
begin
debugln('WARNING: TResourceCacheItem.IncreaseRefCount ',dbgs(FReferenceCount));
end;
{ TResourceCacheDescriptor }
constructor TResourceCacheDescriptor.Create(TheCache: TResourceCache;
TheItem: TResourceCacheItem);
begin
Cache:=TheCache;
Item:=TheItem;
Item.IncreaseRefCount;
AddToList(Item.FirstDescriptor,Item.LastDescriptor);
end;
destructor TResourceCacheDescriptor.Destroy;
begin
Cache.RemoveDescriptor(Self);
inherited Destroy;
end;
procedure TResourceCacheDescriptor.AddToList(
var First, Last: TResourceCacheDescriptor);
// add as last
begin
Next:=nil;
Prev:=Last;
Last:=Self;
if First=nil then First:=Self;
if Prev<>nil then Prev.Next:=Self;
end;
procedure TResourceCacheDescriptor.RemoveFromList(
var First, Last: TResourceCacheDescriptor);
begin
if First=Self then First:=Next;
if Last=Self then Last:=Prev;
if Next<>nil then Next.Prev:=Prev;
if Prev<>nil then Prev.Next:=Next;
Next:=nil;
Prev:=nil;
end;
{ TResourceCache }
procedure TResourceCache.RemoveItem(Item: TResourceCacheItem);
begin
if FDestroying then exit;
while Item.FirstDescriptor<>nil do Item.FirstDescriptor.Free;
FItems.Remove(Item);
end;
procedure TResourceCache.RemoveDescriptor(Desc: TResourceCacheDescriptor);
begin
if FDestroying then exit;
Desc.RemoveFromList(Desc.Item.FirstDescriptor,Desc.Item.LastDescriptor);
FDescriptors.Remove(Desc);
if Desc.Item.FirstDescriptor=nil then
Desc.Item.Free;
end;
procedure TResourceCache.ItemUsed(Item: TResourceCacheItem);
// called after creation or when Item is used again
begin
if not ItemIsUsed(Item) then begin
Item.RemoveFromList(FFirstUnusedItem,FLastUnusedItem);
dec(FUnUsedItemCount);
end;
end;
procedure TResourceCache.ItemUnused(Item: TResourceCacheItem);
// called when Item is not used any more
begin
if not ItemIsUsed(Item) then
raise Exception.Create('TResourceCache.ItemUnused');
Item.AddToList(FFirstUnusedItem,FLastUnusedItem);
inc(FUnUsedItemCount);
if FUnUsedItemCount>FMaxUnusedItem then
// maximum unused resources reached -> free the oldest
FFirstUnusedItem.Free;
end;
function TResourceCache.ItemIsUsed(Item: TResourceCacheItem): boolean;
begin
Result:=(FFirstUnusedItem<>Item) and (Item.Next=nil)
and (Item.Prev=nil)
end;
constructor TResourceCache.Create;
begin
FMaxUnusedItem:=100;
FItems:=TAvgLvlTree.CreateObjectCompare(@CompareItems);
FDescriptors:=TAvgLvlTree.CreateObjectCompare(@CompareDescriptors);
FResourceCacheItemClass:=TResourceCacheItem;
FResourceCacheDescriptorClass:=TResourceCacheDescriptor;
end;
destructor TResourceCache.Destroy;
begin
FDestroying:=true;
FItems.FreeAndClear;
FItems.Free;
FItems:=nil;
FDescriptors.FreeAndClear;
FDescriptors.Free;
FDescriptors:=nil;
inherited Destroy;
end;
function TResourceCache.CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer
): integer;
begin
Result:=CompareHandles(TResourceCacheItem(Item1).Handle,
TResourceCacheItem(Item2).Handle);
end;
procedure TResourceCache.ConsistencyCheck;
var
ANode: TAvgLvlTreeNode;
Item: TResourceCacheItem;
begin
if (FFirstUnusedItem=nil) xor (FLastUnusedItem=nil) then
RaiseGDBException('');
// check items
ANode:=FItems.FindLowest;
while ANode<>nil do begin
Item:=TResourceCacheItem(ANode.Data);
if Item.FirstDescriptor=nil then
RaiseGDBException('');
if Item.LastDescriptor=nil then
RaiseGDBException('');
ANode:=FItems.FindSuccessor(ANode);
end;
end;
{ THandleResourceCache }
function THandleResourceCache.FindItem(Handle: THandle): TResourceCacheItem;
var
ANode: TAvgLvlTreeNode;
begin
ANode:=FItems.FindKey(@Handle,@ComparePHandleWithResourceCacheItem);
if ANode<>nil then
Result:=TResourceCacheItem(ANode.Data)
else
Result:=nil;
end;
{ TBlockResourceCache }
constructor TBlockResourceCache.Create(TheDataSize: integer);
begin
inherited Create;
FDataSize:=TheDataSize;
FResourceCacheDescriptorClass:=TBlockResourceCacheDescriptor;
FOnCompareDescPtrWithDescriptor:=@CompareDescPtrWithBlockResDesc;
end;
function TBlockResourceCache.FindDescriptor(DescPtr: Pointer
): TBlockResourceCacheDescriptor;
var
ANode: TAvgLvlTreeNode;
begin
ANode:=FDescriptors.FindKey(DescPtr,FOnCompareDescPtrWithDescriptor);
if ANode<>nil then
Result:=TBlockResourceCacheDescriptor(ANode.Data)
else
Result:=nil;
end;
function TBlockResourceCache.AddResource(Handle: THandle; DescPtr: Pointer
): TBlockResourceCacheDescriptor;
var
Item: TResourceCacheItem;
procedure RaiseDescriptorAlreadyAdded;
var
Msg: String;
i: Integer;
begin
Msg:='TBlockResourceCache.AddResource Descriptor Already Added '#13;
for i:=0 to DataSize-1 do
Msg:=Msg+hexstr(ord(PChar(DescPtr)[i]),2);
raise Exception.Create(Msg);
end;
begin
Result:=FindDescriptor(DescPtr);
if Result<>nil then
RaiseDescriptorAlreadyAdded;
Item:=FindItem(Handle);
if Item=nil then begin
Item:=FResourceCacheItemClass.Create(Self,Handle);
FItems.Add(Item);
end;
Result:=TBlockResourceCacheDescriptor(
FResourceCacheDescriptorClass.Create(Self,Item));
ReAllocMem(Result.Data,DataSize);
System.Move(DescPtr^,Result.Data^,DataSize);
FDescriptors.Add(Result);
end;
function TBlockResourceCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1,
Desc2: Pointer): integer;
begin
Result:=CompareMemRange(TBlockResourceCacheDescriptor(Desc1).Data,
TBlockResourceCacheDescriptor(Desc2).Data,
DataSize);
end;
{ TBlockResourceCacheDescriptor }
destructor TBlockResourceCacheDescriptor.Destroy;
begin
ReAllocMem(Data,0);
inherited Destroy;
end;
end.

49
lcl/lclstrconsts.pas
View File

@ -185,6 +185,55 @@ ResourceString
rsError = 'Error';
rsPickDate = 'Select a date';
// I'm not sure if in all languages the Dialog texts for a button
// have the same meaning as a key
// So every VK gets its own constant
ifsVK_UNKNOWN = 'Unknown';
ifsVK_LBUTTON = 'Mouse Button Left';
ifsVK_RBUTTON = 'Mouse Button Right';
ifsVK_CANCEL = 'Cancel'; //= dlgCancel
ifsVK_MBUTTON = 'Mouse Button Middle';
ifsVK_BACK = 'Backspace';
ifsVK_TAB = 'Tab';
ifsVK_CLEAR = 'Clear';
ifsVK_RETURN = 'Return';
ifsVK_SHIFT = 'Shift';
ifsVK_CONTROL = 'Control';
ifsVK_MENU = 'Menu';
ifsVK_PAUSE = 'Pause key';
ifsVK_CAPITAL = 'Capital';
ifsVK_KANA = 'Kana';
ifsVK_JUNJA = 'Junja';
ifsVK_FINAL = 'Final';
ifsVK_HANJA = 'Hanja';
ifsVK_ESCAPE = 'Escape';
ifsVK_CONVERT = 'Convert';
ifsVK_NONCONVERT = 'Nonconvert';
ifsVK_ACCEPT = 'Accept';
ifsVK_MODECHANGE = 'Mode Change';
ifsVK_SPACE = 'Space key';
ifsVK_PRIOR = 'Prior';
ifsVK_NEXT = 'Next';
ifsVK_END = 'End';
ifsVK_HOME = 'Home';
ifsVK_LEFT = 'Left';
ifsVK_UP = 'Up';
ifsVK_RIGHT = 'Right';
ifsVK_DOWN = 'Down'; //= dlgdownword
ifsVK_SELECT = 'Select'; //= lismenuselect
ifsVK_PRINT = 'Print';
ifsVK_EXECUTE = 'Execute';
ifsVK_SNAPSHOT = 'Snapshot';
ifsVK_INSERT = 'Insert';
ifsVK_DELETE = 'Delete'; //= dlgeddelete
ifsVK_HELP = 'Help';
ifsVK_LWIN = 'left windows key';
ifsVK_RWIN = 'right windows key';
ifsVK_APPS = 'application key';
ifsVK_NUMPAD = 'Numpad %d';
ifsVK_NUMLOCK = 'Numlock';
ifsVK_SCROLL = 'Scroll';
implementation
end.

17
lcl/lmessages.pp
View File

@ -23,19 +23,19 @@
*****************************************************************************
}
unit lMessages;
unit LMessages;
{$mode objfpc}{$H+}
interface
uses Classes, SysUtils, vclGlobals, LCLType, GraphType
{$ifdef win32}
{$ifndef ver1_0}
,messages
{$endif ver1_0}
{$endif win32}
;
{$ifdef win32}
{$ifndef ver1_0}
,messages
{$endif ver1_0}
{$endif win32}
;
const
//-------------
@ -1080,6 +1080,9 @@ end.
{
$Log$
Revision 1.68 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache
Revision 1.67 2004/07/16 21:49:00 mattias
added RTTI controls