paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-25 05:39:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

saved bitmap stream is now stored

Browse Source 
git-svn-id: trunk@4461 -
This commit is contained in:
mattias 2003-08-10 09:33:43 +00:00
parent ad6c403825
commit 816c00cf86
3 changed files with 43 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ide/initialsetupdlgs.pas
View File

@ -28,6 +28,10 @@
Author: Mattias Gaertner
Abstract:
Procedures and dialogs to check environment. The IDE uses these procedures
at startup to check for example the lazarus directory and warns if, there
it looks suspicious.
}
unit InitialSetupDlgs;

30
lcl/include/bitmap.inc
View File

@ -480,6 +480,10 @@ Type
InfoHeader : tagBitmapInfoHeader;
end;
var
MemStream: TMemoryStream;
Procedure FillBitmapInfo(Bitmap : hBitmap; var Bits : Pointer;
Var Header : TBitmapHeader);
var
@ -521,7 +525,7 @@ Type
Procedure DoWriteStreamSize(Size: longint);
begin
if WriteSize then
Stream.WriteBuffer(Size, SizeOf(Size));
MemStream.WriteBuffer(Size, SizeOf(Size));
end;
Procedure DoWriteSize(Header : TBitmapHeader);
@ -531,7 +535,7 @@ Type
Procedure WriteBitmapHeader(Header : TBitmapHeader);
begin
Stream.WriteBuffer(Header, SizeOf(Header));
MemStream.WriteBuffer(Header, SizeOf(Header));
end;
Procedure WriteTRIColorMap(Color : PLongint; size : Longint); //For OS/2 Bitmaps
@ -545,7 +549,7 @@ Type
Tri.rgbtBlue := Blue(Color[i]);
Tri.rgbtGreen := Green(Color[i]);
Tri.rgbtRed := Red(Color[i]);
Stream.WriteBuffer(Tri, 3);
MemStream.WriteBuffer(Tri, 3);
end;
end;
@ -561,7 +565,7 @@ Type
Quad.rgbBlue := Blue(Color[i]);
Quad.rgbGreen := Green(Color[i]);
Quad.rgbRed := Red(Color[i]);
Stream.WriteBuffer(Quad, 4);
MemStream.WriteBuffer(Quad, 4);
end;
end;
@ -572,7 +576,7 @@ Type
Procedure WritePixels(Bits : PByte; Header : TBitmapHeader);
begin
Stream.WriteBuffer(Bits^, Header.InfoHeader.biSizeImage);
MemStream.WriteBuffer(Bits^, Header.InfoHeader.biSizeImage);
end;
procedure DoWriteOriginal;
@ -592,15 +596,26 @@ begin
exit;
end;
Bits:=nil;
// write image in BMP format to temporary stream
MemStream:=TMemoryStream.Create;
try
Bits:=nil;
FillBitmapInfo(Handle, Bits, Header);
DoWriteSize(Header);
WriteBitmapHeader(Header);
WriteColorMap(Header);
WritePixels(Bits, Header);
// save stream, so that further saves will be fast
MemStream.Position:=0;
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
MemStream:=nil;
FImage.SaveStreamType:=bnWinBitmap;
// copy savestream to destination stream
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
finally
ReallocMem(Bits, 0);
MemStream.Free;
end;
end;
@ -716,6 +731,9 @@ end;
{ =============================================================================
$Log$
Revision 1.38 2003/08/10 09:33:43 mattias
saved bitmap stream is now stored
Revision 1.37 2003/07/01 09:29:51 mattias
attaching menuitems topdown

19
lcl/intfgraphics.pas
View File

@ -185,6 +185,7 @@ type
destructor Destroy; override;
procedure DeleteChilds;
procedure UnbindFromParent;
procedure CreateChildNode(ChildValue: integer);
function GetChildNode(ChildValue: integer;
CreateIfNotExists: boolean): TArrayNode;
procedure Expand(ValueToInclude: integer);
@ -1811,6 +1812,18 @@ begin
end;
end;
procedure TArrayNode.CreateChildNode(ChildValue: integer);
var
NewNode: TArrayNode;
Index: Integer;
begin
NewNode:=TArrayNode.Create;
NewNode.Value:=ChildValue;
NewNode.Parent:=Self;
Index:=ChildValue-StartValue;
Childs[Index]:=NewNode;
end;
function TArrayNode.GetChildNode(ChildValue: integer; CreateIfNotExists: boolean
): TArrayNode;
var
@ -1826,10 +1839,8 @@ begin
end;
Result:=Childs[Index];
if (Result=nil) and CreateIfNotExists then begin
Result:=TArrayNode.Create;
Result.Value:=ChildValue;
Result.Parent:=Self;
Childs[Index]:=Result;
CreateChildNode(ChildValue);
Result:=Childs[Index];
end;
end;