paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 15:58:07 +02: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

54
designer/controlselection.pp
View File

@ -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
then begin
Inc(FLeft, dx);
Dec(FWidth, dx);
end;
if gpRight in Positions then Inc(FWidth, dx);
if gpTop in Positions
then begin
Inc(FTop, dy);
Dec(FHeight, dy)
end;
if gpBottom in Positions then Inc(FHeight, dy);
if gpLeft in TGrabber(Sender).Positions
then begin
Inc(FLeft, dx);
Dec(FWidth, dx);
end;
if gpRight in TGrabber(Sender).Positions then Inc(FWidth, dx);
if gpTop in TGrabber(Sender).Positions
then begin
Inc(FTop, dy);
Dec(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;

9
ide/lazarus.pp
View File

@ -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

9
ide/splash.pp
View File

@ -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

5
lcl/Makefile
View File

@ -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)

4
lcl/Makefile.fpc
View File

@ -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]

10
lcl/include/bitmapcanvas.inc
View File

@ -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

43
lcl/include/winapi.inc
View File

@ -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
//TODO: Finish this. BEGINPAINT
Result := Getdc(Handle);
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,11 +449,11 @@ end;
Returns:
------------------------------------------------------------------------------}
Function CharLowerBuff(pStr : PChar; Len : Integer): Integer;
function CharLowerBuff(pStr : PChar; Len : Integer): Integer;
begin
// your code here
//TODO:WINAPI call CHARLOWERBUFF
Writeln('TODO: WINAPI call CHARLOWERBUFF');
//TODO:WINAPI call CHARLOWERBUFF
Writeln('TODO: WINAPI call CHARLOWERBUFF');
end;
@ -529,8 +539,11 @@ end;
-------------------------------------------------------------------------------}
Function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
Begin
//TODO: Finish EndPaint in winapi.inc
Result := 1;
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

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 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

25
lcl/include/wincontrol.inc
View File

@ -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,26 +1271,27 @@ 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
//ToDO:define wm_erasebkgnd
// Perform(WM_ERASEBKGND, MemDC, MemDC);
Msg.DC := MemDC;
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

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

