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

fixed a few more black colors

Browse Source 
git-svn-id: trunk@4838 -
This commit is contained in:
mattias 2003-11-25 08:59:01 +00:00
parent 6e8632dd99
commit 4847e82ed3
5 changed files with 61 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ide/project.pp
View File

@ -1262,8 +1262,9 @@ begin
Add('program Project1;'); Add('program Project1;');
Add(''); Add('');
Add('{$mode objfpc}{$H+}'); Add('{$mode objfpc}{$H+}');
if fProjectType in [ptApplication] then // This results in crashing programs, when stdout is not open
Add('{$AppType Gui} // for win32 applications'); //if fProjectType in [ptApplication] then
// Add('{$AppType Gui} // for win32 applications');
Add(''); Add('');
Add('uses'); Add('uses');
case fProjectType of case fProjectType of
@ -2738,6 +2739,9 @@ end.
{ {
$Log$ $Log$
Revision 1.141 2003/11/25 08:59:01 mattias
fixed a few more black colors
Revision 1.140 2003/11/22 23:56:33 mattias Revision 1.140 2003/11/22 23:56:33 mattias
fixed win32 intf menu height from Wojciech fixed win32 intf menu height from Wojciech

7
lcl/graphics.pp
View File

@ -846,7 +846,7 @@ type
Handle is interface dependent. } Handle is interface dependent. }
TBitmapInternalStateFlag = ( TBitmapInternalStateFlag = (
bmisCreateingCanvas bmisCreatingCanvas
); );
TBitmapInternalState = set of TBitmapInternalStateFlag; TBitmapInternalState = set of TBitmapInternalStateFlag;
@ -897,7 +897,7 @@ type
procedure SetWidth(NewWidth: Integer); override; procedure SetWidth(NewWidth: Integer); override;
procedure WriteData(Stream: TStream); override; procedure WriteData(Stream: TStream); override;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual; procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
procedure StoreOriginalStream(Stream: TStream); virtual; procedure StoreOriginalStream(Stream: TStream; Size: integer); virtual;
{$IFDEF UseFPImage} {$IFDEF UseFPImage}
procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint; procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint;
ReaderClass: TFPCustomImageReaderClass); virtual; ReaderClass: TFPCustomImageReaderClass); virtual;
@ -1257,6 +1257,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.98 2003/11/25 08:59:01 mattias
fixed a few more black colors
Revision 1.97 2003/11/22 17:22:14 mattias Revision 1.97 2003/11/22 17:22:14 mattias
moved TBevelCut to controls.pp moved TBevelCut to controls.pp

34
lcl/include/bitmap.inc
View File

