paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-07 13:00:47 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed TBitmap.GetHandle

Browse Source 
git-svn-id: trunk@4489 -
This commit is contained in:
mattias 2003-08-16 15:29:56 +00:00
parent de0fa7faca
commit a11cc81501
4 changed files with 48 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
designer/jitforms.pp
View File

@ -47,8 +47,8 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms, Controls, LCLLinux, Dialogs, JITForm, ComponentReg,
IDEProcs;
Classes, SysUtils, TypInfo, Forms, Controls, LCLLinux, Dialogs, JITForm,
ComponentReg, IDEProcs;
type
//----------------------------------------------------------------------------
@ -100,6 +100,12 @@ type
// TReader events
procedure ReaderFindMethod(Reader: TReader; const FindMethodName: Ansistring;
var Address: Pointer; var Error: Boolean);
{$IFDEF Reader2}
procedure ReaderSetMethodProperty(Reader: TReader; Instance: TPersistent;
PropInfo: PPropInfo; const TheMethodName: string; var Handled: boolean);
procedure ReaderPropertyNotFound(Reader: TReader; Instance: TPersistent;
var PropName: string; IsPath: Boolean; var Handled, Skip: Boolean);
{$ENDIF}
procedure ReaderSetName(Reader: TReader; Component: TComponent;
var NewName: Ansistring);
procedure ReaderReferenceName(Reader: TReader; var RefName: Ansistring);
@ -393,6 +399,10 @@ begin
// connect TReader events
Reader.OnError:=@ReaderError;
Reader.OnFindMethod:=@ReaderFindMethod;
{$IFDEF Reader2}
Reader.OnPropertyNotFound:=@ReaderPropertyNotFound;
Reader.OnSetMethodProperty:=@ReaderSetMethodProperty;
{$ENDIF}
Reader.OnSetName:=@ReaderSetName;
Reader.OnReferenceName:=@ReaderReferenceName;
Reader.OnAncestorNotFound:=@ReaderAncestorNotFound;
@ -829,6 +839,22 @@ begin
end;
end;
{$IFDEF Reader2}
procedure TJITComponentList.ReaderPropertyNotFound(Reader: TReader;
Instance: TPersistent; var PropName: string; IsPath: Boolean;
var Handled, Skip: Boolean);
begin
writeln('TJITComponentList.ReaderPropertyNotFound ',Instance.ClassName,'.',PropName);
end;
procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
var Handled: boolean);
begin
writeln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
end;
{$ENDIF}
procedure TJITComponentList.ReaderSetName(Reader: TReader;
Component: TComponent; var NewName: Ansistring);
var

3
ide/sourceeditprocs.pas
View File

@ -44,12 +44,13 @@ type
TIdentComplValue = (
icvIdentifier, icvProcWithParams, icvIndexedProp);
// completion form and functions
procedure PaintCompletionItem(const AKey: string; ACanvas: TCanvas;
X, Y, MaxX: integer; ItemSelected: boolean; Index: integer;
aCompletion : TSynCompletion; CurrentCompletionType: TCompletionType);
function GetIdentCompletionValue(aCompletion : TSynCompletion;
var ValueType: TIdentComplValue; var CursorToLeft: integer): string;
implementation

17
lcl/include/bitmap.inc
View File

@ -131,7 +131,6 @@ begin
UnshareImage;
if FImage.FHandle=0 then
HandleNeeded;
Changing(Self);
Result := FImage.FHandle;
end;
@ -439,7 +438,7 @@ begin
// store original stream
if Stream<>FImage.SaveStream then begin
MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(Stream,Stream.Size);
MemStream.CopyFrom(Stream,Stream.Size-Stream.Position);
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
end else
@ -522,15 +521,15 @@ var
end;
end;
Procedure DoWriteStreamSize(Size: longint);
Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
begin
if WriteSize then
MemStream.WriteBuffer(Size, SizeOf(Size));
DestStream.WriteBuffer(Size, SizeOf(Size));
end;
Procedure DoWriteSize(Header : TBitmapHeader);
Procedure DoWriteSize(Header: TBitmapHeader);
begin
DoWriteStreamSize(Header.FileHeader.bfSize);
DoWriteStreamSize(MemStream,Header.FileHeader.bfSize);
end;
Procedure WriteBitmapHeader(Header : TBitmapHeader);
@ -581,7 +580,7 @@ var
procedure DoWriteOriginal;
begin
DoWriteStreamSize(FImage.SaveStream.Size);
DoWriteStreamSize(Stream,FImage.SaveStream.Size);
FImage.SaveStream.Position:=0;
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
end;
@ -595,6 +594,7 @@ begin
DoWriteOriginal;
exit;
end;
writeln('TBitmap.WriteStream A Warning: creating BMP does not always work ',FImage.SaveStream<>nil,' ',ord(FImage.SaveStreamType));
// write image in BMP format to temporary stream
MemStream:=TMemoryStream.Create;
@ -731,6 +731,9 @@ end;
{ =============================================================================
$Log$
Revision 1.39 2003/08/16 15:29:56 mattias
fixed TBitmap.GetHandle
Revision 1.38 2003/08/10 09:33:43 mattias
saved bitmap stream is now stored

10
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -1677,6 +1677,7 @@ var
ColorMap: PGdkColormap;
P: Pointer;
Depth : Longint;
ok: Boolean;
begin
GdiObject := NewGDIObject(gdiBitmap);
if TransColor >= 0 then begin
@ -1689,6 +1690,7 @@ begin
ColorMap:=gdk_window_get_colormap(Window)
else
ColorMap:=gdk_colormap_get_system;
ok:=false;
try
GdiObject^.GDIPixmapObject :=
gdk_pixmap_colormap_create_from_xpm_d(Window,Colormap,
@ -1712,8 +1714,9 @@ begin
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, 1);
GdiObject^.GDIBitmapType:=gbPixmap;
except
on E: Exception do begin
ok:=true;
finally
if not ok then begin
DisposeGDIObject(GdiObject);
GdiObject:=nil;
end;
@ -8750,6 +8753,9 @@ end;
{ =============================================================================
$Log$
Revision 1.267 2003/08/16 15:29:56 mattias
fixed TBitmap.GetHandle
Revision 1.266 2003/08/15 14:01:20 mattias
combined lazconf things for unix