@ -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,12 +129,14 @@ 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;
(*
(*
//----------------- Is this still used ??? ---------------
Mess.msg := LM_EXPOSEEVENT;
@ -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]

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

@ -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');
@ -208,7 +214,7 @@ begin
Assert(False, 'Trace:Message received');
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:
// 1st part should contain all messages which don't need the "handle" variable
@ -226,7 +232,7 @@ begin
LM_ShowHide :
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);
end;
@ -243,7 +249,7 @@ begin
LM_ATTACHMENU: AttachMenu(Sender);
else begin
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
LM_SetText : SetText(PgtkWidget(Handle), Data);
@ -253,12 +259,12 @@ begin
Assert(False, 'Trace:Adding a child to Parent');
If (TWinControl(Sender).Parent is TToolbar) then
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;
end
else Begin
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);
end;
end;
@ -439,7 +445,7 @@ begin
LM_SetSize :
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);
end;
@ -464,7 +470,7 @@ begin
//SH: think of TCanvas.handle!!!!
LM_ReDraw :
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
ReDraw(PgtkWidget((Sender as TCanvas).Handle))
else
@ -476,7 +482,7 @@ begin
LM_AddPage :
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);
end;
@ -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 }
@ -886,7 +895,7 @@ var
pWidget: PGTKWidget;
Parent: TWinControl;
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;
@ -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
@ -1010,7 +1021,7 @@ var
pLabel: pchar;
begin
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]));
P := Pointer(TWinControl(Sender).Handle);
@ -1026,11 +1037,11 @@ begin
begin
if Child = nil then
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)
end
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);
end;
end;
@ -1069,7 +1080,7 @@ begin
Assert(True, Format ('WARNING: [TgtkObject.SetLabel] --> not handled for class %s ', [Sender.ClassName]));
end;
Assert(False, Format('trace:[TgtkObject.SetLabel] %s --> END', [Sender.ClassName]));
Assert(False, Format('trace: [TgtkObject.SetLabel] %s --> END', [Sender.ClassName]));
end;
{------------------------------------------------------------------------------}
@ -1148,7 +1159,7 @@ procedure TGTKObject.SetCallback(Msg : LongInt; Sender : TObject);
Handler := Next;
end;
// 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);
if ReqSignalMask <> 0 then
@ -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;
@ -2054,7 +2065,7 @@ begin
NewHandle := THandle(gdk_font_load(strTemp));
if NewHandle = 0 then //Load a DEFAULT font
begin
Assert(False, 'Trace:[TgtkObject.FontSetName] WARNING: Loading Default Font');
Assert(False, 'Trace: [TgtkObject.FontSetName] WARNING: Loading Default Font');
StrDispose(StrTemp);
strTemp := StrAlloc(Length('-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1') + 1);
StrPCopy(strTemp, '-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1');
@ -2073,7 +2084,7 @@ begin
Msg := LM_Changed;
TObject(sender).Dispatch(Msg);
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');
StrDispose(StrTemp);
@ -2218,7 +2229,7 @@ begin
result := 0; // default if nobody sets it
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]));
Handle := Pointer(TWinControl(Sender).Handle);
@ -2256,7 +2267,7 @@ begin
result := 0; // default if nobody sets it
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]));
Handle := Pointer(TWinControl(Sender).Handle);
@ -2297,7 +2308,7 @@ begin
result := 0; // default if nobody sets it
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]));
Handle := Pointer(TWinControl(Sender).Handle);
@ -2470,7 +2481,7 @@ end;
function TgtkObject.IsValidDC(const DC: HDC): Boolean;
begin
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;
{------------------------------------------------------------------------------
@ -2507,7 +2518,7 @@ begin
except
on Exception do Result := False;
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;
{------------------------------------------------------------------------------
@ -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

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

@ -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;
@ -94,7 +95,7 @@ procedure SelectGDKBrushProps(const DC: HDC);
begin
with PDeviceContext(DC)^, CurrentBrush^ do
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_foreground(GC, @GDIBrushColor);
gdk_gc_set_background(GC, @CurrentBackColor);
@ -146,7 +147,7 @@ begin
begin
gdk_gc_set_foreground(GC, @CurrentTextColor);
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;
@ -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

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

@ -120,7 +120,7 @@ const // FROM TO
(@DrawableToNoDrawable, @DrawableToDrawable)
);
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);
if Result
then begin
@ -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;
@ -180,7 +200,7 @@ Begin
Inc(P.X, X);
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;
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
@ -215,24 +235,24 @@ begin
if BitCount = gdk_visual_get_system^.Depth
then begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbPixmap', []));
Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbPixmap', []));
GdiObject^.GDIBitmapType := gbPixmap;
GdiObject^.GDIPixmapObject := gdk_pixmap_new(nil, Width, Height, BitCount);
end
else if Bitcount = 1
then begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbBitmap', []));
Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbBitmap', []));
GdiObject^.GDIBitmapType := gbBitmap;
GdiObject^.GDIBitmapObject := gdk_pixmap_new(nil, Width, Height, BitCount);
end
else begin
Assert(False, Format('Trace:[TgtkObject.CreateBitmap] gbImage', []));
Assert(False, Format('Trace: [TgtkObject.CreateBitmap] gbImage', []));
GdiObject^.GDIBitmapType := gbImage;
GdiObject^.GDIRawImageObject := NewGDIRawImage(Width, Height, BitCount);
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);
@ -312,7 +332,7 @@ begin
end;
gdk_colormap_alloc_color(gdk_colormap_get_system, @GObject^.GDIBrushColor, False, True);
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;
if sError = ''
then Result := HBRUSH(GObject)
@ -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
@ -395,7 +441,7 @@ begin
pNewDC^.CurrentPen := CreateDefaultPen;
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;
{------------------------------------------------------------------------------
@ -456,7 +502,7 @@ begin
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.
// API XLFD
@ -571,7 +617,7 @@ begin
if Result = 0
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;
{------------------------------------------------------------------------------
@ -677,33 +723,39 @@ 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
begin
case GDIType of
gdiFont:
begin
if Result then gdk_font_unref(GDIFontObject);
if Result or (PGdiObject(GDIObject) <> nil)
then
with PGdiObject(GDIObject)^ do
begin
case GDIType of
gdiFont:
begin
if Result then gdk_font_unref(GDIFontObject);
end;
gdiBrush:
begin
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 and (GDIBitmapObject <> nil)
then gdk_bitmap_unref(GDIBitmapObject);
end;
gdiPen:
begin
gdk_colormap_free_colors(gdk_colormap_get_system, @GDIPenColor, 1);
end;
else begin
Result:= false;
Assert(False, 'Trace:TODO : Unimplemented GDI object in delete object');
Exit;
end;
gdiBrush:
begin
if Result 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);
end;
gdiPen:
begin
gdk_colormap_free_colors(gdk_colormap_get_system, @GDIPenColor, 1);
end;
else begin
Result:= false;
Assert(False, 'Trace:TODO : Unimplemented GDI object in delete object');
Exit;
end;
end;
end;
{ Dispose of the GDI object }
if PGDIObject(GDIObject) <> nil
then begin
@ -755,7 +807,7 @@ Assert(False, 'Trace:************************************************');
end;
DFC_BUTTON:
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
case uState and $1F of
DFCS_BUTTONRADIOIMAGE:
@ -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;
{------------------------------------------------------------------------------
@ -976,7 +1029,7 @@ end;
------------------------------------------------------------------------------}
function TGTKObject.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
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
then gtk_widget_set_sensitive(pgtkwidget(hWnd), bEnable)
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,27 +1226,27 @@ begin
pFixed := GetFixedWidget(Pointer(hWnd));
if pFixed = nil
then begin
WriteLn('WARNING: [TgtkObject.GetDC] Window has no fixed');
end
else begin
// create a new devicecontext for this window
P := NewDC;
p^.hWnd := hWnd;
//(*
if PGTKFixed(pFixed)^.Container.Widget.Window = nil
then begin
Assert(False, 'Trace:[TgtkObject.GetDC] Force widget creation');
//force creation
gtk_widget_realize(PGTKWidget(pFixed));
end;
//*)
p^.Drawable := PGTKFixed(pFixed)^.Container.Widget.Window;
p^.GC := gdk_gc_new(p^.Drawable);
gdk_gc_set_function(p^.GC, GDK_COPY);
gdk_gc_get_values(p^.GC, @Values);
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;
//(*
if PGTKFixed(pFixed)^.Container.Widget.Window = nil
then begin
Assert(False, 'Trace:[TgtkObject.GetDC] Force widget creation');
//force creation
gtk_widget_realize(PGTKWidget(pFixed));
end;
//*)
p^.Drawable := PGTKFixed(pFixed)^.Container.Widget.Window;
p^.GC := gdk_gc_new(p^.Drawable);
gdk_gc_set_function(p^.GC, GDK_COPY);
gdk_gc_get_values(p^.GC, @Values);
end;
if p <> nil
@ -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;
{------------------------------------------------------------------------------
@ -1262,7 +1317,7 @@ end;
------------------------------------------------------------------------------}
function TgtkObject.GetKeyState(nVirtKey: Integer): Smallint;
const
KEYSTATE: array[Boolean] of Smallint = (0, -32768{$8000});
KEYSTATE: array[Boolean] of Smallint = (0, -32768 { $8000});
TOGGLESTATE: array[Boolean] of Smallint = (0, 1);
begin
case nVirtKey of
@ -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;
{------------------------------------------------------------------------------
@ -1919,7 +1978,7 @@ function TgtkObject.HideCaret(hWnd: HWND): Boolean;
var
GTKObject: PGTKObject;
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)
GTKObject := PGTKObject(HWND);
@ -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)
@ -2403,7 +2467,7 @@ begin
gdiBitmap:
with PDeviceContext(DC)^ do
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);
CurrentBitmap := PGDIObject(GDIObj);
if GC <> nil then gdk_gc_unref(GC);
@ -2423,7 +2487,7 @@ begin
gdiBrush:
with PDeviceContext(DC)^, PGdiObject(GDIObj)^ do
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);
CurrentBrush := PGDIObject(GDIObj);
if GC <> nil
@ -2438,7 +2502,7 @@ begin
gdiFont:
with PDeviceContext(DC)^ do
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);
CurrentFont := PGDIObject(GDIObj);
if GC <> nil
@ -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

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 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

15
lcl/lcllinux.pp
View File

@ -1338,16 +1338,17 @@ function MakeWord(A,B : Byte) : Word;
implementation
uses
Interfaces, Strings, Math;
SysUtils, Interfaces, Strings, Math;
function MakeLong(A,B : Word) : LongInt;
begin
Result := A or B shl 16;
Result := A or B shl 16;
end;
function MakeWord(A,B : Byte) : Word;
Begin
Result := A or B shl 8;
Result := A or B shl 8;
end;
{$I winapi.inc}
@ -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
View File

@ -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