mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 06:21:38 +01:00 
			
		
		
		
	added DefineRectProperty
git-svn-id: trunk@8811 -
This commit is contained in:
		
							parent
							
								
									509e8de76c
								
							
						
					
					
						commit
						c03e8cd810
					
				| @ -59,7 +59,7 @@ uses | |||||||
|   {$IFDEF USE_UTF8BIDI_LCL} |   {$IFDEF USE_UTF8BIDI_LCL} | ||||||
|   FreeBIDI, utf8bidi, |   FreeBIDI, utf8bidi, | ||||||
|   {$ENDIF} |   {$ENDIF} | ||||||
|   FPCAdds, LCLIntf, LCLType, LMessages, LCLProc, |   Types, FPCAdds, LCLIntf, LCLType, LMessages, LCLProc, | ||||||
| {$ELSE} | {$ELSE} | ||||||
|   Windows, |   Windows, | ||||||
| {$ENDIF} | {$ENDIF} | ||||||
|  | |||||||
| @ -59,7 +59,7 @@ uses | |||||||
|   {$IFDEF USE_UTF8BIDI_LCL} |   {$IFDEF USE_UTF8BIDI_LCL} | ||||||
|   utf8bidi, |   utf8bidi, | ||||||
|   {$ENDIF} |   {$ENDIF} | ||||||
|   LCLIntf, LCLType, |   Types, LCLIntf, LCLType, | ||||||
|   {$ELSE} |   {$ELSE} | ||||||
|   Windows, Messages, |   Windows, Messages, | ||||||
|   {$ENDIF} |   {$ENDIF} | ||||||
|  | |||||||
| @ -33,7 +33,7 @@ unit DesignerProcs; | |||||||
| interface | interface | ||||||
| 
 | 
 | ||||||
| uses | uses | ||||||
|   Classes, SysUtils, LCLIntf, Forms, Controls, LCLType, Graphics; |   Classes, SysUtils, Types, LCLIntf, Forms, Controls, LCLType, Graphics; | ||||||
| 
 | 
 | ||||||