@ -128,14 +128,14 @@ end;
procedure TBitmap.CreateCanvas; procedure TBitmap.CreateCanvas;
begin begin
if (FCanvas <> nil) or (bmisCreateingCanvas in FInternalState) then exit; if (FCanvas <> nil) or (bmisCreatingCanvas in FInternalState) then exit;
Include(FInternalState,bmisCreateingCanvas); Include(FInternalState,bmisCreatingCanvas);
try try
FCanvas := TBitmapCanvas.Create(Self); FCanvas := TBitmapCanvas.Create(Self);
FCanvas.OnChange := @Changed; FCanvas.OnChange := @Changed;
FCanvas.OnChanging := @Changing; FCanvas.OnChanging := @Changing;
finally finally
Exclude(FInternalState,bmisCreateingCanvas); Exclude(FInternalState,bmisCreatingCanvas);
end; end;
end; end;
@ -486,7 +486,7 @@ begin
end; end;
// store original stream // store original stream
StoreOriginalStream(Stream); StoreOriginalStream(Stream,Size);
MemStream:=FImage.SaveStream; MemStream:=FImage.SaveStream;
// determine stream type // determine stream type
@ -684,19 +684,19 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TBitmap.StoreOriginalStream(Stream: TStream); procedure TBitmap.StoreOriginalStream(Stream: TStream; Size: integer);
var var
MemStream: TMemoryStream; MemStream: TMemoryStream;
begin begin
if Stream<>FImage.SaveStream then begin if Stream<>FImage.SaveStream then begin
MemStream:=TMemoryStream.Create; MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(Stream,Stream.Size-Stream.Position); MemStream.CopyFrom(Stream,Size);
FreeAndNil(FImage.FSaveStream); FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream; FImage.SaveStream:=MemStream;
end else end else
MemStream:=FImage.SaveStream; MemStream:=FImage.SaveStream;
FImage.SaveStreamType:=bnNone; FImage.SaveStreamType:=bnNone;
MemStream.Position:=0; FImage.SaveStream.Position:=0;
end; end;
{$IFDEF UseFPImage} {$IFDEF UseFPImage}
@ -706,6 +706,7 @@ var
IntfImg: TLazIntfImage; IntfImg: TLazIntfImage;
ImgReader: TFPCustomImageReader; ImgReader: TFPCustomImageReader;
ImgHandle, ImgMaskHandle: HBitmap; ImgHandle, ImgMaskHandle: HBitmap;
NewSaveStream: TMemoryStream;
begin begin
UnshareImage; UnshareImage;
if Size = 0 then begin if Size = 0 then begin
@ -713,22 +714,29 @@ begin
Height:=0; Height:=0;
exit; exit;
end; end;
StoreOriginalStream(Stream); StoreOriginalStream(Stream,Size);
IntfImg:=nil; IntfImg:=nil;
ImgReader:=nil; ImgReader:=nil;
try try
// store save stream during reading
NewSaveStream:=FImage.SaveStream;
FImage.SaveStream:=nil;
// read image
IntfImg:=TLazIntfImage.Create(0,0); IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.GetDescriptionFromDevice(0); IntfImg.GetDescriptionFromDevice(0);
ImgReader:=ReaderClass.Create; ImgReader:=ReaderClass.Create;
InitFPImageReader(ImgReader); InitFPImageReader(ImgReader);
FImage.SaveStream.Position:=0; NewSaveStream.Position:=0;
IntfImg.LoadFromStream(FImage.SaveStream,ImgReader); IntfImg.LoadFromStream(NewSaveStream,ImgReader);
FinalizeFPImageReader(ImgReader); FinalizeFPImageReader(ImgReader);
IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle); IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle);
Handle:=ImgHandle; Handle:=ImgHandle;
MaskHandle:=ImgMaskHandle; MaskHandle:=ImgMaskHandle;
finally finally
// restore save stream
FImage.SaveStream:=NewSaveStream;
// clean up
IntfImg.Free; IntfImg.Free;
ImgReader.Free; ImgReader.Free;
end; end;
@ -760,6 +768,7 @@ begin
exit; exit;
end; end;
writeln('WriteStreamWithFPImage');
// write image to temporary stream // write image to temporary stream
MemStream:=TMemoryStream.Create; MemStream:=TMemoryStream.Create;
IntfImg:=nil; IntfImg:=nil;
@ -780,7 +789,7 @@ begin
FImage.SaveStreamType:=bnNone; FImage.SaveStreamType:=bnNone;
MemStream:=nil; MemStream:=nil;
// copy savestream to destination stream // copy savestream to destination stream
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size); DoWriteOriginal;
finally finally
MemStream.Free; MemStream.Free;
IntfImg.Free; IntfImg.Free;
@ -953,6 +962,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.51 2003/11/25 08:59:01 mattias
fixed a few more black colors
Revision 1.50 2003/11/23 14:09:45 mattias Revision 1.50 2003/11/23 14:09:45 mattias
fixed mem leak thx to Vincent fixed mem leak thx to Vincent

