paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-29 00:37:19 +01:00
Code Issues Packages Projects Releases Wiki Activity

MWE:

Browse Source 
+ Added CreateCompatibeleBitamp function
  + Updated TWinControl.WMPaint
  + Added some checks to avoid gtk/gdk errors
  - Removed no fixed warning from GetDC
  - Removed some output

git-svn-id: trunk@34 -
This commit is contained in:
lazarus 2000-09-10 23:08:31 +00:00
parent 8d46c53658
commit a2060eac49
16 changed files with 419 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
designer/controlselection.pp
View File

@ -174,6 +174,7 @@ end;
procedure TGrabber.PaintWindow(DC: HDC); procedure TGrabber.PaintWindow(DC: HDC);
begin begin
WriteLn(Format('[TGrabber.PaintWindow] 0x%x', [DC]));
FillRect(DC, Rect(0, 0, Width, Height), GetStockObject(BLACK_BRUSH)); FillRect(DC, Rect(0, 0, Width, Height), GetStockObject(BLACK_BRUSH));
end; end;
@ -336,22 +337,20 @@ end;
procedure TControlSelection.GrabberMove(Sender: TObject; dx, dy: Integer); procedure TControlSelection.GrabberMove(Sender: TObject; dx, dy: Integer);
begin begin
with TGrabber(Sender) do if gpLeft in TGrabber(Sender).Positions
begin
if gpLeft in Positions
then begin then begin
Inc(FLeft, dx); Inc(FLeft, dx);
Dec(FWidth, dx); Dec(FWidth, dx);
end; end;
if gpRight in Positions then Inc(FWidth, dx); if gpRight in TGrabber(Sender).Positions then Inc(FWidth, dx);
if gpTop in Positions if gpTop in TGrabber(Sender).Positions
then begin then begin
Inc(FTop, dy); Inc(FTop, dy);
Dec(FHeight, dy) Dec(FHeight, dy)
end; end;
if gpBottom in Positions then Inc(FHeight, dy); if gpBottom in TGrabber(Sender).Positions then Inc(FHeight, dy);
end;
SetGrabbers; SetGrabbers;
end; end;
@ -403,26 +402,27 @@ end;
procedure TControlSelection.SetGrabbers; procedure TControlSelection.SetGrabbers;
var var
GrabPos: TGrabIndex; GrabPos: TGrabIndex;
Grabber: TGrabber;
begin begin
for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do
with FGrabbers[GrabPos] do
begin begin
Grabber := FGrabbers[GrabPos];
if FVisible if FVisible
then begin then begin
if gpLeft in Positions if gpLeft in Grabber.Positions
then Left := FLeft - GRAB_SIZE then Grabber.Left := FLeft - GRAB_SIZE
else if gpRight in Positions else if gpRight in Grabber.Positions
then Left := FLeft + FWidth then Grabber.Left := FLeft + FWidth
else Left := FLeft + (FWidth - GRAB_SIZE) div 2; else Grabber.Left := FLeft + (FWidth - GRAB_SIZE) div 2;
if gpTop in Positions if gpTop in Grabber.Positions
then Top := FTop - GRAB_SIZE then Grabber.Top := FTop - GRAB_SIZE
else if gpBottom in Positions else if gpBottom in Grabber.Positions
then Top := FTop + FHeight then Grabber.Top := FTop + FHeight
else Top := FTop + (FHeight - GRAB_SIZE) div 2; else Grabber.Top := FTop + (FHeight - GRAB_SIZE) div 2;
end; end;
Visible := FVisible; Grabber.Visible := FVisible;
end; end;
end; end;

9
ide/lazarus.pp
View File

