paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-28 12:57:21 +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

43
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
//TODO: Finish this. BEGINPAINT Assert(False, Format('Trace:> [BeginPaint] HWND: 0x%x', [Handle]));
Result := Getdc(Handle);
//TODO: Finish this. BEGINPAINT
// Move to platform dependent ??
Result := Getdc(Handle);
Assert(False, Format('Trace:< [BeginPaint] HWND: 0x%x --> 0x%x', [Handle, Result]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -439,11 +449,11 @@ 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
Writeln('TODO: WINAPI call CHARLOWERBUFF'); Writeln('TODO: WINAPI call CHARLOWERBUFF');
end; end;
@ -529,8 +539,11 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
Begin Begin
//TODO: Finish EndPaint in winapi.inc Assert(False, Format('Trace:> [EndPaint] HWND: 0x%x', [Handle]));
Result := 1;
//TODO: Finish EndPaint in winapi.inc
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]

80
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');
@ -208,7 +214,7 @@ begin
Assert(False, 'Trace:Message received'); Assert(False, 'Trace:Message received');
if Sender <> nil then if Sender <> nil then
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Sent LM_Message: $%x (%s); Data: %d', [Sender.ClassName, LM_Message, GetMessageName(LM_Message), Integer(data)])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Sent LM_Message: $%x (%s); Data: %d', [Sender.ClassName, LM_Message, GetMessageName(LM_Message), Integer(data)]));
// The following case is now split into 2 separate parts: // The following case is now split into 2 separate parts:
// 1st part should contain all messages which don't need the "handle" variable // 1st part should contain all messages which don't need the "handle" variable
@ -226,7 +232,7 @@ begin
LM_ShowHide : LM_ShowHide :
begin begin
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Show/Hide', [Sender.ClassNAme])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Show/Hide', [Sender.ClassNAme]));
ShowHide(Sender); ShowHide(Sender);
end; end;
@ -243,7 +249,7 @@ begin
LM_ATTACHMENU: AttachMenu(Sender); LM_ATTACHMENU: AttachMenu(Sender);
else begin else begin
handle := hwnd(ObjectToGtkObject (sender)); handle := hwnd(ObjectToGtkObject (sender));
//??? if handle = nil then assert (false, Format ('Trace:[TgtkObject.IntSendMessage3] %s --> got handle=nil',[Sender.ClassName])); //??? if handle = nil then assert (false, Format ('Trace: [TgtkObject.IntSendMessage3] %s --> got handle=nil',[Sender.ClassName]));
Case LM_Message of Case LM_Message of
LM_SetText : SetText(PgtkWidget(Handle), Data); LM_SetText : SetText(PgtkWidget(Handle), Data);
@ -253,12 +259,12 @@ begin
Assert(False, 'Trace:Adding a child to Parent'); Assert(False, 'Trace:Adding a child to Parent');
If (TWinControl(Sender).Parent is TToolbar) then If (TWinControl(Sender).Parent is TToolbar) then
Begin Begin
// Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> %s ---calling INSERTBUTTON from Add Child', [AParent.ClassName, Sender.ClassNAme])); // Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> %s ---calling INSERTBUTTON from Add Child', [AParent.ClassName, Sender.ClassNAme]));
exit; exit;
end end
else Begin else Begin
AParent := (Sender as TWinControl).Parent; AParent := (Sender as TWinControl).Parent;
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme]));
AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top); AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top);
end; end;
end; end;
@ -439,7 +445,7 @@ begin
LM_SetSize : LM_SetSize :
begin begin
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> LM_SetSize(%d, %d, %d, %d)', [Sender.ClassNAme, pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> LM_SetSize(%d, %d, %d, %d)', [Sender.ClassNAme, pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom]));
ResizeChild(Sender,pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom); ResizeChild(Sender,pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom);
end; end;
@ -464,7 +470,7 @@ begin
//SH: think of TCanvas.handle!!!! //SH: think of TCanvas.handle!!!!
LM_ReDraw : LM_ReDraw :
begin begin
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Redraw', [Sender.ClassName])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Redraw', [Sender.ClassName]));
if (Sender is TCanvas) then if (Sender is TCanvas) then
ReDraw(PgtkWidget((Sender as TCanvas).Handle)) ReDraw(PgtkWidget((Sender as TCanvas).Handle))
else else
@ -476,7 +482,7 @@ begin
LM_AddPage : LM_AddPage :
begin begin
Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Add NB page: %s', [Sender.ClassName, TLMNotebookEvent(Data^).Child.ClassName])); Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Add NB page: %s', [Sender.ClassName, TLMNotebookEvent(Data^).Child.ClassName]));
AddNBPage(TControl(Sender), TLMNotebookEvent(Data^).Child, TLMNotebookEvent(Data^).Page); AddNBPage(TControl(Sender), TLMNotebookEvent(Data^).Child, TLMNotebookEvent(Data^).Page);
end; end;
@ -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 }
@ -886,7 +895,7 @@ var
pWidget: PGTKWidget; pWidget: PGTKWidget;
Parent: TWinControl; Parent: TWinControl;
begin begin
Assert(false, (Format('trace:[TgtkObject.ResizeChild] %s --> Resize', [Sender.ClassNAme]))); Assert(false, (Format('trace: [TgtkObject.ResizeChild] %s --> Resize', [Sender.ClassNAme])));
Parent := TControl(Sender).Parent; Parent := TControl(Sender).Parent;
@ -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
@ -1010,7 +1021,7 @@ var
pLabel: pchar; pLabel: pchar;
begin begin
if Sender is TWinControl if Sender is TWinControl
then Assert(False, Format('Trace:[TgtkObject.SetLabel] %s --> label %s', [Sender.ClassName, TControl(Sender).Caption])) then Assert(False, Format('Trace: [TgtkObject.SetLabel] %s --> label %s', [Sender.ClassName, TControl(Sender).Caption]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName])); else Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName]));
P := Pointer(TWinControl(Sender).Handle); P := Pointer(TWinControl(Sender).Handle);
@ -1026,11 +1037,11 @@ begin
begin begin
if Child = nil then if Child = nil then
begin begin
Assert(False, Format('trace:[TgtkObject.SetLabel] %s has no child label', [Sender.ClassName])); Assert(False, Format('trace: [TgtkObject.SetLabel] %s has no child label', [Sender.ClassName]));
child := gtk_label_new(pLabel) child := gtk_label_new(pLabel)
end end
else begin else begin
Assert(False, Format('trace:[TgtkObject.SetLabel] %s has child label', [Sender.ClassName])); Assert(False, Format('trace: [TgtkObject.SetLabel] %s has child label', [Sender.ClassName]));
gtk_label_set_text(pgtkLabel(Child), PLabel); gtk_label_set_text(pgtkLabel(Child), PLabel);
end; end;
end; end;
@ -1069,7 +1080,7 @@ begin
Assert(True, Format ('WARNING: [TgtkObject.SetLabel] --> not handled for class %s ', [Sender.ClassName])); Assert(True, Format ('WARNING: [TgtkObject.SetLabel] --> not handled for class %s ', [Sender.ClassName]));
end; end;
Assert(False, Format('trace:[TgtkObject.SetLabel] %s --> END', [Sender.ClassName])); Assert(False, Format('trace: [TgtkObject.SetLabel] %s --> END', [Sender.ClassName]));
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -1148,7 +1159,7 @@ procedure TGTKObject.SetCallback(Msg : LongInt; Sender : TObject);
Handler := Next; Handler := Next;
end; end;
// if we are here no handler was defined yet // if we are here no handler was defined yet
Assert(False, Format('trace:[TGTKObject.SetCallback] %s signal <%s>', [Sender.ClassName, ASignal])); Assert(False, Format('trace: [TGTKObject.SetCallback] %s signal <%s>', [Sender.ClassName, ASignal]));
gtk_signal_connect(AObject, ASignal, TGTKSignalFunc(ACallBackProc), Sender); gtk_signal_connect(AObject, ASignal, TGTKSignalFunc(ACallBackProc), Sender);
if ReqSignalMask <> 0 then if ReqSignalMask <> 0 then
@ -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;
@ -2054,7 +2065,7 @@ begin
NewHandle := THandle(gdk_font_load(strTemp)); NewHandle := THandle(gdk_font_load(strTemp));
if NewHandle = 0 then //Load a DEFAULT font if NewHandle = 0 then //Load a DEFAULT font
begin begin
Assert(False, 'Trace:[TgtkObject.FontSetName] WARNING: Loading Default Font'); Assert(False, 'Trace: [TgtkObject.FontSetName] WARNING: Loading Default Font');
StrDispose(StrTemp); StrDispose(StrTemp);
strTemp := StrAlloc(Length('-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1') + 1); strTemp := StrAlloc(Length('-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1') + 1);
StrPCopy(strTemp, '-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1'); StrPCopy(strTemp, '-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1');
@ -2073,7 +2084,7 @@ begin
Msg := LM_Changed; Msg := LM_Changed;
TObject(sender).Dispatch(Msg); TObject(sender).Dispatch(Msg);
end end
else Assert(False, Format('Trace:[TgtkObject.FontSetName] WARNING: Could not load font: %s', [strTemp]));; else Assert(False, Format('Trace: [TgtkObject.FontSetName] WARNING: Could not load font: %s', [strTemp]));;
Assert(False, 'Trace:7'); Assert(False, 'Trace:7');
StrDispose(StrTemp); StrDispose(StrTemp);
@ -2218,7 +2229,7 @@ begin
result := 0; // default if nobody sets it result := 0; // default if nobody sets it
if Sender is TWinControl if Sender is TWinControl
then Assert(False, Format('Trace:[TgtkObject.GetValue] %s', [Sender.ClassName])) then Assert(False, Format('Trace: [TgtkObject.GetValue] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.GetValue] %s --> No Decendant of TWinControl', [Sender.ClassName])); else Assert(False, Format('Trace:WARNING: [TgtkObject.GetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle); Handle := Pointer(TWinControl(Sender).Handle);
@ -2256,7 +2267,7 @@ begin
result := 0; // default if nobody sets it result := 0; // default if nobody sets it
if Sender is TWinControl if Sender is TWinControl
then Assert(False, Format('Trace:[TgtkObject.SetValue] %s', [Sender.ClassName])) then Assert(False, Format('Trace: [TgtkObject.SetValue] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetValue] %s --> No Decendant of TWinControl', [Sender.ClassName])); else Assert(False, Format('Trace:WARNING: [TgtkObject.SetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle); Handle := Pointer(TWinControl(Sender).Handle);
@ -2297,7 +2308,7 @@ begin
result := 0; // default if nobody sets it result := 0; // default if nobody sets it
if Sender is TWinControl if Sender is TWinControl
then Assert(False, Format('Trace:[TgtkObject.SetProperties] %s', [Sender.ClassName])) then Assert(False, Format('Trace: [TgtkObject.SetProperties] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetProperties] %s --> No Decendant of TWinControl', [Sender.ClassName])); else Assert(False, Format('Trace:WARNING: [TgtkObject.SetProperties] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle); Handle := Pointer(TWinControl(Sender).Handle);
@ -2470,7 +2481,7 @@ end;
function TgtkObject.IsValidDC(const DC: HDC): Boolean; function TgtkObject.IsValidDC(const DC: HDC): Boolean;
begin begin
Result := FDeviceContexts.IndexOf(Pointer(DC)) <> -1; Result := FDeviceContexts.IndexOf(Pointer(DC)) <> -1;
Assert(False, Format('Trace:[TgtkObject.IsValidDC] DC: 0x%x --> %s', [Integer(DC), BOOL_RESULT[Result]])); Assert(False, Format('Trace: [TgtkObject.IsValidDC] DC: 0x%x --> %s', [Integer(DC), BOOL_RESULT[Result]]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2507,7 +2518,7 @@ begin
except except
on Exception do Result := False; on Exception do Result := False;
end; end;
Assert(False, Format('Trace:[TgtkObject.IsValidGDIObject] GDIObject: 0x%x --> %s', [Integer(GDIObject), BOOL_RESULT[Result]])); Assert(False, Format('Trace: [TgtkObject.IsValidGDIObject] GDIObject: 0x%x --> %s', [Integer(GDIObject), BOOL_RESULT[Result]]));
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

25
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;
@ -94,7 +95,7 @@ procedure SelectGDKBrushProps(const DC: HDC);
begin begin
with PDeviceContext(DC)^, CurrentBrush^ do with PDeviceContext(DC)^, CurrentBrush^ do
begin begin
Assert(False, Format('Trace:[SelectGDKBrushProps] Fill: %d | Color --> pixel: %d, red: 0x%x, green: 0x%x, blue: 0x%x', [Integer(GDIBrushFill), GDIBrushColor.Pixel, GDIBrushColor.Red, GDIBrushColor.Green, GDIBrushColor.Blue])); Assert(False, Format('Trace: [SelectGDKBrushProps] Fill: %d | Color --> pixel: %d, red: 0x%x, green: 0x%x, blue: 0x%x', [Integer(GDIBrushFill), GDIBrushColor.Pixel, GDIBrushColor.Red, GDIBrushColor.Green, GDIBrushColor.Blue]));
gdk_gc_set_fill(GC, GDIBrushFill); gdk_gc_set_fill(GC, GDIBrushFill);
gdk_gc_set_foreground(GC, @GDIBrushColor); gdk_gc_set_foreground(GC, @GDIBrushColor);
gdk_gc_set_background(GC, @CurrentBackColor); gdk_gc_set_background(GC, @CurrentBackColor);
@ -146,7 +147,7 @@ begin
begin begin
gdk_gc_set_foreground(GC, @CurrentTextColor); gdk_gc_set_foreground(GC, @CurrentTextColor);
gdk_gc_set_background(GC, @CurrentBackColor); gdk_gc_set_background(GC, @CurrentBackColor);
Assert(False, Format('trace:[SelectGDKTextProps] Color --> pixel: %d, red: 0x%x, green: 0x%x, blue: 0x%x', [CurrentTextColor.Pixel, CurrentTextColor.Red, CurrentTextColor.Green, CurrentTextColor.Blue])); Assert(False, Format('trace: [SelectGDKTextProps] Color --> pixel: %d, red: 0x%x, green: 0x%x, blue: 0x%x', [CurrentTextColor.Pixel, CurrentTextColor.Red, CurrentTextColor.Green, CurrentTextColor.Blue]));
end; end;
end; end;
@ -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

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

@ -120,7 +120,7 @@ const // FROM TO
(@DrawableToNoDrawable, @DrawableToDrawable) (@DrawableToNoDrawable, @DrawableToDrawable)
); );
begin begin
Assert(False, Format('trace:[TgtkObject.BitBlt] DestDC:0x%x; X:%d, Y:%d, Width:%d, Height:%d; SrcDC:0x%x; XSrc:%d, YSrc:%d, Rop:0x%x', [DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Rop])); Assert(False, Format('trace: [TgtkObject.BitBlt] DestDC:0x%x; X:%d, Y:%d, Width:%d, Height:%d; SrcDC:0x%x; XSrc:%d, YSrc:%d, Rop:0x%x', [DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Rop]));
Result := IsValidDC(DestDC) and IsValidDC(SrcDC); Result := IsValidDC(DestDC) and IsValidDC(SrcDC);
if Result if Result
then begin then begin
@ -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;
@ -180,7 +200,7 @@ Begin
Inc(P.X, X); Inc(P.X, X);
Inc(P.Y, Y); Inc(P.Y, Y);
Assert(False, Format('Trace:[GTKObject.ClientToScreen] Handle: 0x%x --> (%d, %d)', [Integer(Handle), P.X, P.y])); Assert(False, Format('Trace: [GTKObject.ClientToScreen] Handle: 0x%x --> (%d, %d)', [Integer(Handle), P.X, P.y]));
Result := True; Result := True;
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
@ -215,24 +235,24 @@ begin
if BitCount = gdk_visual_get_system^.Depth if BitCount = gdk_visual_get_system^.Depth
then begin then begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbPixmap', [])); Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbPixmap', []));
GdiObject^.GDIBitmapType := gbPixmap; GdiObject^.GDIBitmapType := gbPixmap;
GdiObject^.GDIPixmapObject := gdk_pixmap_new(nil, Width, Height, BitCount); GdiObject^.GDIPixmapObject := gdk_pixmap_new(nil, Width, Height, BitCount);
end end
else if Bitcount = 1 else if Bitcount = 1
then begin then begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbBitmap', [])); Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbBitmap', []));
GdiObject^.GDIBitmapType := gbBitmap; GdiObject^.GDIBitmapType := gbBitmap;
GdiObject^.GDIBitmapObject := gdk_pixmap_new(nil, Width, Height, BitCount); GdiObject^.GDIBitmapObject := gdk_pixmap_new(nil, Width, Height, BitCount);
end end
else begin else begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbImage', [])); Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbImage', []));
GdiObject^.GDIBitmapType := gbImage; GdiObject^.GDIBitmapType := gbImage;
GdiObject^.GDIRawImageObject := NewGDIRawImage(Width, Height, BitCount); GdiObject^.GDIRawImageObject := NewGDIRawImage(Width, Height, BitCount);
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);
@ -312,7 +332,7 @@ begin
end; end;
gdk_colormap_alloc_color(gdk_colormap_get_system, @GObject^.GDIBrushColor, False, True); gdk_colormap_alloc_color(gdk_colormap_get_system, @GObject^.GDIBrushColor, False, True);
with GObject^.GDIBrushColor do with GObject^.GDIBrushColor do
Assert(False, Format('Trace:[TgtkObject.CreateBrushIndirect] Allocated R: %2x, G: %2x, B: %2x', [Red, Green, Blue])); Assert(False, Format('Trace: [TgtkObject.CreateBrushIndirect] Allocated R: %2x, G: %2x, B: %2x', [Red, Green, Blue]));
end; end;
if sError = '' if sError = ''
then Result := HBRUSH(GObject) then Result := HBRUSH(GObject)
@ -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
@ -395,7 +441,7 @@ begin
pNewDC^.CurrentPen := CreateDefaultPen; pNewDC^.CurrentPen := CreateDefaultPen;
Result := HDC(pNewDC); Result := HDC(pNewDC);
Assert(False,Format('trace:[TgtkObject.CreateCompatibleDC] DC: 0x%x --> 0x%x', [Integer(DC), Integer(Result)])); Assert(False,Format('trace: [TgtkObject.CreateCompatibleDC] DC: 0x%x --> 0x%x', [Integer(DC), Integer(Result)]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -456,7 +502,7 @@ begin
FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*'); FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*');
Assert(False, Format('trace:[TgtkObject.CreateFontIndirect] Name: %s, Height: %d', [FamilyName, lfHeight])); Assert(False, Format('trace: [TgtkObject.CreateFontIndirect] Name: %s, Height: %d', [FamilyName, lfHeight]));
// calculate weight offset. // calculate weight offset.
// API XLFD // API XLFD
@ -571,7 +617,7 @@ begin
if Result = 0 if Result = 0
then WriteLn(Format('WARNING: [TgtkObject.CreateFontIndirect] NOT found XLFD: <%s>', [S])) then WriteLn(Format('WARNING: [TgtkObject.CreateFontIndirect] NOT found XLFD: <%s>', [S]))
else Assert(False, Format('Trace:[TgtkObject.CreateFontIndirect] found XLFD: <%s>', [S])); else Assert(False, Format('Trace: [TgtkObject.CreateFontIndirect] found XLFD: <%s>', [S]));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -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
@ -755,7 +807,7 @@ Assert(False, 'Trace:************************************************');
end; end;
DFC_BUTTON: DFC_BUTTON:
begin begin
Assert(False, Format('Trace:[TgtkObject.DrawFrameControl] DFC_BUTTON --> draw rect = %d,%d,%d,%d',[Rect.Left,Rect.Top,REct.Right,REct.Bottom])); Assert(False, Format('Trace: [TgtkObject.DrawFrameControl] DFC_BUTTON --> draw rect = %d,%d,%d,%d',[Rect.Left,Rect.Top,REct.Right,REct.Bottom]));
//figure out the style first //figure out the style first
case uState and $1F of case uState and $1F of
DFCS_BUTTONRADIOIMAGE: DFCS_BUTTONRADIOIMAGE:
@ -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;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -976,7 +1029,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TGTKObject.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; function TGTKObject.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin begin
Assert(False, Format('Trace:[TGTKObject.EnableWindow] hWnd: 0x%x, Enable: %s', [hwnd, BOOL_TEXT[bEnable]])); Assert(False, Format('Trace: [TGTKObject.EnableWindow] hWnd: 0x%x, Enable: %s', [hwnd, BOOL_TEXT[bEnable]]));
if hWnd <> 0 if hWnd <> 0
then gtk_widget_set_sensitive(pgtkwidget(hWnd), bEnable) then gtk_widget_set_sensitive(pgtkwidget(hWnd), bEnable)
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;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1262,7 +1317,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.GetKeyState(nVirtKey: Integer): Smallint; function TgtkObject.GetKeyState(nVirtKey: Integer): Smallint;
const const
KEYSTATE: array[Boolean] of Smallint = (0, -32768{$8000}); KEYSTATE: array[Boolean] of Smallint = (0, -32768 { $8000});
TOGGLESTATE: array[Boolean] of Smallint = (0, 1); TOGGLESTATE: array[Boolean] of Smallint = (0, 1);
begin begin
case nVirtKey of case nVirtKey of
@ -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;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1919,7 +1978,7 @@ function TgtkObject.HideCaret(hWnd: HWND): Boolean;
var var
GTKObject: PGTKObject; GTKObject: PGTKObject;
begin begin
Assert(False, Format('Trace:[TgtkObject.HideCaret] HWND: 0x%x', [hWnd])); Assert(False, Format('Trace: [TgtkObject.HideCaret] HWND: 0x%x', [hWnd]));
//TODO: [TgtkObject.HideCaret] Finish (in gtkwinapi.inc) //TODO: [TgtkObject.HideCaret] Finish (in gtkwinapi.inc)
GTKObject := PGTKObject(HWND); GTKObject := PGTKObject(HWND);
@ -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)
@ -2403,7 +2467,7 @@ begin
gdiBitmap: gdiBitmap:
with PDeviceContext(DC)^ do with PDeviceContext(DC)^ do
begin begin
Assert(False, Format('trace:[TgtkObject.SelectObject] DC: 0x%x, Type: Bitmap', [DC])); Assert(False, Format('trace: [TgtkObject.SelectObject] DC: 0x%x, Type: Bitmap', [DC]));
Result := HBITMAP(CurrentBitmap); Result := HBITMAP(CurrentBitmap);
CurrentBitmap := PGDIObject(GDIObj); CurrentBitmap := PGDIObject(GDIObj);
if GC <> nil then gdk_gc_unref(GC); if GC <> nil then gdk_gc_unref(GC);
@ -2423,7 +2487,7 @@ begin
gdiBrush: gdiBrush:
with PDeviceContext(DC)^, PGdiObject(GDIObj)^ do with PDeviceContext(DC)^, PGdiObject(GDIObj)^ do
begin begin
Assert(False, Format('trace:[TgtkObject.SelectObject] DC: 0x%x, Type: Brush', [DC])); Assert(False, Format('trace: [TgtkObject.SelectObject] DC: 0x%x, Type: Brush', [DC]));
Result := HBRUSH(CurrentBrush); Result := HBRUSH(CurrentBrush);
CurrentBrush := PGDIObject(GDIObj); CurrentBrush := PGDIObject(GDIObj);
if GC <> nil if GC <> nil
@ -2438,7 +2502,7 @@ begin
gdiFont: gdiFont:
with PDeviceContext(DC)^ do with PDeviceContext(DC)^ do
begin begin
Assert(False, Format('trace:[TgtkObject.SelectObject] DC: 0x%x, Type: Font', [DC])); Assert(False, Format('trace: [TgtkObject.SelectObject] DC: 0x%x, Type: Font', [DC]));
Result := HFONT(CurrentFont); Result := HFONT(CurrentFont);
CurrentFont := PGDIObject(GDIObj); CurrentFont := PGDIObject(GDIObj);
if GC <> nil if GC <> nil
@ -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

15
lcl/lcllinux.pp
View File

@ -1338,16 +1338,17 @@ 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
Result := A or B shl 16; Result := A or B shl 16;
end; end;
function MakeWord(A,B : Byte) : Word; function MakeWord(A,B : Byte) : Word;
Begin Begin
Result := A or B shl 8; Result := A or B shl 8;
end; end;
{$I winapi.inc} {$I winapi.inc}
@ -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