8
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -205,6 +205,7 @@ var
TheWinControl: TWinControl; TheWinControl: TWinControl;
ClientWidget: PGtkWidget; ClientWidget: PGtkWidget;
MainWidget: PGtkWidget; MainWidget: PGtkWidget;
ClientAreaStyle: PGtkStyle;
begin begin
{$ifdef GTK2} {$ifdef GTK2}
Result := False; Result := False;
@ -237,7 +238,7 @@ begin
//if TheWinControl<>nil then write(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',HexStr(Cardinal(TheWinControl.Handle),8)); //if TheWinControl<>nil then write(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',HexStr(Cardinal(TheWinControl.Handle),8));
//writeln(' Widget=',HexStr(Cardinal(Widget),8),' Fixed=',HexStr(Cardinal(GetFixedWidget(Widget)),8),' Main=',HexStr(Cardinal(GetMainWidget(Widget)),8)); //writeln(' Widget=',HexStr(Cardinal(Widget),8),' Fixed=',HexStr(Cardinal(GetFixedWidget(Widget)),8),' Main=',HexStr(Cardinal(GetMainWidget(Widget)),8));
if (TheWinControl<>nil) then begin if (TheWinControl<>nil) then begin
BeginGDKErrorTrap; {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
NewEventMask:=gdk_window_get_events(GetControlWindow(Widget)) NewEventMask:=gdk_window_get_events(GetControlWindow(Widget))
or WinWidgetInfo^.EventMask; or WinWidgetInfo^.EventMask;
gdk_window_set_events(GetControlWindow(Widget),NewEventMask); gdk_window_set_events(GetControlWindow(Widget),NewEventMask);
@ -248,7 +249,7 @@ begin
gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask); gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask);
end; end;
//writeln('BBB1 ',HexStr(Cardinal(NewEventMask),8),' ',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8)); //writeln('BBB1 ',HexStr(Cardinal(NewEventMask),8),' ',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8));
EndGDKErrorTrap; {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end; end;
if TheWinControl<>nil then begin if TheWinControl<>nil then begin
@ -3192,6 +3193,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.205 2003/11/25 08:59:01 mattias
fixed a few more black colors
Revision 1.204 2003/10/19 16:33:10 marc Revision 1.204 2003/10/19 16:33:10 marc
* Fixed VKey keypad handling * Fixed VKey keypad handling

26
lcl/interfaces/gtk/gtkproc.inc
View File

@ -4793,6 +4793,7 @@ var
SysColor: TColorRef; SysColor: TColorRef;
BaseColor: TColorRef; BaseColor: TColorRef;
Red, Green, Blue: byte; Red, Green, Blue: byte;
success: Boolean;
begin begin
BaseColor := Color and $FF; BaseColor := Color and $FF;
@ -5041,11 +5042,23 @@ begin
end; end;
?????????????????} ?????????????????}
end; end;
if (style <> nil) then
if (style^.colormap <> nil) then if (result.foreground.pixel = 0) and ((result.foreground.red <> 0) or
gdk_colormap_query_color(style^.colormap,result.foreground.pixel, @result.foreground) (result.foreground.blue <> 0) or (result.foreground.green <> 0)) then
else begin
gdk_colormap_query_color(gdk_colormap_get_system(),result.foreground.pixel, @result.foreground) if (style <> nil) and (style^.colormap <> nil) then
gdk_colormap_alloc_colors(style^.colormap, @result.foreground, 1,
false, true, nil)
else
gdk_colormap_alloc_colors(gdk_colormap_get_system(),
@result.foreground, 1, false, true, @success);
end else
if (style <> nil) and (style^.colormap <> nil) then
gdk_colormap_query_color(style^.colormap,result.foreground.pixel,
@result.foreground)
else
gdk_colormap_query_color(gdk_colormap_get_system(),
result.foreground.pixel, @result.foreground);
end; end;
Function StyleForegroundColor(Color : TColorRef; DefaultColor : PGDKColor): PGDKColor; Function StyleForegroundColor(Color : TColorRef; DefaultColor : PGDKColor): PGDKColor;
@ -5601,6 +5614,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.229 2003/11/25 08:59:01 mattias
fixed a few more black colors
Revision 1.228 2003/11/23 13:13:35 mattias Revision 1.228 2003/11/23 13:13:35 mattias
added clWindow for gtklistitem added clWindow for gtklistitem