| type | type | ||||||
|   TDesignerDCFlag = (ddcDCOriginValid, ddcFormOriginValid, |   TDesignerDCFlag = (ddcDCOriginValid, ddcFormOriginValid, | ||||||
|  | |||||||
| @ -1,5 +1,3 @@ | |||||||
| { This is an automatically generated lazarus resource file } |  | ||||||
| 
 |  | ||||||
| LazarusResources.Add('TCompStreamDemoForm','FORMDATA',[ | LazarusResources.Add('TCompStreamDemoForm','FORMDATA',[ | ||||||
|   'TPF0'#19'TCompStreamDemoForm'#18'CompStreamDemoForm'#7'Caption'#6#28'Streami' |   'TPF0'#19'TCompStreamDemoForm'#18'CompStreamDemoForm'#7'Caption'#6#28'Streami' | ||||||
|   +'ng components example'#12'ClientHeight'#3#229#1#11'ClientWidth'#3#13#2#8'On' |   +'ng components example'#12'ClientHeight'#3#229#1#11'ClientWidth'#3#13#2#8'On' | ||||||
|  | |||||||
| @ -27,7 +27,7 @@ unit GtkWSMenus; | |||||||
| interface | interface | ||||||
| 
 | 
 | ||||||
| uses | uses | ||||||
|   Classes, InterfaceBase, LCLProc, LCLType, WSMenus, WSLCLClasses, |   Classes, InterfaceBase, Types, LCLProc, LCLType, WSMenus, WSLCLClasses, | ||||||
|   {$IFDEF gtk2} |   {$IFDEF gtk2} | ||||||
|   glib2, gdk2pixbuf, gdk2, gtk2, Pango, |   glib2, gdk2pixbuf, gdk2, gtk2, Pango, | ||||||
|   {$ELSE} |   {$ELSE} | ||||||
|  | |||||||
| @ -36,7 +36,8 @@ unit LCLProc; | |||||||
| interface | interface | ||||||
| 
 | 
 | ||||||
| uses | uses | ||||||
|   Classes, SysUtils, Math, FPCAdds, AvgLvlTree, FileUtil, LCLStrConsts, LCLType; |   Classes, SysUtils, Math, Types, FPCAdds, AvgLvlTree, FileUtil, LCLStrConsts, | ||||||
|  |   LCLType; | ||||||
| 
 | 
 | ||||||
| type | type | ||||||
|   { TMethodList - array of TMethod } |   { TMethodList - array of TMethod } | ||||||
|  | |||||||
| @ -25,7 +25,7 @@ unit LCLResCache; | |||||||
| interface | interface | ||||||
| 
 | 
 | ||||||
| uses | uses | ||||||
|   Classes, SysUtils, FPCAdds, LCLType, LCLProc, AvgLvlTree; |   Classes, SysUtils, FPCAdds, Types, LCLType, LCLProc, AvgLvlTree; | ||||||
|    |    | ||||||
| {off $DEFINE CheckResCacheConsistency} | {off $DEFINE CheckResCacheConsistency} | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -66,9 +66,7 @@ type | |||||||
| {$ELSE USE_UTF8BIDI_LCL} | {$ELSE USE_UTF8BIDI_LCL} | ||||||
|   TUTF8Char = String[7]; |   TUTF8Char = String[7]; | ||||||
| {$ENDIF USE_UTF8BIDI_LCL} | {$ENDIF USE_UTF8BIDI_LCL} | ||||||
|   PRect = ^TRect; |  | ||||||
|   UINT = LongWord; |   UINT = LongWord; | ||||||
|   PPoint = ^TPoint; |  | ||||||
| 
 | 
 | ||||||
|   {PLongInt = ^LongInt; |   {PLongInt = ^LongInt; | ||||||
|   PInteger = ^Integer; |   PInteger = ^Integer; | ||||||
|  | |||||||
| @ -36,7 +36,7 @@ unit LResources; | |||||||
| interface | interface | ||||||
| 
 | 
 | ||||||
| uses | uses | ||||||
|   Classes, SysUtils, FPCAdds, TypInfo, LCLProc, LCLStrConsts; |   Classes, SysUtils, Types, FPCAdds, TypInfo, LCLProc, LCLStrConsts; | ||||||
| 
 | 
 | ||||||
| type | type | ||||||
|   { TLResourceList } |   { TLResourceList } | ||||||
| @ -263,6 +263,8 @@ procedure LRSObjectResToText(Input, Output: TStream; | |||||||
| function TestFormStreamFormat(Stream: TStream): TLRSStreamOriginalFormat; | function TestFormStreamFormat(Stream: TStream): TLRSStreamOriginalFormat; | ||||||
| procedure FormDataToText(FormStream, TextStream: TStream); | procedure FormDataToText(FormStream, TextStream: TStream); | ||||||
| 
 | 
 | ||||||
|  | procedure DefineRectProperty(Filer: TFiler; const Name: string; | ||||||
|  |                              ARect, DefaultRect: PRect); | ||||||
| 
 | 
 | ||||||
| procedure ReverseBytes(p: Pointer; Count: integer); | procedure ReverseBytes(p: Pointer; Count: integer); | ||||||
| procedure ReverseByteOrderInWords(p: PWord; Count: integer); | procedure ReverseByteOrderInWords(p: PWord; Count: integer); | ||||||
| @ -315,6 +317,80 @@ var | |||||||
|   ByteToStr: array[char] of shortstring; |   ByteToStr: array[char] of shortstring; | ||||||
|   ByteToStrValid: boolean=false; |   ByteToStrValid: boolean=false; | ||||||
|    |    | ||||||
|  | type | ||||||
|  | 
 | ||||||
|  |   { TDefineRectPropertyClass } | ||||||
|  | 
 | ||||||
|  |   TDefineRectPropertyClass = class | ||||||
|  |   public | ||||||
|  |     Value: PRect; | ||||||
|  |     DefaultValue: PRect; | ||||||
|  |     constructor Create(AValue, ADefaultRect: PRect); | ||||||
|  |     procedure ReadData(Reader: TReader); | ||||||
|  |     procedure WriteData(Writer: TWriter); | ||||||
|  |     function HasData: Boolean; | ||||||
|  |   end; | ||||||
|  | 
 | ||||||
|  | { TDefineRectPropertyClass } | ||||||
|  | 
 | ||||||
|  | constructor TDefineRectPropertyClass.Create(AValue, ADefaultRect: PRect); | ||||||
|  | begin | ||||||
|  |   Value:=AValue; | ||||||
|  |   DefaultValue:=ADefaultRect; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | procedure TDefineRectPropertyClass.ReadData(Reader: TReader); | ||||||
|  | begin | ||||||
|  |   with Reader do begin | ||||||
|  |     ReadListBegin; | ||||||
|  |     Value^.Left:=ReadInteger; | ||||||
|  |     Value^.Top:=ReadInteger; | ||||||
|  |     Value^.Right:=ReadInteger; | ||||||
|  |     Value^.Bottom:=ReadInteger; | ||||||
|  |     ReadListEnd; | ||||||
|  |   end; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | procedure TDefineRectPropertyClass.WriteData(Writer: TWriter); | ||||||
|  | begin | ||||||
|  |   with Writer do begin | ||||||
|  |     WriteListBegin; | ||||||
|  |     WriteInteger(Value^.Left); | ||||||
|  |     WriteInteger(Value^.Top); | ||||||
|  |     WriteInteger(Value^.Right); | ||||||
|  |     WriteInteger(Value^.Bottom); | ||||||
|  |     WriteListEnd; | ||||||
|  |   end; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | function TDefineRectPropertyClass.HasData: Boolean; | ||||||
|  | begin | ||||||
|  |   if DefaultValue<>nil then begin | ||||||
|  |     Result:=(DefaultValue^.Left<>Value^.Left) | ||||||
|  |          or (DefaultValue^.Top<>Value^.Top) | ||||||
|  |          or (DefaultValue^.Right<>Value^.Right) | ||||||
|  |          or (DefaultValue^.Bottom<>Value^.Bottom); | ||||||
|  |   end else begin | ||||||
|  |     Result:=(Value^.Left<>0) | ||||||
|  |          or (Value^.Top<>0) | ||||||
|  |          or (Value^.Right<>0) | ||||||
|  |          or (Value^.Bottom<>0); | ||||||
|  |   end; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | procedure DefineRectProperty(Filer: TFiler; const Name: string; ARect, | ||||||
|  |   DefaultRect: PRect); | ||||||
|  | var | ||||||
|  |   PropDef: TDefineRectPropertyClass; | ||||||
|  | begin | ||||||
|  |   PropDef:=TDefineRectPropertyClass.Create(ARect,DefaultRect); | ||||||
|  |   try | ||||||
|  |     Filer.DefineProperty(Name,@PropDef.ReadData,@PropDef.WriteData,PropDef.HasData); | ||||||
|  |   finally | ||||||
|  |     PropDef.Free; | ||||||
|  |   end; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
| procedure InitByteToStr; | procedure InitByteToStr; | ||||||
| var | var | ||||||
|   c: Char; |   c: Char; | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 mattias
						mattias