mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-15 23:39:24 +02:00
MWE:
+ 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
parent
8d46c53658
commit
a2060eac49
@ -174,6 +174,7 @@ end;
|
||||
|
||||
procedure TGrabber.PaintWindow(DC: HDC);
|
||||
begin
|
||||
WriteLn(Format('[TGrabber.PaintWindow] 0x%x', [DC]));
|
||||
FillRect(DC, Rect(0, 0, Width, Height), GetStockObject(BLACK_BRUSH));
|
||||
end;
|
||||
|
||||
@ -336,22 +337,20 @@ end;
|
||||
|
||||
procedure TControlSelection.GrabberMove(Sender: TObject; dx, dy: Integer);
|
||||
begin
|
||||
with TGrabber(Sender) do
|
||||
begin
|
||||
if gpLeft in Positions
|
||||
if gpLeft in TGrabber(Sender).Positions
|
||||
then begin
|
||||
Inc(FLeft, dx);
|
||||
Dec(FWidth, dx);
|
||||
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
|
||||
Inc(FTop, dy);
|
||||
Dec(FHeight, dy)
|
||||
end;
|
||||
if gpBottom in Positions then Inc(FHeight, dy);
|
||||
end;
|
||||
if gpBottom in TGrabber(Sender).Positions then Inc(FHeight, dy);
|
||||
|
||||
SetGrabbers;
|
||||
end;
|
||||
|
||||
@ -403,26 +402,27 @@ end;
|
||||
procedure TControlSelection.SetGrabbers;
|
||||
var
|
||||
GrabPos: TGrabIndex;
|
||||
Grabber: TGrabber;
|
||||
begin
|
||||
for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do
|
||||
with FGrabbers[GrabPos] do
|
||||
begin
|
||||
Grabber := FGrabbers[GrabPos];
|
||||
if FVisible
|
||||
then begin
|
||||
if gpLeft in Positions
|
||||
then Left := FLeft - GRAB_SIZE
|
||||
else if gpRight in Positions
|
||||
then Left := FLeft + FWidth
|
||||
else Left := FLeft + (FWidth - GRAB_SIZE) div 2;
|
||||
if gpLeft in Grabber.Positions
|
||||
then Grabber.Left := FLeft - GRAB_SIZE
|
||||
else if gpRight in Grabber.Positions
|
||||
then Grabber.Left := FLeft + FWidth
|
||||
else Grabber.Left := FLeft + (FWidth - GRAB_SIZE) div 2;
|
||||
|
||||
if gpTop in Positions
|
||||
then Top := FTop - GRAB_SIZE
|
||||
else if gpBottom in Positions
|
||||
then Top := FTop + FHeight
|
||||
else Top := FTop + (FHeight - GRAB_SIZE) div 2;
|
||||
if gpTop in Grabber.Positions
|
||||
then Grabber.Top := FTop - GRAB_SIZE
|
||||
else if gpBottom in Grabber.Positions
|
||||
then Grabber.Top := FTop + FHeight
|
||||
else Grabber.Top := FTop + (FHeight - GRAB_SIZE) div 2;
|
||||
end;
|
||||
|
||||
Visible := FVisible;
|
||||
Grabber.Visible := FVisible;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -58,7 +58,6 @@ begin
|
||||
Application.CreateForm(TIDEEditor, IdeEditor1);
|
||||
Application.CreateForm(TViewUnits1, ViewUnits1);
|
||||
Application.CreateForm(TViewForms1, ViewForms1);
|
||||
|
||||
SplashForm.StartTimer;
|
||||
Application.Run;
|
||||
end.
|
||||
@ -66,6 +65,14 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
Added more code for the find function.
|
||||
Shane
|
||||
|
||||
@ -347,7 +347,6 @@ end;
|
||||
|
||||
procedure TSplashForm.HideFormTimer(Sender : TObject);
|
||||
begin
|
||||
Writeln('Timer fired!');
|
||||
Click;
|
||||
end;
|
||||
|
||||
@ -368,6 +367,14 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
+ Initial import
|
||||
|
||||
|
||||
@ -197,8 +197,8 @@ ZIPTARGET=install
|
||||
|
||||
# Directories
|
||||
|
||||
override NEEDUNITDIR=$(UNITTARGETDIR) ./interfaces/$(LCLPLATFORM)
|
||||
override NEEDINCDIR=./include
|
||||
override NEEDUNITDIR=$(UNITTARGETDIR) . ./interfaces/$(LCLPLATFORM)
|
||||
override NEEDINCDIR=./include ./interfaces/$(LCLPLATFORM)
|
||||
ifndef UNITTARGETDIR
|
||||
UNITTARGETDIR=./units
|
||||
endif
|
||||
@ -1234,7 +1234,6 @@ endif
|
||||
# Users rules
|
||||
#####################################################################
|
||||
|
||||
|
||||
cleartarget:
|
||||
-$(DEL) allunits$(EXEEXT)
|
||||
|
||||
|
||||
@ -14,8 +14,8 @@ files=$(wildcard $(UNITTARGETDIR)/*$(OEXT))
|
||||
|
||||
[dirs]
|
||||
unittargetdir=./units
|
||||
unitdir=$(UNITTARGETDIR) ./interfaces/$(LCLPLATFORM)
|
||||
incdir=./include
|
||||
unitdir=$(UNITTARGETDIR) . ./interfaces/$(LCLPLATFORM)
|
||||
incdir=./include ./interfaces/$(LCLPLATFORM)
|
||||
|
||||
[install]
|
||||
|
||||
|
||||
@ -32,7 +32,7 @@ begin
|
||||
FBitmap.PaletteNeeded;
|
||||
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
|
||||
then FOldBitmap := 0
|
||||
@ -87,6 +87,14 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
+ Initial import
|
||||
|
||||
|
||||
@ -46,6 +46,11 @@ Begin
|
||||
Result := InterfaceObject.CreateCaret(Handle, Bitmap, width, Height);
|
||||
end;
|
||||
|
||||
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
|
||||
begin
|
||||
Result := InterfaceObject.CreateCompatibleBitmap(DC, Width, Height);
|
||||
end;
|
||||
|
||||
function CreateCompatibleDC(DC: HDC): HDC;
|
||||
begin
|
||||
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);
|
||||
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
|
||||
Result := InterfaceObject.TextOut(DC, X, Y, Str, Count);
|
||||
end;
|
||||
|
||||
Function WindowFromPoint(Point : TPoint) : HWND;
|
||||
function WindowFromPoint(Point : TPoint) : HWND;
|
||||
begin
|
||||
Result := InterfaceObject.WindowFromPoint(Point);
|
||||
end;
|
||||
@ -426,10 +431,15 @@ end;
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
Function BeginPaint(Handle : hwnd; Var PS : TPaintStruct) : hdc;
|
||||
Begin
|
||||
function BeginPaint(Handle : hwnd; Var PS : TPaintStruct) : hdc;
|
||||
begin
|
||||
Assert(False, Format('Trace:> [BeginPaint] HWND: 0x%x', [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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -439,7 +449,7 @@ end;
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
Function CharLowerBuff(pStr : PChar; Len : Integer): Integer;
|
||||
function CharLowerBuff(pStr : PChar; Len : Integer): Integer;
|
||||
begin
|
||||
// your code here
|
||||
//TODO:WINAPI call CHARLOWERBUFF
|
||||
@ -529,8 +539,11 @@ end;
|
||||
-------------------------------------------------------------------------------}
|
||||
Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
|
||||
Begin
|
||||
Assert(False, Format('Trace:> [EndPaint] HWND: 0x%x', [Handle]));
|
||||
|
||||
//TODO: Finish EndPaint in winapi.inc
|
||||
Result := 1;
|
||||
Assert(False, Format('Trace:< [EndPaint] HWND: 0x%x --> 0x%x', [Handle, Result]));
|
||||
end;
|
||||
|
||||
|
||||
@ -926,6 +939,14 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
Minor modifications for SynEdit .
|
||||
Shane
|
||||
|
||||
@ -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 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 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 CreateFont --> independent
|
||||
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$
|
||||
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
|
||||
Minor modifications for SynEdit .
|
||||
Shane
|
||||
|
||||
@ -439,6 +439,7 @@ var
|
||||
DC: HDC;
|
||||
PS: TPaintStruct; //defined in LCLLinux.pp
|
||||
begin
|
||||
Assert(False, Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, Message.DC]));
|
||||
DC := Message.DC;
|
||||
if DC = 0 then DC := BeginPaint(Handle, PS);
|
||||
try
|
||||
@ -462,6 +463,7 @@ begin
|
||||
finally
|
||||
if Message.DC = 0 then EndPaint(Handle, PS);
|
||||
end;
|
||||
Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
|
||||
end;
|
||||
|
||||
|
||||
@ -1257,7 +1259,7 @@ var
|
||||
PS : TPaintStruct;
|
||||
I : Integer;
|
||||
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
|
||||
begin
|
||||
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
|
||||
@ -1269,10 +1271,10 @@ begin
|
||||
end
|
||||
else begin
|
||||
DC := GetDC(0);
|
||||
// MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
|
||||
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
|
||||
ReleaseDC(0, DC);
|
||||
MemDC := CreateCompatibleDC(0);
|
||||
// OldBitmap := SelectObject(MemDC, MemBitmap);
|
||||
OldBitmap := SelectObject(MemDC, MemBitmap);
|
||||
try
|
||||
DC := BeginPaint(Handle, PS);
|
||||
//ToDO:define wm_erasebkgnd
|
||||
@ -1281,14 +1283,15 @@ begin
|
||||
WMPaint(Msg);
|
||||
Msg.DC := 0;
|
||||
//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);
|
||||
finally
|
||||
// SelectObject(MemDC, OldBitmap);
|
||||
SelectObject(MemDC, OldBitmap);
|
||||
DeleteDC(MemDC);
|
||||
// DeleteObject(MemBitmap);
|
||||
DeleteObject(MemBitmap);
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('Trace:< [TWinControl.WMPaint] %s', [ClassName]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1857,6 +1860,14 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
MWE:
|
||||
= Moved ObjectToGTKObject to GTKProc unit
|
||||
|
||||
@ -5,6 +5,7 @@
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
||||
// temp solution to fill msgqueue
|
||||
function DeliverPostMessage(const Target: Pointer; var Message): GBoolean;
|
||||
begin
|
||||
@ -79,28 +80,32 @@ end;
|
||||
// Unused: Longint;
|
||||
// Result: Longint;
|
||||
// end;
|
||||
function gtkdraw( widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl;
|
||||
function gtkdraw(Widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl;
|
||||
var
|
||||
MSG: TLMPaint;
|
||||
begin
|
||||
Result := True;
|
||||
EventTrace('draw', data);
|
||||
MSG.Msg := LM_PAINT;
|
||||
// TODO: get DC
|
||||
MSG.DC := 0;
|
||||
MSG.DC := GetDC(THandle(Widget));
|
||||
MSG.Unused := 0;
|
||||
|
||||
Result := DeliverMessage(Data, MSG) = 0;
|
||||
|
||||
Result := DeliverPostMessage(Data, MSG);
|
||||
// Result := DeliverMessage(Data, MSG) = 0;
|
||||
end;
|
||||
|
||||
function GTKDrawDefault(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
|
||||
var
|
||||
Mess : TLMessage;
|
||||
MSG : TLMPaint;
|
||||
begin
|
||||
Result := True;
|
||||
EventTrace('draw', data);
|
||||
Mess.Msg := LM_PAINT;
|
||||
Result := DeliverMessage(Data, Mess) = 0;
|
||||
MSG.Msg := LM_PAINT;
|
||||
MSG.DC := GetDC(THandle(Widget));
|
||||
MSG.Unused := 0;
|
||||
|
||||
Result := DeliverPostMessage(Data, MSG);
|
||||
end;
|
||||
|
||||
function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
|
||||
@ -113,10 +118,10 @@ end;
|
||||
|
||||
function GTKExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose; Data: gPointer): GBoolean; cdecl;
|
||||
var
|
||||
Mess : TLMessage;
|
||||
fWindow : pgdkWindow;
|
||||
widget2: pgtkWidget;
|
||||
PixMap : pgdkPixMap;
|
||||
// Mess : TLMessage;
|
||||
// fWindow : pgdkWindow;
|
||||
// widget2: pgtkWidget;
|
||||
// PixMap : pgdkPixMap;
|
||||
|
||||
msg: TLMPaint;
|
||||
begin
|
||||
@ -124,10 +129,12 @@ begin
|
||||
EventTrace('expose-event', data);
|
||||
|
||||
msg.msg := LM_PAINT;
|
||||
msg.DC := 0;
|
||||
MSG.DC := GetDC(THandle(Widget));
|
||||
msg.Unused := 0;
|
||||
|
||||
Result := DeliverMessage(Data, msg) = 0;
|
||||
Result := DeliverPostMessage(Data, MSG);
|
||||
|
||||
// Result := DeliverMessage(Data, msg) = 0;
|
||||
|
||||
(*
|
||||
|
||||
@ -1068,6 +1075,14 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
Added a few files for the start of creating classes for the editor. [SHANE]
|
||||
|
||||
|
||||
@ -2,6 +2,12 @@
|
||||
TGTKObject
|
||||
******************************************************************************)
|
||||
|
||||
{$IFOPT C-}
|
||||
// Uncomment for local trace
|
||||
// {$C+}
|
||||
// {$DEFINE ASSERT_IS_ON}
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
BOOL_RESULT: array[Boolean] of String = ('False', 'True');
|
||||
|
||||
@ -592,8 +598,11 @@ begin
|
||||
|
||||
LM_SCREENINIT :
|
||||
begin
|
||||
WriteLN('LM_SCREENINIT called --> should go to GTKObject.Init');
|
||||
WriteLN('TODO: check this');
|
||||
{ Initialize gdk }
|
||||
//??? shouldn't this go to init ????
|
||||
// MWE: Move this to init !!!!!
|
||||
gdk_init(@argc, @argv);
|
||||
//???--????
|
||||
{ Compute pixels per inch variable }
|
||||
@ -899,7 +908,9 @@ begin
|
||||
begin
|
||||
pFixed := GetFixedWidget(PGtkWidget(Parent.Handle));
|
||||
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....');
|
||||
end
|
||||
else begin
|
||||
@ -1770,8 +1781,8 @@ begin
|
||||
Without, the notebook dumps
|
||||
This should be fixed someday
|
||||
}
|
||||
Assert(False, 'Trace:FIXME !!! [TgtkObject.CreateComponent] csNotebook --> gtk_Object_Set_Data');
|
||||
SetFixedWidget(p, p);
|
||||
// Assert(False, 'Trace:FIXME !!! [TgtkObject.CreateComponent] csNotebook --> gtk_Object_Set_Data');
|
||||
// SetFixedWidget(p, p);
|
||||
|
||||
end;
|
||||
|
||||
@ -2534,7 +2545,7 @@ function TgtkObject.NewDC: PDeviceContext;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Assert(False, Format('Trace:==> [TgtkObject.NewDC]', []));
|
||||
Assert(False, Format('Trace:> [TgtkObject.NewDC]', []));
|
||||
New(Result);
|
||||
with Result^ do
|
||||
begin
|
||||
@ -2552,7 +2563,7 @@ begin
|
||||
gdk_color_white(gdk_colormap_get_system, @CurrentBackColor);
|
||||
end;
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2566,12 +2577,12 @@ function TgtkObject.NewGDIObject(const GDIType: TGDIType): PGdiObject;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Assert(False, Format('Trace:==> [TgtkObject.NewGDIObject]', []));
|
||||
Assert(False, Format('Trace:> [TgtkObject.NewGDIObject]', []));
|
||||
New(Result);
|
||||
FillChar(Result^, SizeOf(TGDIObject), 0);
|
||||
Result^.GDIType := GDIType;
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2616,9 +2627,22 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{$IFDEF ASSERT_IS_ON}
|
||||
{$UNDEF ASSERT_IS_ON}
|
||||
{$C-}
|
||||
{$ENDIF}
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
Changed TCustomDialog to TCommonDialog
|
||||
Shane
|
||||
|
||||
@ -55,7 +55,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function CopyDCData(const DestinationDC, SourceDC: PDeviceContext): Boolean;
|
||||
var
|
||||
GCValues: PGDKGCValues;
|
||||
GCValues: TGDKGCValues;
|
||||
begin
|
||||
Assert(False, 'Trace:[CopyDCData]');
|
||||
Result := (DestinationDC <> nil) and (SourceDC <> nil);
|
||||
@ -68,8 +68,9 @@ begin
|
||||
if (SourceDC^.GC = nil) or (Drawable = nil)
|
||||
then GC := nil
|
||||
else begin
|
||||
gdk_gc_get_values(SourceDC^.GC, GCValues);
|
||||
GC := gdk_gc_new_with_values(Drawable, GCValues, $FFFF);
|
||||
gdk_gc_get_values(SourceDC^.GC, @GCValues);
|
||||
//GC := gdk_gc_new(Drawable);
|
||||
GC := gdk_gc_new_with_values(Drawable, @GCValues, 3 { $3FF});
|
||||
end;
|
||||
PenPos := SourceDC^.PenPos;
|
||||
CurrentBitmap := SourceDC^.CurrentBitmap;
|
||||
@ -485,7 +486,7 @@ var
|
||||
begin
|
||||
if not assigned (AObject) then
|
||||
begin
|
||||
assert (false, 'TRACE: ObjectToGtkObject: object not assigned');
|
||||
assert (false, 'TRACE: [ObjectToGtkObject] Object not assigned');
|
||||
handle := 0
|
||||
end
|
||||
else if (AObject is TWinControl) then
|
||||
@ -505,11 +506,11 @@ begin
|
||||
{if TCommonDialog(AObject).HandleAllocated then } handle := TCommonDialog(AObject).Handle
|
||||
end
|
||||
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;
|
||||
end;
|
||||
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;
|
||||
|
||||
|
||||
@ -654,6 +655,14 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
Changed TCustomDialog to TCommonDialog
|
||||
Shane
|
||||
|
||||
@ -128,11 +128,31 @@ begin
|
||||
// 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[
|
||||
PDeviceContext(SrcDC)^.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;
|
||||
|
||||
@ -198,7 +218,7 @@ var
|
||||
GdiObject: PGdiObject;
|
||||
RawImage: PGDIRawImage;
|
||||
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)
|
||||
then begin
|
||||
@ -232,7 +252,7 @@ begin
|
||||
end;
|
||||
|
||||
Result := HBITMAP(GdiObject);
|
||||
Assert(False, Format('Trace:<== [TgtkObject.CreateBitmap] --> 0x%x', [Integer(Result)]));
|
||||
Assert(False, Format('Trace:< [TgtkObject.CreateBitmap] --> 0x%x', [Integer(Result)]));
|
||||
end;
|
||||
|
||||
|
||||
@ -256,7 +276,7 @@ var
|
||||
GObject: PGdiObject;
|
||||
sError: String;
|
||||
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 := '';
|
||||
GObject := NewGDIObject(gdiBrush);
|
||||
@ -321,7 +341,7 @@ begin
|
||||
Result := 0;
|
||||
Dispose(GObject);
|
||||
end;
|
||||
Assert(False, Format('Trace:[TgtkObject.CreateBrushIndirect] Got --> %x', [Result]));
|
||||
Assert(False, Format('Trace:< [TgtkObject.CreateBrushIndirect] Got --> %x', [Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -359,6 +379,32 @@ begin
|
||||
|
||||
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
|
||||
Params: none
|
||||
@ -677,7 +723,9 @@ function TgtkObject.DeleteObject(GDIObject: HGDIOBJ): Boolean;
|
||||
begin
|
||||
{ Find out if we want to release internal GDI object }
|
||||
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
|
||||
case GDIType of
|
||||
gdiFont:
|
||||
@ -686,12 +734,15 @@ begin
|
||||
end;
|
||||
gdiBrush:
|
||||
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);
|
||||
end;
|
||||
gdiBitmap:
|
||||
begin
|
||||
if Result then gdk_bitmap_unref(GDIBitmapObject);
|
||||
if Result and (GDIBitmapObject <> nil)
|
||||
then gdk_bitmap_unref(GDIBitmapObject);
|
||||
end;
|
||||
gdiPen:
|
||||
begin
|
||||
@ -704,6 +755,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Dispose of the GDI object }
|
||||
if PGDIObject(GDIObject) <> nil
|
||||
then begin
|
||||
@ -814,7 +866,7 @@ Var
|
||||
Width, Height: Integer;
|
||||
R: TRect;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -928,6 +980,7 @@ begin
|
||||
Result := True;
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -993,7 +1046,7 @@ var
|
||||
pStr: PChar;
|
||||
Width, Height: Integer;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -1035,6 +1088,7 @@ begin
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1051,7 +1105,7 @@ var
|
||||
Width, Height: Integer;
|
||||
OldCurrentBrush: PGdiObject;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -1076,6 +1130,7 @@ begin
|
||||
Result := True;
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1158,7 +1213,7 @@ var
|
||||
Color: TGdkColor;
|
||||
nIndex: Integer;
|
||||
begin
|
||||
Assert(False, Format('trace:[TgtkObject.GetDC] hWND: 0x%x', [hWnd]));
|
||||
Assert(False, Format('trace:> [TgtkObject.GetDC] hWND: 0x%x', [hWnd]));
|
||||
p := nil;
|
||||
|
||||
if hWnd = 0
|
||||
@ -1171,9 +1226,10 @@ begin
|
||||
pFixed := GetFixedWidget(Pointer(hWnd));
|
||||
if pFixed = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [TgtkObject.GetDC] Window has no fixed');
|
||||
end
|
||||
else begin
|
||||
Assert(False, 'trace:WARNING: [TgtkObject.GetDC] Window has no fixed, using window itself');
|
||||
pFixed := Pointer(hWnd);
|
||||
end;
|
||||
|
||||
// create a new devicecontext for this window
|
||||
P := NewDC;
|
||||
p^.hWnd := hWnd;
|
||||
@ -1192,7 +1248,6 @@ begin
|
||||
|
||||
gdk_gc_get_values(p^.GC, @Values);
|
||||
end;
|
||||
end;
|
||||
|
||||
if p <> nil
|
||||
then begin
|
||||
@ -1210,7 +1265,7 @@ begin
|
||||
p^.CurrentPen := CreateDefaultPen;
|
||||
end;
|
||||
Result := HDC(p);
|
||||
Assert(False, Format('trace:[TgtkObject.GetDC] Got 0x%x', [Result]));
|
||||
Assert(False, Format('trace:< [TgtkObject.GetDC] Got 0x%x', [Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1382,7 +1437,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.GetStockObject(Value: Integer): LongInt;
|
||||
begin
|
||||
Assert(False, Format('Trace:[TgtkObject.GetStockObject] %d', [Value]));
|
||||
Assert(False, Format('Trace:> [TgtkObject.GetStockObject] %d', [Value]));
|
||||
Result := 0;
|
||||
case Value of
|
||||
BLACK_BRUSH: // Black brush.
|
||||
@ -1435,6 +1490,7 @@ begin
|
||||
else
|
||||
Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value]));
|
||||
end;
|
||||
Assert(False, Format('Trace:< [TgtkObject.GetStockObject] %d --> 0x%x', [Value, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1465,7 +1521,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.GetSystemMetrics(nIndex: Integer): Integer;
|
||||
begin
|
||||
Assert(False, 'Trace:[TgtkObject.GetSystemMetrics]');
|
||||
Assert(False, Format('Trace:> [TgtkObject.GetSystemMetrics] %d', [nIndex]));
|
||||
case nIndex of
|
||||
SM_ARRANGE:
|
||||
begin
|
||||
@ -1745,7 +1801,7 @@ begin
|
||||
end;
|
||||
else Result := 0;
|
||||
end;
|
||||
|
||||
Assert(False, Format('Trace:< [TgtkObject.GetSystemMetrics] %d --> 0x%x (%d)', [nIndex, Result, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1759,7 +1815,7 @@ function TgtkObject.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var
|
||||
var
|
||||
lbearing, rbearing, width, ascent,descent: LongInt;
|
||||
begin
|
||||
Assert(False, 'trace:[TgtkObject.GetTextExtentPoint]');
|
||||
Assert(False, 'trace:> [TgtkObject.GetTextExtentPoint]');
|
||||
Result := IsValidDC(DC);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -1780,6 +1836,7 @@ begin
|
||||
Size.cY := ascent + descent;
|
||||
end;
|
||||
end;
|
||||
Assert(False, 'trace:< [TgtkObject.GetTextExtentPoint]');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1793,7 +1850,7 @@ function TgtkObject.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
|
||||
var
|
||||
lbearing, rbearing, dummy: LongInt;
|
||||
begin
|
||||
Assert(False, 'Trace:TODO FINISH: [TgtkObject.GetTextMetrics]');
|
||||
Assert(False, Format('Trace:> TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
|
||||
|
||||
Result := IsValidDC(DC);
|
||||
if Result then with PDeviceContext(DC)^ do begin
|
||||
@ -1811,7 +1868,7 @@ begin
|
||||
tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack
|
||||
end;
|
||||
end;
|
||||
Assert(False, 'Trace:Exiting GetTextMetrics');
|
||||
Assert(False, Format('Trace:< TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1823,7 +1880,8 @@ Function TgtkObject.GetWindowLong(Handle : hwnd; int : Integer): Longint;
|
||||
var
|
||||
Data : Tobject;
|
||||
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
|
||||
GWL_WNDPROC :
|
||||
@ -1864,6 +1922,7 @@ begin
|
||||
else Result := 0;
|
||||
end; //case
|
||||
|
||||
Assert(False, Format('Trace:< [TgtkObject.GETWINDOWLONG] HWND: 0x%x, int: 0x%x (%d) --> 0x%x (%d)', [Handle, int, int, Result, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1949,7 +2008,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.LineTo(DC: HDC; X, Y: Integer): Boolean;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -1966,6 +2025,7 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('trace:< [TgtkObject.LineTo] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2109,7 +2169,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -2117,6 +2177,7 @@ begin
|
||||
if OldPoint <> nil then OldPoint^ := PenPos;
|
||||
PenPos := Point(X, Y);
|
||||
end;
|
||||
Assert(False, Format('trace:< [TgtkObject.MoveToEx] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
|
||||
end;
|
||||
|
||||
|
||||
@ -2198,7 +2259,7 @@ function TgtkObject.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
|
||||
var
|
||||
Width, Height: Integer;
|
||||
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);
|
||||
if Result
|
||||
then with PDeviceContext(DC)^ do
|
||||
@ -2221,6 +2282,7 @@ begin
|
||||
Result := True;
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2249,7 +2311,7 @@ var
|
||||
nIndex: Integer;
|
||||
pDC: PDeviceContext;
|
||||
begin
|
||||
Assert(False, Format('trace:[TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
|
||||
Assert(False, Format('trace:> [TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
|
||||
Result := 0;
|
||||
|
||||
if {(hWnd <> 0) and} (hDC <> 0)
|
||||
@ -2275,6 +2337,7 @@ begin
|
||||
Result := 1;
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('trace:< [TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2299,18 +2362,16 @@ var
|
||||
pDC, OldDC: PDeviceContext;
|
||||
count: Integer;
|
||||
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);
|
||||
if Result
|
||||
then begin
|
||||
pDC := PDeviceContext(DC);
|
||||
Count := CountSaved(pDC);
|
||||
|
||||
Result := (Abs(SavedDC) < Count);
|
||||
Result := (Abs(SavedDC) <= Count);
|
||||
if Result
|
||||
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
|
||||
begin
|
||||
OldDC := pDC;
|
||||
@ -2328,6 +2389,7 @@ begin
|
||||
Result := CopyDCData(PDeviceContext(DC), pDC);
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('Trace:< [TgtkObject.RestoreDC] 0x%x, Saved: %d --> %s', [Integer(DC), SavedDC, BOOL_TEXT[Result]]));
|
||||
end;
|
||||
|
||||
|
||||
@ -2344,7 +2406,7 @@ function TgtkObject.SaveDC(DC: HDC): Integer;
|
||||
var
|
||||
pDC, pSavedDC: PDeviceContext;
|
||||
begin
|
||||
Assert(False, Format('Trace:[TgtkObject.SaveDC] 0x%x', [Integer(DC)]));
|
||||
Assert(False, Format('Trace:> [TgtkObject.SaveDC] 0x%x', [Integer(DC)]));
|
||||
|
||||
Result := 0;
|
||||
if IsValidDC(DC)
|
||||
@ -2359,6 +2421,8 @@ begin
|
||||
pDC := pDC^.SavedContext;
|
||||
until pDC^.SavedContext = nil;
|
||||
end;
|
||||
|
||||
Assert(False, Format('Trace:< [TgtkObject.SaveDC] 0x%x --> %d', [Integer(DC), Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2394,7 +2458,7 @@ var
|
||||
Color: TGdkColor;
|
||||
begin
|
||||
//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;
|
||||
if IsValidDC(DC) and IsValidGDIObject(GDIObj)
|
||||
@ -2459,7 +2523,7 @@ begin
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2513,8 +2577,7 @@ const
|
||||
HI_MASK = LongWord($FF00);
|
||||
LO_MASK = LongWord($FF);
|
||||
begin
|
||||
//WriteLn(Format('[TgtkObject.SetBKColor] DC: 0x%x Color: %8x', [Integer(DC), Color]));
|
||||
Assert(False, 'Trace:[TgtkObject.SetBKColor]');
|
||||
Assert(False, Format('trace:> [TgtkObject.SetBKColor] DC: 0x%x Color: %8x', [Integer(DC), Color]));
|
||||
Result := CLR_INVALID;
|
||||
if IsValidDC(DC)
|
||||
then begin
|
||||
@ -2536,7 +2599,7 @@ begin
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
Assert(False, Format('trace:< [TgtkObject.SetBKColor] DC: 0x%x Color: %8x --> %8x', [Integer(DC), Color, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2560,7 +2623,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.SetCapture(Value: Longint): Longint;
|
||||
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.
|
||||
|
||||
@ -2594,6 +2657,7 @@ begin
|
||||
end;
|
||||
|
||||
// TODO send a WM_CaptureChanged
|
||||
Assert(False, Format('Trace:< [TgtkObject.SetCapture] 0x%x --> 0x%x', [Value, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2664,8 +2728,9 @@ function TgtkObject.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo:
|
||||
var
|
||||
Adjustment: PGtkAdjustment;
|
||||
begin
|
||||
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]));
|
||||
// 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]));
|
||||
|
||||
Result := 0;
|
||||
if (Handle <> 0)
|
||||
then begin
|
||||
@ -2702,6 +2767,7 @@ begin
|
||||
if bRedraw then gtk_adjustment_changed(Adjustment);
|
||||
end;
|
||||
end;
|
||||
with ScrollInfo do Assert(False, Format('Trace:> [TgtkObject.SetScrollInfo] --> %d', [Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2764,7 +2830,7 @@ const
|
||||
HI_MASK = LongWord($FF00);
|
||||
LO_MASK = LongWord($FF);
|
||||
begin
|
||||
Assert(False, 'trace:[TgtkObject.SetTextColor]');
|
||||
Assert(False, Format('trace:> [TgtkObject.SetTextColor] DC: 0x%x Color: %8x', [Integer(DC), Color]));
|
||||
Result := CLR_INVALID;
|
||||
if IsValidDC(DC)
|
||||
then begin
|
||||
@ -2786,7 +2852,7 @@ begin
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
Assert(False, Format('trace:< [TgtkObject.SetTextColor] DC: 0x%x Color: %8x --> %8x', [Integer(DC), Color, Result]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2799,7 +2865,7 @@ end;
|
||||
function TgtkObject.SetWindowLong(Handle: HWND; Idx: Integer; NewLong: Longint): LongInt;
|
||||
begin
|
||||
//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
|
||||
GWL_WNDPROC :
|
||||
@ -2828,6 +2894,7 @@ begin
|
||||
gtk_object_set_data(pgtkobject(Handle),'ID',pointer(NewLong));
|
||||
end;
|
||||
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;
|
||||
|
||||
Function TgtkObject.SetWindowOrgEx(dc : hdc; NewX, NewY : Integer; Var lpPoint : TPoint) : Boolean;
|
||||
@ -2858,7 +2925,7 @@ var
|
||||
begin
|
||||
//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);
|
||||
Result := GTKObject <> nil;
|
||||
@ -2876,6 +2943,7 @@ begin
|
||||
end
|
||||
else WriteLn('WARNING: [TgtkObject.ShowCaret] Got null HWND');
|
||||
|
||||
Assert(False, Format('Trace:< [TgtkObject.ShowCaret] HWND: 0x%x --> %s', [hWnd, BOOL_TEXT[Result]]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2933,7 +3001,7 @@ var
|
||||
pixmap : PgdkPixmap;
|
||||
pixmapwid : pgtkWidget;
|
||||
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);
|
||||
if Result
|
||||
then begin
|
||||
@ -2953,6 +3021,7 @@ begin
|
||||
XSrc, YSrc, X, Y, Width, Height);
|
||||
|
||||
end;
|
||||
Assert(True, Format('trace:< [TgtkObject.StretchBlt] DestDC:0x%x --> %s', [DestDC, BOOL_TEXT[Result]]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -3032,6 +3101,14 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
Minor modifications for SynEdit .
|
||||
Shane
|
||||
|
||||
@ -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 CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; 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 CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
|
||||
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
|
||||
@ -98,6 +99,14 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
|
||||
{ =============================================================================
|
||||
|
||||
$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
|
||||
Minor modifications for SynEdit .
|
||||
Shane
|
||||
|
||||
@ -1338,7 +1338,8 @@ function MakeWord(A,B : Byte) : Word;
|
||||
implementation
|
||||
|
||||
uses
|
||||
Interfaces, Strings, Math;
|
||||
|
||||
SysUtils, Interfaces, Strings, Math;
|
||||
|
||||
function MakeLong(A,B : Word) : LongInt;
|
||||
begin
|
||||
@ -1360,6 +1361,14 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
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.
|
||||
|
||||
10
lcl/menus.pp
10
lcl/menus.pp
@ -160,7 +160,7 @@ type
|
||||
end;
|
||||
|
||||
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
|
||||
|
||||
@ -199,6 +199,14 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
+ Initial import
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user