@ -58,7 +58,6 @@ begin
Application.CreateForm(TIDEEditor, IdeEditor1); Application.CreateForm(TIDEEditor, IdeEditor1);
Application.CreateForm(TViewUnits1, ViewUnits1); Application.CreateForm(TViewUnits1, ViewUnits1);
Application.CreateForm(TViewForms1, ViewForms1); Application.CreateForm(TViewForms1, ViewForms1);
SplashForm.StartTimer; SplashForm.StartTimer;
Application.Run; Application.Run;
end. end.
@ -66,6 +65,14 @@ end.
{ {
$Log$ $Log$
Revision 1.4 2000/09/10 23:08:29 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.3 2000/08/09 18:32:10 lazarus Revision 1.3 2000/08/09 18:32:10 lazarus
Added more code for the find function. Added more code for the find function.
Shane Shane

9
ide/splash.pp
View File

@ -347,7 +347,6 @@ end;
procedure TSplashForm.HideFormTimer(Sender : TObject); procedure TSplashForm.HideFormTimer(Sender : TObject);
begin begin
Writeln('Timer fired!');
Click; Click;
end; end;
@ -368,6 +367,14 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.2 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.1 2000/07/13 10:27:48 michael Revision 1.1 2000/07/13 10:27:48 michael
+ Initial import + Initial import

5
lcl/Makefile
View File

@ -197,8 +197,8 @@ ZIPTARGET=install
# Directories # Directories
override NEEDUNITDIR=$(UNITTARGETDIR) ./interfaces/$(LCLPLATFORM) override NEEDUNITDIR=$(UNITTARGETDIR) . ./interfaces/$(LCLPLATFORM)
override NEEDINCDIR=./include override NEEDINCDIR=./include ./interfaces/$(LCLPLATFORM)
ifndef UNITTARGETDIR ifndef UNITTARGETDIR
UNITTARGETDIR=./units UNITTARGETDIR=./units
endif endif
@ -1234,7 +1234,6 @@ endif
# Users rules # Users rules
##################################################################### #####################################################################
cleartarget: cleartarget:
-$(DEL) allunits$(EXEEXT) -$(DEL) allunits$(EXEEXT)

4
lcl/Makefile.fpc
View File

@ -14,8 +14,8 @@ files=$(wildcard $(UNITTARGETDIR)/*$(OEXT))
[dirs] [dirs]
unittargetdir=./units unittargetdir=./units
unitdir=$(UNITTARGETDIR) ./interfaces/$(LCLPLATFORM) unitdir=$(UNITTARGETDIR) . ./interfaces/$(LCLPLATFORM)
incdir=./include incdir=./include ./interfaces/$(LCLPLATFORM)
[install] [install]

10
lcl/include/bitmapcanvas.inc
View File

@ -32,7 +32,7 @@ begin
FBitmap.PaletteNeeded; FBitmap.PaletteNeeded;
hDC := CreateCompatibleDC(0); hDC := CreateCompatibleDC(0);
WriteLN(Format('[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle])); Assert(False, Format('trace:[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle]));
if FBitmap.Handle = 0 if FBitmap.Handle = 0
then FOldBitmap := 0 then FOldBitmap := 0
@ -87,6 +87,14 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.2 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.1 2000/07/13 10:28:24 michael Revision 1.1 2000/07/13 10:28:24 michael
+ Initial import + Initial import

31
lcl/include/winapi.inc
View File

@ -46,6 +46,11 @@ Begin
Result := InterfaceObject.CreateCaret(Handle, Bitmap, width, Height); Result := InterfaceObject.CreateCaret(Handle, Bitmap, width, Height);
end; end;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
begin
Result := InterfaceObject.CreateCompatibleBitmap(DC, Width, Height);
end;
function CreateCompatibleDC(DC: HDC): HDC; function CreateCompatibleDC(DC: HDC): HDC;
begin begin
Result := InterfaceObject.CreateCompatibleDC(DC); Result := InterfaceObject.CreateCompatibleDC(DC);
@ -386,12 +391,12 @@ begin
Result := InterfaceObject.StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Mask, XMask, YMask, Rop); Result := InterfaceObject.StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Mask, XMask, YMask, Rop);
end; end;
Function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
begin begin
Result := InterfaceObject.TextOut(DC, X, Y, Str, Count); Result := InterfaceObject.TextOut(DC, X, Y, Str, Count);
end; end;
Function WindowFromPoint(Point : TPoint) : HWND; function WindowFromPoint(Point : TPoint) : HWND;
begin begin
Result := InterfaceObject.WindowFromPoint(Point); Result := InterfaceObject.WindowFromPoint(Point);
end; end;
@ -426,10 +431,15 @@ end;
Returns: Returns:
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function BeginPaint(Handle : hwnd; Var PS : TPaintStruct) : hdc; function BeginPaint(Handle : hwnd; Var PS : TPaintStruct) : hdc;
Begin begin
Assert(False, Format('Trace:> [BeginPaint] HWND: 0x%x', [Handle]));
//TODO: Finish this. BEGINPAINT //TODO: Finish this. BEGINPAINT
// Move to platform dependent ??
Result := Getdc(Handle); Result := Getdc(Handle);
Assert(False, Format('Trace:< [BeginPaint] HWND: 0x%x --> 0x%x', [Handle, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -439,7 +449,7 @@ end;
Returns: Returns:
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function CharLowerBuff(pStr : PChar; Len : Integer): Integer; function CharLowerBuff(pStr : PChar; Len : Integer): Integer;
begin begin
// your code here // your code here
//TODO:WINAPI call CHARLOWERBUFF //TODO:WINAPI call CHARLOWERBUFF
@ -529,8 +539,11 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
Begin Begin
Assert(False, Format('Trace:> [EndPaint] HWND: 0x%x', [Handle]));
//TODO: Finish EndPaint in winapi.inc //TODO: Finish EndPaint in winapi.inc
Result := 1; Result := 1;
Assert(False, Format('Trace:< [EndPaint] HWND: 0x%x --> 0x%x', [Handle, Result]));
end; end;
@ -926,6 +939,14 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.5 2000/08/14 12:31:12 lazarus Revision 1.5 2000/08/14 12:31:12 lazarus
Minor modifications for SynEdit . Minor modifications for SynEdit .
Shane Shane

9
lcl/include/winapih.inc
View File

@ -27,6 +27,7 @@ Function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean; {$IFDEF IF_BAS
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateCaret(Handle: HWND; Bitmap: hBitmap; width, Height: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreateCaret(Handle: HWND; Bitmap: hBitmap; width, Height: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateCompatibleDC(DC: HDC): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreateCompatibleDC(DC: HDC): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreateFont --> independent //function CreateFont --> independent
function CreateFontIndirect(const LogFont: TLogFont): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreateFontIndirect(const LogFont: TLogFont): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -215,6 +216,14 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.5 2000/08/14 12:31:12 lazarus Revision 1.5 2000/08/14 12:31:12 lazarus
Minor modifications for SynEdit . Minor modifications for SynEdit .
Shane Shane

23
lcl/include/wincontrol.inc
View File

@ -439,6 +439,7 @@ var
DC: HDC; DC: HDC;
PS: TPaintStruct; //defined in LCLLinux.pp PS: TPaintStruct; //defined in LCLLinux.pp
begin begin
Assert(False, Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, Message.DC]));
DC := Message.DC; DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS); if DC = 0 then DC := BeginPaint(Handle, PS);
try try
@ -462,6 +463,7 @@ begin
finally finally
if Message.DC = 0 then EndPaint(Handle, PS); if Message.DC = 0 then EndPaint(Handle, PS);
end; end;
Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
end; end;
@ -1257,7 +1259,7 @@ var
PS : TPaintStruct; PS : TPaintStruct;
I : Integer; I : Integer;
begin begin
Assert(False, Format('Trace:[TWinControl.WMPaint] %s', [ClassName])); Assert(False, Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC]));
if (Msg.DC <> 0) then if (Msg.DC <> 0) then
begin begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then if not (csCustomPaint in ControlState) and (ControlCount = 0) then
@ -1269,10 +1271,10 @@ begin
end end
else begin else begin
DC := GetDC(0); DC := GetDC(0);
// MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom); MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(0, DC); ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0); MemDC := CreateCompatibleDC(0);
// OldBitmap := SelectObject(MemDC, MemBitmap); OldBitmap := SelectObject(MemDC, MemBitmap);
try try
DC := BeginPaint(Handle, PS); DC := BeginPaint(Handle, PS);
//ToDO:define wm_erasebkgnd //ToDO:define wm_erasebkgnd
@ -1281,14 +1283,15 @@ begin
WMPaint(Msg); WMPaint(Msg);
Msg.DC := 0; Msg.DC := 0;
//TODO:bitblt //TODO:bitblt
// BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY); BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
EndPaint(Handle, PS); EndPaint(Handle, PS);
finally finally
// SelectObject(MemDC, OldBitmap); SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC); DeleteDC(MemDC);
// DeleteObject(MemBitmap); DeleteObject(MemBitmap);
end; end;
end; end;
Assert(False, Format('Trace:< [TWinControl.WMPaint] %s', [ClassName]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1857,6 +1860,14 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.3 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.2 2000/07/30 21:48:32 lazarus Revision 1.2 2000/07/30 21:48:32 lazarus
MWE: MWE:
= Moved ObjectToGTKObject to GTKProc unit = Moved ObjectToGTKObject to GTKProc unit

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

@ -5,6 +5,7 @@
{$ENDIF} {$ENDIF}
// temp solution to fill msgqueue // temp solution to fill msgqueue
function DeliverPostMessage(const Target: Pointer; var Message): GBoolean; function DeliverPostMessage(const Target: Pointer; var Message): GBoolean;
begin begin
@ -79,28 +80,32 @@ end;
// Unused: Longint; // Unused: Longint;
// Result: Longint; // Result: Longint;
// end; // end;
function gtkdraw( widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl; function gtkdraw(Widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl;
var var
MSG: TLMPaint; MSG: TLMPaint;
begin begin
Result := True; Result := True;
EventTrace('draw', data); EventTrace('draw', data);
MSG.Msg := LM_PAINT; MSG.Msg := LM_PAINT;
// TODO: get DC MSG.DC := GetDC(THandle(Widget));
MSG.DC := 0;
MSG.Unused := 0; MSG.Unused := 0;
Result := DeliverMessage(Data, MSG) = 0;
Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, MSG) = 0;
end; end;
function GTKDrawDefault(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl; function GTKDrawDefault(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
var var
Mess : TLMessage; MSG : TLMPaint;
begin begin
Result := True; Result := True;
EventTrace('draw', data); EventTrace('draw', data);
Mess.Msg := LM_PAINT; MSG.Msg := LM_PAINT;
Result := DeliverMessage(Data, Mess) = 0; MSG.DC := GetDC(THandle(Widget));
MSG.Unused := 0;
Result := DeliverPostMessage(Data, MSG);
end; end;
function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl; function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
@ -113,10 +118,10 @@ end;
function GTKExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose; Data: gPointer): GBoolean; cdecl; function GTKExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose; Data: gPointer): GBoolean; cdecl;
var var
Mess : TLMessage; // Mess : TLMessage;
fWindow : pgdkWindow; // fWindow : pgdkWindow;
widget2: pgtkWidget; // widget2: pgtkWidget;
PixMap : pgdkPixMap; // PixMap : pgdkPixMap;
msg: TLMPaint; msg: TLMPaint;
begin begin
@ -124,10 +129,12 @@ begin
EventTrace('expose-event', data); EventTrace('expose-event', data);
msg.msg := LM_PAINT; msg.msg := LM_PAINT;
msg.DC := 0; MSG.DC := GetDC(THandle(Widget));
msg.Unused := 0; msg.Unused := 0;
Result := DeliverMessage(Data, msg) = 0; Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, msg) = 0;
(* (*
@ -1068,6 +1075,14 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.5 2000/08/28 14:23:49 lazarus Revision 1.5 2000/08/28 14:23:49 lazarus
Added a few files for the start of creating classes for the editor. [SHANE] Added a few files for the start of creating classes for the editor. [SHANE]

38
lcl/interfaces/gtk/gtkobject.inc
View File

@ -2,6 +2,12 @@
TGTKObject TGTKObject
******************************************************************************) ******************************************************************************)
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
const const
BOOL_RESULT: array[Boolean] of String = ('False', 'True'); BOOL_RESULT: array[Boolean] of String = ('False', 'True');
@ -592,8 +598,11 @@ begin
LM_SCREENINIT : LM_SCREENINIT :
begin begin
WriteLN('LM_SCREENINIT called --> should go to GTKObject.Init');
WriteLN('TODO: check this');
{ Initialize gdk } { Initialize gdk }
//??? shouldn't this go to init ???? //??? shouldn't this go to init ????
// MWE: Move this to init !!!!!
gdk_init(@argc, @argv); gdk_init(@argc, @argv);
//???--???? //???--????
{ Compute pixels per inch variable } { Compute pixels per inch variable }
@ -899,7 +908,9 @@ begin
begin begin
pFixed := GetFixedWidget(PGtkWidget(Parent.Handle)); pFixed := GetFixedWidget(PGtkWidget(Parent.Handle));
if pFixed <> nil if pFixed <> nil
then gtk_fixed_move(pFixed, pWidget, Left, Top) then begin
gtk_fixed_move(pFixed, pWidget, Left, Top);
end
else Assert(False, 'Trace:ERROR!!!! - no Fixed Widget found to use when resizing....'); else Assert(False, 'Trace:ERROR!!!! - no Fixed Widget found to use when resizing....');
end end
else begin else begin
@ -1770,8 +1781,8 @@ begin
Without, the notebook dumps Without, the notebook dumps
This should be fixed someday This should be fixed someday
} }
Assert(False, 'Trace:FIXME !!! [TgtkObject.CreateComponent] csNotebook --> gtk_Object_Set_Data'); // Assert(False, 'Trace:FIXME !!! [TgtkObject.CreateComponent] csNotebook --> gtk_Object_Set_Data');
SetFixedWidget(p, p); // SetFixedWidget(p, p);
end; end;
@ -2534,7 +2545,7 @@ function TgtkObject.NewDC: PDeviceContext;
var var
n: Integer; n: Integer;
begin begin
Assert(False, Format('Trace:==> [TgtkObject.NewDC]', [])); Assert(False, Format('Trace:> [TgtkObject.NewDC]', []));
New(Result); New(Result);
with Result^ do with Result^ do
begin begin
@ -2552,7 +2563,7 @@ begin
gdk_color_white(gdk_colormap_get_system, @CurrentBackColor); gdk_color_white(gdk_colormap_get_system, @CurrentBackColor);
end; end;
n := FDeviceContexts.Add(Result); n := FDeviceContexts.Add(Result);
Assert(False, Format('Trace:<== [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result])); Assert(False, Format('Trace:< [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2566,12 +2577,12 @@ function TgtkObject.NewGDIObject(const GDIType: TGDIType): PGdiObject;
var var
n: Integer; n: Integer;
begin begin
Assert(False, Format('Trace:==> [TgtkObject.NewGDIObject]', [])); Assert(False, Format('Trace:> [TgtkObject.NewGDIObject]', []));
New(Result); New(Result);
FillChar(Result^, SizeOf(TGDIObject), 0); FillChar(Result^, SizeOf(TGDIObject), 0);
Result^.GDIType := GDIType; Result^.GDIType := GDIType;
n := FGDIObjects.Add(Result); n := FGDIObjects.Add(Result);
Assert(False, Format('Trace:<== [TgtkObject.NewGDIObject] FGDIObjects[%d] --> 0x%p', [n, Result])); Assert(False, Format('Trace:< [TgtkObject.NewGDIObject] FGDIObjects[%d] --> 0x%p', [n, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2616,9 +2627,22 @@ begin
end; end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
{$ENDIF}
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.8 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.7 2000/08/10 10:55:45 lazarus Revision 1.7 2000/08/10 10:55:45 lazarus
Changed TCustomDialog to TCommonDialog Changed TCustomDialog to TCommonDialog
Shane Shane

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

@ -55,7 +55,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function CopyDCData(const DestinationDC, SourceDC: PDeviceContext): Boolean; function CopyDCData(const DestinationDC, SourceDC: PDeviceContext): Boolean;
var var
GCValues: PGDKGCValues; GCValues: TGDKGCValues;
begin begin
Assert(False, 'Trace:[CopyDCData]'); Assert(False, 'Trace:[CopyDCData]');
Result := (DestinationDC <> nil) and (SourceDC <> nil); Result := (DestinationDC <> nil) and (SourceDC <> nil);
@ -68,8 +68,9 @@ begin
if (SourceDC^.GC = nil) or (Drawable = nil) if (SourceDC^.GC = nil) or (Drawable = nil)
then GC := nil then GC := nil
else begin else begin
gdk_gc_get_values(SourceDC^.GC, GCValues); gdk_gc_get_values(SourceDC^.GC, @GCValues);
GC := gdk_gc_new_with_values(Drawable, GCValues, $FFFF); //GC := gdk_gc_new(Drawable);
GC := gdk_gc_new_with_values(Drawable, @GCValues, 3 { $3FF});
end; end;
PenPos := SourceDC^.PenPos; PenPos := SourceDC^.PenPos;
CurrentBitmap := SourceDC^.CurrentBitmap; CurrentBitmap := SourceDC^.CurrentBitmap;
@ -485,7 +486,7 @@ var
begin begin
if not assigned (AObject) then if not assigned (AObject) then
begin begin
assert (false, 'TRACE: ObjectToGtkObject: object not assigned'); assert (false, 'TRACE: [ObjectToGtkObject] Object not assigned');
handle := 0 handle := 0
end end
else if (AObject is TWinControl) then else if (AObject is TWinControl) then
@ -505,11 +506,11 @@ begin
{if TCommonDialog(AObject).HandleAllocated then } handle := TCommonDialog(AObject).Handle {if TCommonDialog(AObject).HandleAllocated then } handle := TCommonDialog(AObject).Handle
end end
else begin else begin
Assert(False, 'Trace:Message received with unhandled class-type'); Assert(False, Format('Trace: [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AObject.ClassName]));
handle := 0; handle := 0;
end; end;
result := gtk_object (handle); result := gtk_object (handle);
if handle = 0 then assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******'); if handle = 0 then Assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******');
end; end;
@ -654,6 +655,14 @@ end;
{ {
$Log$ $Log$
Revision 1.4 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.3 2000/08/10 10:55:45 lazarus Revision 1.3 2000/08/10 10:55:45 lazarus
Changed TCustomDialog to TCommonDialog Changed TCustomDialog to TCommonDialog
Shane Shane

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

@ -128,11 +128,31 @@ begin
// TODO: Add ROP // TODO: Add ROP
// ----------------------------------
// MWE: Temporary commented out due to compiler problems
// The called functions can't access local vars outside
// themselves when they are called through a const or a var.
// Since only DrawableToDrawable is implemented,
// it is for the time beeing handled by an if statement
// ----------------------------------
(*
Result := DRAWABLE_MATRIX[ Result := DRAWABLE_MATRIX[
PDeviceContext(SrcDC)^.Drawable <> nil, PDeviceContext(SrcDC)^.Drawable <> nil,
PDeviceContext(DestDC)^.Drawable <> nil PDeviceContext(DestDC)^.Drawable <> nil
](); ]();
*)
// ----------------------------------
// MWE: Begin of temporary part
// ----------------------------------
if (PDeviceContext(SrcDC)^.Drawable <> nil)
and (PDeviceContext(DestDC)^.Drawable <> nil)
then Result := DrawableToDrawable
else Result := False;
// ----------------------------------
// MWE: End of temporary part
// ----------------------------------
end; end;
end; end;
@ -198,7 +218,7 @@ var
GdiObject: PGdiObject; GdiObject: PGdiObject;
RawImage: PGDIRawImage; RawImage: PGDIRawImage;
begin begin
Assert(False, Format('Trace:==> [TgtkObject.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, Longint(BitmapBits)])); Assert(False, Format('Trace:> [TgtkObject.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, Longint(BitmapBits)]));
if (BitCount < 1) or (Bitcount > 32) if (BitCount < 1) or (Bitcount > 32)
then begin then begin
@ -232,7 +252,7 @@ begin
end; end;
Result := HBITMAP(GdiObject); Result := HBITMAP(GdiObject);
Assert(False, Format('Trace:<== [TgtkObject.CreateBitmap] --> 0x%x', [Integer(Result)])); Assert(False, Format('Trace:< [TgtkObject.CreateBitmap] --> 0x%x', [Integer(Result)]));
end; end;
@ -256,7 +276,7 @@ var
GObject: PGdiObject; GObject: PGdiObject;
sError: String; sError: String;
begin begin
Assert(False, Format('Trace:[TgtkObject.CreateBrushIndirect] Style: %d, Color: %8x', [LogBrush.lbStyle, LogBrush.lbColor])); Assert(False, Format('Trace:> [TgtkObject.CreateBrushIndirect] Style: %d, Color: %8x', [LogBrush.lbStyle, LogBrush.lbColor]));
sError := ''; sError := '';
GObject := NewGDIObject(gdiBrush); GObject := NewGDIObject(gdiBrush);
@ -321,7 +341,7 @@ begin
Result := 0; Result := 0;
Dispose(GObject); Dispose(GObject);
end; end;
Assert(False, Format('Trace:[TgtkObject.CreateBrushIndirect] Got --> %x', [Result])); Assert(False, Format('Trace:< [TgtkObject.CreateBrushIndirect] Got --> %x', [Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -359,6 +379,32 @@ begin
end; end;
{------------------------------------------------------------------------------
Function: CreateCompatibleBitmap
Params: DC:
Width:
Height:
Returns:
Creates a bitmap compatible with the specified device context.
------------------------------------------------------------------------------}
function TGTKObject.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
var
visual: PGDKVisual;
begin
Assert(False, Format('Trace:> [TgtkObject.CreateCompatibleBitmap] DC: 0x%x, W: %d, H: %d', [DC, Width, Height]));
if (IsValidDC(DC) and (PDeviceContext(DC)^.Drawable <> nil))
then visual := gdk_window_get_visual(Pointer(PDeviceContext(DC)^.Drawable))
else visual := gdk_visual_get_system;
if Visual <> nil
then Result := CreateBitmap(Width, Height, 1, Visual^.Depth, nil)
else Result := 0;
Assert(False, Format('Trace:< [TgtkObject.CreateCompatibleBitmap] DC: 0x%x --> 0x%x', [DC, Result]));
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: CreateCompatibleDC Function: CreateCompatibleDC
Params: none Params: none
@ -677,7 +723,9 @@ function TgtkObject.DeleteObject(GDIObject: HGDIOBJ): Boolean;
begin begin
{ Find out if we want to release internal GDI object } { Find out if we want to release internal GDI object }
Result:= IsValidGDIObject(GDIObject); Result:= IsValidGDIObject(GDIObject);
if Result or (PGdiObject(GDIObject) <> nil) then with PGdiObject(GDIObject)^ do if Result or (PGdiObject(GDIObject) <> nil)
then
with PGdiObject(GDIObject)^ do
begin begin
case GDIType of case GDIType of
gdiFont: gdiFont:
@ -686,12 +734,15 @@ begin
end; end;
gdiBrush: gdiBrush:
begin begin
if Result then gdk_bitmap_unref(GDIBrushPixmap); if Result and (GDIBrushPixmap <> nil)
then gdk_bitmap_unref(GDIBrushPixmap);
gdk_colormap_free_colors(gdk_colormap_get_system, @GDIBrushColor, 1); gdk_colormap_free_colors(gdk_colormap_get_system, @GDIBrushColor, 1);
end; end;
gdiBitmap: gdiBitmap:
begin begin
if Result then gdk_bitmap_unref(GDIBitmapObject); if Result and (GDIBitmapObject <> nil)
then gdk_bitmap_unref(GDIBitmapObject);
end; end;
gdiPen: gdiPen:
begin begin
@ -704,6 +755,7 @@ begin
end; end;
end; end;
end; end;
{ Dispose of the GDI object } { Dispose of the GDI object }
if PGDIObject(GDIObject) <> nil if PGDIObject(GDIObject) <> nil
then begin then begin
@ -814,7 +866,7 @@ Var
Width, Height: Integer; Width, Height: Integer;
R: TRect; R: TRect;
begin begin
Assert(False, Format('trace:[TgtkObject.DrawEdge] DC:0x%x, Rect = %d,%d,%d,%d', [DC, Rect.Left, Rect.Top,Rect.Right, Rect.Bottom])); Assert(False, Format('trace:> [TgtkObject.DrawEdge] DC:0x%x, Rect = %d,%d,%d,%d', [DC, Rect.Left, Rect.Top,Rect.Right, Rect.Bottom]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -928,6 +980,7 @@ begin
Result := True; Result := True;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.DrawEdge] DC:0x%x, Rect = %d,%d,%d,%d', [DC, Rect.Left, Rect.Top,Rect.Right, Rect.Bottom]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -993,7 +1046,7 @@ var
pStr: PChar; pStr: PChar;
Width, Height: Integer; Width, Height: Integer;
begin begin
Assert(False, Format('trace:[TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); Assert(False, Format('trace:> [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -1035,6 +1088,7 @@ begin
end; end;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1051,7 +1105,7 @@ var
Width, Height: Integer; Width, Height: Integer;
OldCurrentBrush: PGdiObject; OldCurrentBrush: PGdiObject;
begin begin
Assert(False, Format('trace:[TgtkObject.FillRect] DC:0x%x; Rect: ((%d,%d)(%d,%d)); brush: %x', [Integer(DC), Rect.left, rect.top, rect.right, rect.bottom, brush])); Assert(False, Format('trace:> [TgtkObject.FillRect] DC:0x%x; Rect: ((%d,%d)(%d,%d)); brush: %x', [Integer(DC), Rect.left, rect.top, rect.right, rect.bottom, brush]));
Result := IsValidDC(DC) and IsValidGDIObject(Brush); Result := IsValidDC(DC) and IsValidGDIObject(Brush);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -1076,6 +1130,7 @@ begin
Result := True; Result := True;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.FillRect] DC:0x%x; Rect: ((%d,%d)(%d,%d)); brush: %x', [Integer(DC), Rect.left, rect.top, rect.right, rect.bottom, brush]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1158,7 +1213,7 @@ var
Color: TGdkColor; Color: TGdkColor;
nIndex: Integer; nIndex: Integer;
begin begin
Assert(False, Format('trace:[TgtkObject.GetDC] hWND: 0x%x', [hWnd])); Assert(False, Format('trace:> [TgtkObject.GetDC] hWND: 0x%x', [hWnd]));
p := nil; p := nil;
if hWnd = 0 if hWnd = 0
@ -1171,9 +1226,10 @@ begin
pFixed := GetFixedWidget(Pointer(hWnd)); pFixed := GetFixedWidget(Pointer(hWnd));
if pFixed = nil if pFixed = nil
then begin then begin
WriteLn('WARNING: [TgtkObject.GetDC] Window has no fixed'); Assert(False, 'trace:WARNING: [TgtkObject.GetDC] Window has no fixed, using window itself');
end pFixed := Pointer(hWnd);
else begin end;
// create a new devicecontext for this window // create a new devicecontext for this window
P := NewDC; P := NewDC;
p^.hWnd := hWnd; p^.hWnd := hWnd;
@ -1192,7 +1248,6 @@ begin
gdk_gc_get_values(p^.GC, @Values); gdk_gc_get_values(p^.GC, @Values);
end; end;
end;
if p <> nil if p <> nil
then begin then begin
@ -1210,7 +1265,7 @@ begin
p^.CurrentPen := CreateDefaultPen; p^.CurrentPen := CreateDefaultPen;
end; end;
Result := HDC(p); Result := HDC(p);
Assert(False, Format('trace:[TgtkObject.GetDC] Got 0x%x', [Result])); Assert(False, Format('trace:< [TgtkObject.GetDC] Got 0x%x', [Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1382,7 +1437,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.GetStockObject(Value: Integer): LongInt; function TgtkObject.GetStockObject(Value: Integer): LongInt;
begin begin
Assert(False, Format('Trace:[TgtkObject.GetStockObject] %d', [Value])); Assert(False, Format('Trace:> [TgtkObject.GetStockObject] %d', [Value]));
Result := 0; Result := 0;
case Value of case Value of
BLACK_BRUSH: // Black brush. BLACK_BRUSH: // Black brush.
@ -1435,6 +1490,7 @@ begin
else else
Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value])); Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value]));
end; end;
Assert(False, Format('Trace:< [TgtkObject.GetStockObject] %d --> 0x%x', [Value, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1465,7 +1521,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.GetSystemMetrics(nIndex: Integer): Integer; function TgtkObject.GetSystemMetrics(nIndex: Integer): Integer;
begin begin
Assert(False, 'Trace:[TgtkObject.GetSystemMetrics]'); Assert(False, Format('Trace:> [TgtkObject.GetSystemMetrics] %d', [nIndex]));
case nIndex of case nIndex of
SM_ARRANGE: SM_ARRANGE:
begin begin
@ -1745,7 +1801,7 @@ begin
end; end;
else Result := 0; else Result := 0;
end; end;
Assert(False, Format('Trace:< [TgtkObject.GetSystemMetrics] %d --> 0x%x (%d)', [nIndex, Result, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1759,7 +1815,7 @@ function TgtkObject.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var
var var
lbearing, rbearing, width, ascent,descent: LongInt; lbearing, rbearing, width, ascent,descent: LongInt;
begin begin
Assert(False, 'trace:[TgtkObject.GetTextExtentPoint]'); Assert(False, 'trace:> [TgtkObject.GetTextExtentPoint]');
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -1780,6 +1836,7 @@ begin
Size.cY := ascent + descent; Size.cY := ascent + descent;
end; end;
end; end;
Assert(False, 'trace:< [TgtkObject.GetTextExtentPoint]');
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1793,7 +1850,7 @@ function TgtkObject.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
var var
lbearing, rbearing, dummy: LongInt; lbearing, rbearing, dummy: LongInt;
begin begin
Assert(False, 'Trace:TODO FINISH: [TgtkObject.GetTextMetrics]'); Assert(False, Format('Trace:> TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result then with PDeviceContext(DC)^ do begin if Result then with PDeviceContext(DC)^ do begin
@ -1811,7 +1868,7 @@ begin
tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack
end; end;
end; end;
Assert(False, 'Trace:Exiting GetTextMetrics'); Assert(False, Format('Trace:< TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1823,7 +1880,8 @@ Function TgtkObject.GetWindowLong(Handle : hwnd; int : Integer): Longint;
var var
Data : Tobject; Data : Tobject;
begin begin
Assert(False, 'Trace:TODO: [TgtkObject.GETWINDOWLONG] Started but not finished'); //TODO:Started but not finished
Assert(False, Format('Trace:> [TgtkObject.GETWINDOWLONG] HWND: 0x%x, int: 0x%x (%d)', [Handle, int, int]));
case int of case int of
GWL_WNDPROC : GWL_WNDPROC :
@ -1864,6 +1922,7 @@ begin
else Result := 0; else Result := 0;
end; //case end; //case
Assert(False, Format('Trace:< [TgtkObject.GETWINDOWLONG] HWND: 0x%x, int: 0x%x (%d) --> 0x%x (%d)', [Handle, int, int, Result, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1949,7 +2008,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.LineTo(DC: HDC; X, Y: Integer): Boolean; function TgtkObject.LineTo(DC: HDC; X, Y: Integer): Boolean;
begin begin
Assert(False, Format('trace:[TgtkObject.LineTo] DC:0x%x, X:%d, Y:%d', [DC, X, Y])); Assert(False, Format('trace:> [TgtkObject.LineTo] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -1966,6 +2025,7 @@ begin
Result := True; Result := True;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.LineTo] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2109,7 +2169,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; function TgtkObject.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
begin begin
Assert(False, Format('trace:[TgtkObject.MoveToEx] DC:0x%x, X:%d, Y:%d', [DC, X, Y])); Assert(False, Format('trace:> [TgtkObject.MoveToEx] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -2117,6 +2177,7 @@ begin
if OldPoint <> nil then OldPoint^ := PenPos; if OldPoint <> nil then OldPoint^ := PenPos;
PenPos := Point(X, Y); PenPos := Point(X, Y);
end; end;
Assert(False, Format('trace:< [TgtkObject.MoveToEx] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
end; end;
@ -2198,7 +2259,7 @@ function TgtkObject.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var var
Width, Height: Integer; Width, Height: Integer;
begin begin
Assert(False, Format('trace:[TgtkObject.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2])); Assert(False, Format('trace:> [TgtkObject.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
@ -2221,6 +2282,7 @@ begin
Result := True; Result := True;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2249,7 +2311,7 @@ var
nIndex: Integer; nIndex: Integer;
pDC: PDeviceContext; pDC: PDeviceContext;
begin begin
Assert(False, Format('trace:[TgtkObject.ReleaseDC] DC:0x%x', [hDC])); Assert(False, Format('trace:> [TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
Result := 0; Result := 0;
if {(hWnd <> 0) and} (hDC <> 0) if {(hWnd <> 0) and} (hDC <> 0)
@ -2275,6 +2337,7 @@ begin
Result := 1; Result := 1;
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2299,18 +2362,16 @@ var
pDC, OldDC: PDeviceContext; pDC, OldDC: PDeviceContext;
count: Integer; count: Integer;
begin begin
Assert(False, Format('Trace:[TgtkObject.RestoreDC] 0x%x, Saved: %d', [Integer(DC), SavedDC])); Assert(False, Format('Trace:> [TgtkObject.RestoreDC] 0x%x, Saved: %d', [DC, SavedDC]));
Result := IsValidDC(DC) and (SavedDC <> 0); Result := IsValidDC(DC) and (SavedDC <> 0);
if Result if Result
then begin then begin
pDC := PDeviceContext(DC); pDC := PDeviceContext(DC);
Count := CountSaved(pDC); Count := CountSaved(pDC);
Result := (Abs(SavedDC) <= Count);
Result := (Abs(SavedDC) < Count);
if Result if Result
then begin then begin
if SavedDC > 0 then Dec(SavedDc, Count); // make relative if SavedDC > 0 then Dec(SavedDc, Count + 1); // make relative
while (SavedDC < 0) and (pDC <> nil) do while (SavedDC < 0) and (pDC <> nil) do
begin begin
OldDC := pDC; OldDC := pDC;
@ -2328,6 +2389,7 @@ begin
Result := CopyDCData(PDeviceContext(DC), pDC); Result := CopyDCData(PDeviceContext(DC), pDC);
end; end;
end; end;
Assert(False, Format('Trace:< [TgtkObject.RestoreDC] 0x%x, Saved: %d --> %s', [Integer(DC), SavedDC, BOOL_TEXT[Result]]));
end; end;
@ -2344,7 +2406,7 @@ function TgtkObject.SaveDC(DC: HDC): Integer;
var var
pDC, pSavedDC: PDeviceContext; pDC, pSavedDC: PDeviceContext;
begin begin
Assert(False, Format('Trace:[TgtkObject.SaveDC] 0x%x', [Integer(DC)])); Assert(False, Format('Trace:> [TgtkObject.SaveDC] 0x%x', [Integer(DC)]));
Result := 0; Result := 0;
if IsValidDC(DC) if IsValidDC(DC)
@ -2359,6 +2421,8 @@ begin
pDC := pDC^.SavedContext; pDC := pDC^.SavedContext;
until pDC^.SavedContext = nil; until pDC^.SavedContext = nil;
end; end;
Assert(False, Format('Trace:< [TgtkObject.SaveDC] 0x%x --> %d', [Integer(DC), Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2394,7 +2458,7 @@ var
Color: TGdkColor; Color: TGdkColor;
begin begin
//TODO: Finish this; //TODO: Finish this;
Assert(False, Format('trace:==> [TgtkObject.SelectObject] DC: 0x%x', [DC])); Assert(False, Format('trace:> [TgtkObject.SelectObject] DC: 0x%x', [DC]));
Result := 0; Result := 0;
if IsValidDC(DC) and IsValidGDIObject(GDIObj) if IsValidDC(DC) and IsValidGDIObject(GDIObj)
@ -2459,7 +2523,7 @@ begin
end; end;
end; end;
end; end;
Assert(False, Format('trace:<== [TgtkObject.SelectObject] DC: 0x%x', [DC])); Assert(False, Format('trace:< [TgtkObject.SelectObject] DC: 0x%x --> 0x%x', [DC, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2513,8 +2577,7 @@ const
HI_MASK = LongWord($FF00); HI_MASK = LongWord($FF00);
LO_MASK = LongWord($FF); LO_MASK = LongWord($FF);
begin begin
//WriteLn(Format('[TgtkObject.SetBKColor] DC: 0x%x Color: %8x', [Integer(DC), Color])); Assert(False, Format('trace:> [TgtkObject.SetBKColor] DC: 0x%x Color: %8x', [Integer(DC), Color]));
Assert(False, 'Trace:[TgtkObject.SetBKColor]');
Result := CLR_INVALID; Result := CLR_INVALID;
if IsValidDC(DC) if IsValidDC(DC)
then begin then begin
@ -2536,7 +2599,7 @@ begin
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.SetBKColor] DC: 0x%x Color: %8x --> %8x', [Integer(DC), Color, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2560,7 +2623,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.SetCapture(Value: Longint): Longint; function TgtkObject.SetCapture(Value: Longint): Longint;
begin begin
Assert(False, Format('Trace:[TgtkObject.SetCapture] 0x%x', [Value])); Assert(False, Format('Trace:> [TgtkObject.SetCapture] 0x%x', [Value]));
//CaptureHandle is defined in gtkint.pp class definition. //CaptureHandle is defined in gtkint.pp class definition.
@ -2594,6 +2657,7 @@ begin
end; end;
// TODO send a WM_CaptureChanged // TODO send a WM_CaptureChanged
Assert(False, Format('Trace:< [TgtkObject.SetCapture] 0x%x --> 0x%x', [Value, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2664,8 +2728,9 @@ function TgtkObject.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo:
var var
Adjustment: PGtkAdjustment; Adjustment: PGtkAdjustment;
begin begin
Assert(False, 'Trace:[TgtkObject.SetScrollInfo]'); // Assert(False, 'Trace:[TgtkObject.SetScrollInfo]');
// with ScrollInfo do Assert(False, Format('Trace:[TgtkObject.SetScrollInfo] Mask:0x%x, Min:%d, Max:%d, Page:%d, Pos:%d', [fMask, nMin, nMax, nPage, nPos])); with ScrollInfo do Assert(False, Format('Trace:> [TgtkObject.SetScrollInfo] Mask:0x%x, Min:%d, Max:%d, Page:%d, Pos:%d', [fMask, nMin, nMax, nPage, nPos]));
Result := 0; Result := 0;
if (Handle <> 0) if (Handle <> 0)
then begin then begin
@ -2702,6 +2767,7 @@ begin
if bRedraw then gtk_adjustment_changed(Adjustment); if bRedraw then gtk_adjustment_changed(Adjustment);
end; end;
end; end;
with ScrollInfo do Assert(False, Format('Trace:> [TgtkObject.SetScrollInfo] --> %d', [Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2764,7 +2830,7 @@ const
HI_MASK = LongWord($FF00); HI_MASK = LongWord($FF00);
LO_MASK = LongWord($FF); LO_MASK = LongWord($FF);
begin begin
Assert(False, 'trace:[TgtkObject.SetTextColor]'); Assert(False, Format('trace:> [TgtkObject.SetTextColor] DC: 0x%x Color: %8x', [Integer(DC), Color]));
Result := CLR_INVALID; Result := CLR_INVALID;
if IsValidDC(DC) if IsValidDC(DC)
then begin then begin
@ -2786,7 +2852,7 @@ begin
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.SetTextColor] DC: 0x%x Color: %8x --> %8x', [Integer(DC), Color, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2799,7 +2865,7 @@ end;
function TgtkObject.SetWindowLong(Handle: HWND; Idx: Integer; NewLong: Longint): LongInt; function TgtkObject.SetWindowLong(Handle: HWND; Idx: Integer; NewLong: Longint): LongInt;
begin begin
//TODO: Finish this; //TODO: Finish this;
Assert(False, 'Trace:TODO: [TgtkObject.SETWINDOWLONG] Finish'); Assert(False, Format('Trace:> [TgtkObject.SETWINDOWLONG] HWND: 0x%x, idx: 0x%x(%d), Value: 0x%x(%d)', [Handle, idx, idx, newlong, newlong]));
case idx of case idx of
GWL_WNDPROC : GWL_WNDPROC :
@ -2828,6 +2894,7 @@ begin
gtk_object_set_data(pgtkobject(Handle),'ID',pointer(NewLong)); gtk_object_set_data(pgtkobject(Handle),'ID',pointer(NewLong));
end; end;
end; //case end; //case
Assert(False, Format('Trace:< [TgtkObject.SETWINDOWLONG] HWND: 0x%x, idx: 0x%x(%d), Value: 0x%x(%d) --> 0x%x(%d)', [Handle, idx, idx, newlong, newlong, Result, Result]));
end; end;
Function TgtkObject.SetWindowOrgEx(dc : hdc; NewX, NewY : Integer; Var lpPoint : TPoint) : Boolean; Function TgtkObject.SetWindowOrgEx(dc : hdc; NewX, NewY : Integer; Var lpPoint : TPoint) : Boolean;
@ -2858,7 +2925,7 @@ var
begin begin
//TODO: [TgtkObject.ShowCaret] Finish (in gtkwinapi.inc) //TODO: [TgtkObject.ShowCaret] Finish (in gtkwinapi.inc)
Assert(False, Format('Trace:[TgtkObject.ShowCaret] HWND: 0x%x', [hWnd])); Assert(False, Format('Trace:> [TgtkObject.ShowCaret] HWND: 0x%x', [hWnd]));
GTKObject := PGTKObject(HWND); GTKObject := PGTKObject(HWND);
Result := GTKObject <> nil; Result := GTKObject <> nil;
@ -2876,6 +2943,7 @@ begin
end end
else WriteLn('WARNING: [TgtkObject.ShowCaret] Got null HWND'); else WriteLn('WARNING: [TgtkObject.ShowCaret] Got null HWND');
Assert(False, Format('Trace:< [TgtkObject.ShowCaret] HWND: 0x%x --> %s', [hWnd, BOOL_TEXT[Result]]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2933,7 +3001,7 @@ var
pixmap : PgdkPixmap; pixmap : PgdkPixmap;
pixmapwid : pgtkWidget; pixmapwid : pgtkWidget;
begin begin
Assert(True, Format('trace:[TgtkObject.StretchBlt] DestDC:0x%x; X:%d, Y:%d, Width:%d, Height:%d; SrcDC:0x%x; XSrc:%d, YSrc:%d, SrcWidth:%d, SrcHeight:%d; Rop:0x%x', [DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Rop])); Assert(True, Format('trace:> [TgtkObject.StretchBlt] DestDC:0x%x; X:%d, Y:%d, Width:%d, Height:%d; SrcDC:0x%x; XSrc:%d, YSrc:%d, SrcWidth:%d, SrcHeight:%d; Rop:0x%x', [DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Rop]));
Result := IsValidDC(DestDC) and IsValidDC(SrcDC); Result := IsValidDC(DestDC) and IsValidDC(SrcDC);
if Result if Result
then begin then begin
@ -2953,6 +3021,7 @@ begin
XSrc, YSrc, X, Y, Width, Height); XSrc, YSrc, X, Y, Width, Height);
end; end;
Assert(True, Format('trace:< [TgtkObject.StretchBlt] DestDC:0x%x --> %s', [DestDC, BOOL_TEXT[Result]]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -3032,6 +3101,14 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.8 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.7 2000/08/14 12:31:12 lazarus Revision 1.7 2000/08/14 12:31:12 lazarus
Minor modifications for SynEdit . Minor modifications for SynEdit .
Shane Shane

9
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -12,6 +12,7 @@ Function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;override;
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override; function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override; function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean; override; function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean; override;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;
function CreateCompatibleDC(DC: HDC): HDC; override; function CreateCompatibleDC(DC: HDC): HDC; override;
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override; function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
@ -98,6 +99,14 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.5 2000/08/14 12:31:12 lazarus Revision 1.5 2000/08/14 12:31:12 lazarus
Minor modifications for SynEdit . Minor modifications for SynEdit .
Shane Shane

11
lcl/lcllinux.pp
View File

@ -1338,7 +1338,8 @@ function MakeWord(A,B : Byte) : Word;
implementation implementation
uses uses
Interfaces, Strings, Math;
SysUtils, Interfaces, Strings, Math;
function MakeLong(A,B : Word) : LongInt; function MakeLong(A,B : Word) : LongInt;
begin begin
@ -1360,6 +1361,14 @@ end.
{ {
$Log$ $Log$
Revision 1.4 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.3 2000/08/11 14:59:09 lazarus Revision 1.3 2000/08/11 14:59:09 lazarus
Adding all the Synedit files. Adding all the Synedit files.
Changed the GDK_KEY_PRESS and GDK_KEY_RELEASE stuff to fix the problem in the editor with the shift key being ignored. Changed the GDK_KEY_PRESS and GDK_KEY_RELEASE stuff to fix the problem in the editor with the shift key being ignored.

10
lcl/menus.pp
View File

@ -160,7 +160,7 @@ type
end; end;
function ShortCut(Key: Word; Shift : TShiftState) : TShortCut; function ShortCut(Key: Word; Shift : TShiftState) : TShortCut;
Procedure ShortCuttoKey(ShortCut : TShortCut; var Key: Word; var Shift : TShiftState); procedure ShortCuttoKey(ShortCut : TShortCut; var Key: Word; var Shift : TShiftState);
implementation implementation
@ -199,6 +199,14 @@ end.
{ {
$Log$ $Log$
Revision 1.2 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.1 2000/07/13 10:28:24 michael Revision 1.1 2000/07/13 10:28:24 michael
+ Initial import + Initial import