mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 06:55:59 +02:00
Keith: Fixed TPage creation
git-svn-id: trunk@603 -
This commit is contained in:
lazarus
parent
147fbd54ee
commit
55887225f3
File diff suppressed because it is too large
Load Diff
@ -43,7 +43,7 @@ Var
|
||||
FormClassName: PChar;
|
||||
|
||||
Const
|
||||
ClsName = 'MainWinClass';
|
||||
ClsName = 'LazarusForm';
|
||||
|
||||
Type
|
||||
{ Virtual alignment-control record }
|
||||
@ -65,7 +65,7 @@ Type
|
||||
FMessageQueue: TList;
|
||||
FToolTipWindow: HWND;
|
||||
FAccelGroup: HACCEL;
|
||||
FTimerData : TList; // Keeps track of timer event structures
|
||||
FTimerData: TList; // Keeps track of timer event structures
|
||||
|
||||
FAlignment: TAlignment; // Tracks alignment
|
||||
FControlIndex: Cardinal; // Win32-API control index
|
||||
@ -88,7 +88,7 @@ Type
|
||||
|
||||
Procedure CreateComponent(Sender: TObject);
|
||||
Procedure AddChild(Parent, Child: HWND; Left, Top: Integer);
|
||||
Procedure ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
|
||||
Procedure ResizeChild(Window: HWND; Left, Top, Width, Height: Integer);
|
||||
Function GetLabel(CompStyle: Integer; Window: HWnd): String;
|
||||
Procedure AssignSelf(Window: HWnd; Data: Pointer);
|
||||
Procedure ReDraw(Child: TObject);
|
||||
@ -111,8 +111,8 @@ Type
|
||||
Procedure SetColor(Sender : TObject);
|
||||
Procedure SetPixel(Sender: TObject; Data: Pointer);
|
||||
Procedure GetPixel(Sender: TObject; Data: Pointer);
|
||||
Function GetValue (Sender: TObject; Data: pointer): Integer;
|
||||
Function SetValue (Sender: TObject; Data: pointer): Integer;
|
||||
Function GetValue (Sender: TObject; Data: Pointer): Integer;
|
||||
Function SetValue (Sender: TObject; Data: Pointer): Integer;
|
||||
Function SetProperties (Sender: TObject): Integer;
|
||||
Procedure AttachMenu(Sender: TObject);
|
||||
|
||||
@ -129,6 +129,7 @@ Type
|
||||
Procedure DrawText(Child: TObject; Data: Pointer);
|
||||
Procedure PaintPixmap(Surface: TObject; PixmapData: Pointer);
|
||||
Procedure NormalizeIconName(Var IconName: String);
|
||||
Procedure NormalizeIconName(Var IconName: PChar);
|
||||
Procedure CreateCommonDialog(Sender: TObject);
|
||||
Public
|
||||
{ Constructor of the class }
|
||||
@ -155,7 +156,7 @@ Type
|
||||
Procedure DoEvents; Override;
|
||||
{ Handle all events (Window messages) }
|
||||
Procedure HandleEvents; Override;
|
||||
{ Halt until a message is received }
|
||||
{ Wait until a message is received }
|
||||
Procedure WaitMessage; Override;
|
||||
{ Abruptly halt execution of the program }
|
||||
Procedure AppTerminate; Override;
|
||||
@ -242,9 +243,7 @@ Type
|
||||
WParam: WPARAM;
|
||||
Win32Control: PWin32Control;
|
||||
Event: Pointer;
|
||||
Draw: Record
|
||||
X, Y: Integer;
|
||||
End;
|
||||
Draw: TPoint;
|
||||
ExtData: Pointer;
|
||||
Reserved: Pointer;
|
||||
End;
|
||||
@ -326,6 +325,9 @@ End.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.6 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
Revision 1.5 2002/01/05 13:16:09 lazarus
|
||||
MG: win32 interface update from Keith Bowes
|
||||
|
||||
|
||||
@ -19,8 +19,8 @@ Function DefaultCompareFunc(A, B: HWND): Integer; CDecl;
|
||||
Var
|
||||
AStr, BStr: PChar;
|
||||
Begin
|
||||
GetWindowText(A, AStr, GetWindowTextLength(A) + 1);
|
||||
GetWindowText(B, BStr, GetWindowTextLength(B) + 1);
|
||||
GetWindowText(A, @AStr, GetWindowTextLength(A) + 1);
|
||||
GetWindowText(B, @BStr, GetWindowTextLength(B) + 1);
|
||||
Result := StrComp(AStr, BStr);
|
||||
end;
|
||||
|
||||
@ -106,7 +106,7 @@ Begin
|
||||
Raise Exception.Create('Out of bounds.')
|
||||
Else
|
||||
Begin
|
||||
SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(Item));
|
||||
SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(@Item));
|
||||
End;
|
||||
Result := StrPas(Item);
|
||||
End;
|
||||
@ -262,7 +262,7 @@ Begin
|
||||
Raise Exception.Create('Out of bounds.')
|
||||
Else
|
||||
Begin
|
||||
SendMessage(FWin32CList, CB_GETLBTEXT, Index, LPARAM(Item));
|
||||
SendMessage(FWin32CList, CB_GETLBTEXT, Index, LPARAM(@Item));
|
||||
Result := StrPas(Item);
|
||||
End;
|
||||
End;
|
||||
@ -329,8 +329,10 @@ End;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.2 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
Revision 1.1 2002/01/06 23:09:52 lazarus
|
||||
MG: added missing files
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -103,28 +103,29 @@ Var
|
||||
Ctrl: TNotebook;
|
||||
TCI: TC_ITEM;
|
||||
Begin
|
||||
Assert(False, 'Trace:TWin32Object.GetText - Start');
|
||||
Assert(False, Format('Trace:TWin32Object.GetText - Start --> %S', [Sender.ClassName]));
|
||||
Data := '';
|
||||
Result := True;
|
||||
Case Sender.FCompStyle Of
|
||||
csComboBox, csEdit, csMemo:
|
||||
Begin
|
||||
CapLen := GetWindowTextLength((Sender As TWinControl).Handle);
|
||||
GetWindowText((Sender As TWinControl).Handle, Caption, CapLen + 1);
|
||||
GetWindowText((Sender As TWinControl).Handle, @Caption, CapLen + 1);
|
||||
Data := StrPas(PChar(@Caption));
|
||||
End;
|
||||
csPage:
|
||||
Begin
|
||||
Assert(False, 'Trace:TWin32Object.GetText - csPage: Start');
|
||||
Ctrl := (TNotebook(Sender));
|
||||
Ctrl := ((Sender As TPage).Parent As TNotebook);
|
||||
Try
|
||||
Assert(False, 'Trace:TWin32Object.GetText - Filling TC_ITEM');
|
||||
TCI.mask := TCIF_TEXT;
|
||||
TCI.cchTextMax := MAX_PATH;
|
||||
TCI.pszText := StrAlloc(MAX_PATH);
|
||||
Assert(False, 'Trace:TWin32Object.GetText - Getting the text');
|
||||
TabCtrl_GetItem(Ctrl.Handle, PLMNotebookEvent(@Sender)^.Page, TCI);
|
||||
Assert(False, 'Trace:TWin32Object.GetText - Returning the text');
|
||||
TabCtrl_GetItem(Ctrl.Handle, Ctrl.PageIndex, TCI);
|
||||
Data := String(TCI.pszText);
|
||||
Assert(False, Format('Trace:TWin32Object.GetText - Returning the text --> %S', [Data]));
|
||||
Except
|
||||
StrDispose(TCI.pszText);
|
||||
End;
|
||||
@ -133,7 +134,7 @@ Begin
|
||||
Else
|
||||
Result := False;
|
||||
End;
|
||||
Data := StrPas(Caption);
|
||||
// Result := Data <> '';
|
||||
End;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -358,7 +359,7 @@ Begin
|
||||
LM_SETPROPERTIES:
|
||||
Result := SetProperties(Sender);
|
||||
LM_SETDESIGNING:
|
||||
EnableWindow(Handle, False);
|
||||
EnableWindow((Sender As TWinControl).Handle, False);
|
||||
LM_RECREATEWND:
|
||||
Result := RecreateWnd(Sender);
|
||||
LM_ATTACHMENU:
|
||||
@ -1492,6 +1493,7 @@ Begin
|
||||
|
||||
If (Sender Is TWinControl) And ((Sender As TWinControl).Parent <> Nil) Then
|
||||
Begin
|
||||
Assert(False, Format('Trace: %S parent --> %S', [Sender.ClassName, TWinControl(Sender).Parent.ClassName]));
|
||||
Parent := (Sender As TWinControl).Parent.Handle;
|
||||
Assert(False, 'Trace:Setting parent');
|
||||
End
|
||||
@ -1582,7 +1584,7 @@ Begin
|
||||
Assert(False, 'Trace:CreateComponent - Button Window Handle Value = $' + IntToHex(Window, 8));
|
||||
Assert(False, 'Trace:CreateComponent - Creating a Button - SetProp');
|
||||
If Window <> HWND(Nil) Then
|
||||
SetProp(Window, 'Lazarus', @Sender);
|
||||
SetProp(Window, 'Lazarus', Sender);
|
||||
SetName(Window, StrTemp);
|
||||
End;
|
||||
csCalendar:
|
||||
@ -1614,10 +1616,12 @@ Begin
|
||||
End;
|
||||
csImage:
|
||||
Begin
|
||||
DC := GetDC(Handle);
|
||||
With TImage(Sender).Picture.Bitmap Do
|
||||
Window := CreateBitmap(Width, Height, GetDeviceCaps(DC, PLANES), BitsPerPixel[Monochrome], Nil);
|
||||
SetOwner(Window, Sender);
|
||||
SetName(Window, StrTemp);
|
||||
ReleaseDC(Handle, DC);
|
||||
End;
|
||||
csListBox:
|
||||
Begin
|
||||
@ -1673,13 +1677,13 @@ Begin
|
||||
Window := CreateWindow(ClsName, StrTemp, WS_OVERLAPPEDWINDOW, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
|
||||
If Sender Is TForm Then
|
||||
OldClipboardViewer := SetClipboardViewer(Window);
|
||||
If FMainForm = Nil Then
|
||||
If (FMainForm = Nil) And (Application.MainForm = Nil) Then
|
||||
FMainForm := TForm(Sender);
|
||||
FParentWindow := Window;
|
||||
Assert(False, 'Trace:CreateComponent - Form Window Handle Value = $' + IntToHex(Window, 8));
|
||||
Assert(False, 'Trace:Creating a Form - SetProp');
|
||||
//SetProp(Window, 'Lazarus', @Sender);
|
||||
SetProp(Window, 'Lazarus', Pointer(Sender));
|
||||
SetProp(Window, 'Lazarus', Sender);
|
||||
If Window = 0 then
|
||||
Begin
|
||||
MessageBox(0, 'csForm CreateWindow Failed', nil, mb_Ok);
|
||||
@ -1862,30 +1866,48 @@ Begin
|
||||
// TPage - Notebook page
|
||||
csPage:
|
||||
Begin
|
||||
Assert(False, 'Trace:TODO:Create a csPage component.');
|
||||
Assert(False, 'Trace:TODO: Create a csPage component.');
|
||||
Assert(False, 'Trace:Going to try it here. I''m guaranteeing nothing.');
|
||||
With TCI Do
|
||||
Begin
|
||||
Mask := TCIF_TEXT;
|
||||
PSzText := StrTemp;
|
||||
End;
|
||||
Assert(False, 'Trace:csPage - class name is ' + Sender.ClassName);
|
||||
//Assert(False, Format('Trace:[TWin32Object.CreateComponent] csPage: Tab index=%D', [PLMNotebookEvent(@Sender)^.Page]));
|
||||
Try
|
||||
Window := TabCtrl_InsertItem((Sender As TWinControl).Parent.Handle, PLMNotebookEvent(@Sender)^.Page, TCI);
|
||||
Except
|
||||
Assert(False, 'Trace:csPage - Could not insert page');
|
||||
Exit;
|
||||
With ((Sender As TPage).Parent As TNotebook) Do
|
||||
Begin
|
||||
StrDispose(StrTemp);
|
||||
Try
|
||||
Assert(False, Format('Trace:Page caption --> %S', [Page[PageIndex].Caption]));
|
||||
StrTemp := StrAlloc(Length(Page[PageIndex].Caption) + 1);
|
||||
StrPCopy(StrTemp, Page[PageIndex].Caption);
|
||||
Except
|
||||
On E: Exception Do
|
||||
Begin
|
||||
Assert(False, Format('Trace:TWin32Object.CreateComponent - could not create in csPage --> %S', [E.Message]));
|
||||
//Exit;
|
||||
End;
|
||||
End;
|
||||
With TCI Do
|
||||
Begin
|
||||
Mask := TCIF_TEXT;
|
||||
PSzText := StrTemp;
|
||||
End;
|
||||
Try
|
||||
Assert(False, Format('Trace:Number of pages: %D, current page: %D', [Pages.Count, PageIndex]));
|
||||
Window := TabCtrl_InsertItem(Handle, PageIndex, TCI);
|
||||
Except
|
||||
Assert(False, 'Trace:csPage - Could not insert page');
|
||||
Exit;
|
||||
End;
|
||||
If PageIndex >= Pages.Count - 1 Then
|
||||
TabCtrl_DeleteItem(Handle, Pages.Count);
|
||||
PageIndex := PageIndex + 1;
|
||||
SetProp(Handle, 'Lazarus', @Sender);
|
||||
Self.SetName(Handle, StrTemp);
|
||||
End;
|
||||
SetProp(Window, 'Lazarus', @Sender);
|
||||
SetName(Window, strTemp);
|
||||
End;
|
||||
csPopupMenu:
|
||||
Begin
|
||||
Window := CreatePopupMenu;
|
||||
FSubMenu := Window;
|
||||
SetProp(Window, 'Lazarus', @Sender);
|
||||
SetName(Window, strTemp);
|
||||
SetName(Window, StrTemp);
|
||||
End;
|
||||
csProgressBar:
|
||||
Begin
|
||||
@ -1898,7 +1920,7 @@ Begin
|
||||
Assert(False, 'TRACE:CreateComponent - Creating a Track Bar (if we''re lucky)');
|
||||
Window := CreateWindow(TRACKBAR_CLASS, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
|
||||
SetProp(Window, 'Lazarus', @Sender);
|
||||
SetName(Window, strTemp);
|
||||
SetName(Window, StrTemp);
|
||||
End;
|
||||
End; {Case}
|
||||
|
||||
@ -1919,29 +1941,34 @@ Begin
|
||||
If (Sender Is TControl) Then
|
||||
Begin
|
||||
Assert(False, 'Trace:CreateComponent - Assigning window to TControl');
|
||||
(Sender as TWinControl).Handle := Window;
|
||||
(Sender As TWinControl).Handle := Window;
|
||||
End
|
||||
Else
|
||||
If (Sender Is TControlCanvas) Then
|
||||
Begin
|
||||
Assert(False, 'Trace:CreateComponent - Assigning window to TControlCanvas');
|
||||
(Sender as TControlCanvas).Handle := Window;
|
||||
(Sender As TControlCanvas).Handle := Window;
|
||||
End
|
||||
Else If (Sender Is TFont) Then
|
||||
Begin
|
||||
Assert(False, 'Trace:CreateComponent - Assigning P to TFont');
|
||||
(Sender as TFont).Handle := Window;
|
||||
(Sender As TFont).Handle := Window;
|
||||
End;
|
||||
End;
|
||||
|
||||
SetLCLObject(Window, Sender);
|
||||
|
||||
If Window = HWnd(Nil) Then
|
||||
Begin
|
||||
SetProp(Window, 'Style', Pointer(GetWindowLong(Window, GWL_Style)));
|
||||
SetProp(Window, 'ExStyle', Pointer(GetWindowLong(Window, GWL_ExStyle)));
|
||||
End;
|
||||
|
||||
StrDispose(StrTemp);
|
||||
Try
|
||||
StrDispose(StrTemp);
|
||||
Except
|
||||
Assert(False, 'Trace:Warning: Tried to dispose a string that was not allocated');
|
||||
End;
|
||||
|
||||
Assert(False, 'Trace:Leaving CreateComponent');
|
||||
End;
|
||||
@ -2023,9 +2050,9 @@ Var
|
||||
TCI: TC_ITEM;
|
||||
Begin
|
||||
Assert(False, 'Trace:TWin32Object.AddNBPage - Start');
|
||||
Assert(False, Format('Trace:Adding notebook page %N', [Index]));
|
||||
Assert(False, Format('Trace:Adding notebook page %D', [Index]));
|
||||
|
||||
PStr := StrAlloc(Length(TPage(Child).Caption) + 1);
|
||||
{PStr := StrAlloc(Length(TPage(Child).Caption) + 1);
|
||||
Try
|
||||
StrPCopy(PStr, TPage(Child).Caption);
|
||||
With TCI Do
|
||||
@ -2042,7 +2069,7 @@ Begin
|
||||
End;
|
||||
|
||||
PTabInfo(@Child)^.Caption := PChar(TPage(Child).Caption);
|
||||
PTabInfo(@Child)^.Index := Index;
|
||||
PTabInfo(@Child)^.Index := Index;}
|
||||
Assert(False, 'Trace:TWin32Object.AddNBPage - Exit');
|
||||
End;
|
||||
|
||||
@ -2689,26 +2716,7 @@ End;
|
||||
Assigns a name to a window
|
||||
------------------------------------------------------------------------------}
|
||||
Procedure TWin32Object.SetName(Window: HWND; Value: PChar);
|
||||
Var
|
||||
I: Integer;
|
||||
WndListed: Boolean;
|
||||
Begin
|
||||
WndListed := False;
|
||||
|
||||
For I := 0 To WndList.Count - 1 Do
|
||||
Begin
|
||||
If HWND(WndList[I]) = Window Then
|
||||
Begin
|
||||
WndListed := True;
|
||||
End;
|
||||
End;
|
||||
|
||||
If Not WndListed Then
|
||||
Begin
|
||||
WndList.Capacity := WndList.Count;
|
||||
WndList.Add(Pointer(Window));
|
||||
End;
|
||||
|
||||
SetProp(Window, 'Name', Value);
|
||||
End;
|
||||
|
||||
@ -2721,27 +2729,8 @@ End;
|
||||
Assigns an owner object to a window
|
||||
------------------------------------------------------------------------------}
|
||||
Procedure TWin32Object.SetOwner(Window: HWND; Owner: TObject);
|
||||
Var
|
||||
I: Integer;
|
||||
WndListed: Boolean;
|
||||
Begin
|
||||
WndListed := False;
|
||||
|
||||
For I := 0 To WndList.Count - 1 Do
|
||||
Begin
|
||||
If HWND(WndList[I]^) = Window Then
|
||||
Begin
|
||||
WndListed := True;
|
||||
End;
|
||||
End;
|
||||
|
||||
If Not WndListed Then
|
||||
Begin
|
||||
WndList.Capacity := WndList.Count;
|
||||
WndList.Add(@Window);
|
||||
End;
|
||||
|
||||
SetProp(Window, 'Lazarus', Pointer(Owner));
|
||||
SetProp(Window, 'Lazarus', Owner);
|
||||
SetProp(Window, 'MsgList', Nil);
|
||||
End;
|
||||
|
||||
@ -2896,9 +2885,10 @@ Begin
|
||||
End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
Revision 1.5 2002/01/12 22:49:02 lazarus
|
||||
Keith: Fixed compilation problem and some bugs
|
||||
|
||||
Revision 1.4 2002/01/05 13:16:09 lazarus
|
||||
MG: win32 interface update from Keith Bowes
|
||||
|
||||
@ -209,8 +209,8 @@ Begin
|
||||
$003D: Result := 'WM_GETOBJECT';
|
||||
$0041: Result := 'WM_COMPACTING';
|
||||
$0044: Result := 'WM_COMMNOTIfY { obsolete in Win32}';
|
||||
$0046: Result := 'WM_WINDoWPOSCHANGING';
|
||||
$0047: Result := 'WM_WINDoWPOSCHANGED';
|
||||
$0046: Result := 'WM_WINDOWPOSCHANGING';
|
||||
$0047: Result := 'WM_WINDOWPOSCHANGED';
|
||||
$0048: Result := 'WM_POWER';
|
||||
$004A: Result := 'WM_COPYDATA';
|
||||
$004B: Result := 'WM_CANCELJOURNAL';
|
||||
@ -235,26 +235,26 @@ Begin
|
||||
$0086: Result := 'WM_NCACTIVATE';
|
||||
$0087: Result := 'WM_GETDLGCODE';
|
||||
$00A0: Result := 'WM_NCMOUSEMOVE';
|
||||
$00A1: Result := 'WM_NCLBUTTONDoWN';
|
||||
$00A1: Result := 'WM_NCLBUTTONDOWN';
|
||||
$00A2: Result := 'WM_NCLBUTTONUP';
|
||||
$00A3: Result := 'WM_NCLBUTTONDBLCLK';
|
||||
$00A4: Result := 'WM_NCRBUTTONDoWN';
|
||||
$00A4: Result := 'WM_NCRBUTTONDOWN';
|
||||
$00A5: Result := 'WM_NCRBUTTONUP';
|
||||
$00A6: Result := 'WM_NCRBUTTONDBLCLK';
|
||||
$00A7: Result := 'WM_NCMBUTTONDoWN';
|
||||
$00A7: Result := 'WM_NCMBUTTONDOWN';
|
||||
$00A8: Result := 'WM_NCMBUTTONUP';
|
||||
$00A9: Result := 'WM_NCMBUTTONDBLCLK';
|
||||
$0100: Result := 'WM_KEYFIRST or WM_KEYDoWN';
|
||||
$0100: Result := 'WM_KEYFIRST or WM_KEYDOWN';
|
||||
$0101: Result := 'WM_KEYUP';
|
||||
$0102: Result := 'WM_CHAR';
|
||||
$0103: Result := 'WM_DEADCHAR';
|
||||
$0104: Result := 'WM_SYSKEYDoWN';
|
||||
$0104: Result := 'WM_SYSKEYDOWN';
|
||||
$0105: Result := 'WM_SYSKEYUP';
|
||||
$0106: Result := 'WM_SYSCHAR';
|
||||
$0107: Result := 'WM_SYSDEADCHAR';
|
||||
$0108: Result := 'WM_KEYLAST';
|
||||
$010D: Result := 'WM_IME_STARTCOMPOSITION';
|
||||
$010E: Result := 'WM_IME_EndCOMPOSITION';
|
||||
$010E: Result := 'WM_IME_ENDCOMPOSITION';
|
||||
$010F: Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST';
|
||||
$0110: Result := 'WM_INITDIALOG';
|
||||
$0111: Result := 'WM_COMMAND';
|
||||
@ -280,17 +280,17 @@ Begin
|
||||
$0137: Result := 'WM_CTLCOLORSCROLLBAR';
|
||||
$0138: Result := 'WM_CTLCOLORSTATIC';
|
||||
$0200: Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE';
|
||||
$0201: Result := 'WM_LBUTTONDoWN';
|
||||
$0201: Result := 'WM_LBUTTONDOWN';
|
||||
$0202: Result := 'WM_LBUTTONUP';
|
||||
$0203: Result := 'WM_LBUTTONDBLCLK';
|
||||
$0204: Result := 'WM_RBUTTONDoWN';
|
||||
$0204: Result := 'WM_RBUTTONDOWN';
|
||||
$0205: Result := 'WM_RBUTTONUP';
|
||||
$0206: Result := 'WM_RBUTTONDBLCLK';
|
||||
$0207: Result := 'WM_MBUTTONDoWN';
|
||||
$0207: Result := 'WM_MBUTTONDOWN';
|
||||
$0208: Result := 'WM_MBUTTONUP';
|
||||
$0209: Result := 'WM_MBUTTONDBLCLK';
|
||||
$020A: Result := 'WM_MOUSEWHEEL or WM_MOUSELAST';
|
||||
$0210: Result := 'WM_PARENTNOTIfY';
|
||||
$0210: Result := 'WM_PARENTNOTIFY';
|
||||
$0211: Result := 'WM_ENTERMENULOOP';
|
||||
$0212: Result := 'WM_EXITMENULOOP';
|
||||
$0213: Result := 'WM_NEXTMENU';
|
||||
@ -315,13 +315,13 @@ Begin
|
||||
$0233: Result := 'WM_DROPFILES';
|
||||
$0234: Result := 'WM_MDIREFRESHMENU';
|
||||
$0281: Result := 'WM_IME_SETCONTEXT';
|
||||
$0282: Result := 'WM_IME_NOTIfY';
|
||||
$0282: Result := 'WM_IME_NOTIFY';
|
||||
$0283: Result := 'WM_IME_CONTROL';
|
||||
$0284: Result := 'WM_IME_COMPOSITIONFULL';
|
||||
$0285: Result := 'WM_IME_SELECT';
|
||||
$0286: Result := 'WM_IME_CHAR';
|
||||
$0288: Result := 'WM_IME_REQUEST';
|
||||
$0290: Result := 'WM_IME_KEYDoWN';
|
||||
$0290: Result := 'WM_IME_KEYDOWN';
|
||||
$0291: Result := 'WM_IME_KEYUP';
|
||||
$02A1: Result := 'WM_MOUSEHOVER';
|
||||
$02A3: Result := 'WM_MOUSELEAVE';
|
||||
@ -329,9 +329,9 @@ Begin
|
||||
$0301: Result := 'WM_COPY';
|
||||
$0302: Result := 'WM_PASTE';
|
||||
$0303: Result := 'WM_CLEAR';
|
||||
$0304: Result := 'WM_UNDo';
|
||||
$0305: Result := 'WM_REndERFORMAT';
|
||||
$0306: Result := 'WM_REndERALLFORMATS';
|
||||
$0304: Result := 'WM_UNDO';
|
||||
$0305: Result := 'WM_RENDERFORMAT';
|
||||
$0306: Result := 'WM_RENDERALLFORMATS';
|
||||
$0307: Result := 'WM_DESTROYCLIPBOARD';
|
||||
$0308: Result := 'WM_DRAWCLIPBOARD';
|
||||
$0309: Result := 'WM_PAINTCLIPBOARD';
|
||||
@ -610,7 +610,7 @@ End;
|
||||
Function Win32KeyState2ShiftState(KeyState: Word): TShiftState;
|
||||
Begin
|
||||
Assert(False, 'TRACE:Using Function Win32KeyState2ShiftState which isn''t implemented yet');
|
||||
GetShiftState;
|
||||
Result := GetShiftState;
|
||||
End;
|
||||
|
||||
|
||||
@ -899,6 +899,10 @@ End;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.4 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
|
||||
Revision 1.3 2002/01/05 13:16:10 lazarus
|
||||
MG: win32 interface update from Keith Bowes
|
||||
|
||||
@ -908,4 +912,4 @@ End;
|
||||
Revision 1.1 2001/08/02 12:58:35 lazarus
|
||||
MG: win32 interface patch from Keith Bowes
|
||||
|
||||
}
|
||||
}
|
||||
@ -48,7 +48,6 @@ Const
|
||||
circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
|
||||
counter-clockwise while negative values mean clockwise direction.
|
||||
Zero degrees is at the 3'o clock position.
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
Function TWin32Object.Arc(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean;
|
||||
Begin
|
||||
@ -138,12 +137,9 @@ End;
|
||||
Returns: the corresponding mime type as string
|
||||
------------------------------------------------------------------------------}
|
||||
Function TWin32Object.ClipboardFormatToMimeType(FormatID: TClipboardFormat): String;
|
||||
Var
|
||||
GFN: PChar;
|
||||
Begin
|
||||
Assert(False, 'Trace:TWin32Object.ClipboardFormatToMimeType - Start');
|
||||
Windows.GetClipboardFormatName(FormatID, GFN, MAX_PATH);
|
||||
Result := StrPas(GFN);
|
||||
Windows.GetClipboardFormatName(FormatID, @Result, MAX_PATH);
|
||||
Assert(False, 'Trace:TWin32Object.ClipboardFormatToMimeType - Exit');
|
||||
End;
|
||||
|
||||
@ -216,13 +212,18 @@ Var
|
||||
I: Integer;
|
||||
P: PChar;
|
||||
Begin
|
||||
Result := True;
|
||||
If GetClipboardOwner <> HWND(Nil) Then
|
||||
OnRequestProc(0, Nil);
|
||||
GetMem(Formats, FormatCount * SizeOf(TClipboardFormat));
|
||||
For I := 0 To FormatCount Do
|
||||
Begin
|
||||
GetClipboardFormatName(Formats[I], @P, MAX_PATH);
|
||||
RegisterClipboardFormat(@P);
|
||||
Try
|
||||
For I := 0 To FormatCount Do
|
||||
Begin
|
||||
GetClipboardFormatName(Formats[I], @P, MAX_PATH);
|
||||
RegisterClipboardFormat(@P);
|
||||
End;
|
||||
Except
|
||||
Result := False;
|
||||
End;
|
||||
FreeMem(Formats);
|
||||
End;
|
||||
@ -1422,10 +1423,32 @@ End;
|
||||
|
||||
Adds a new entry or changes an existing entry in the property list of the
|
||||
specified window.
|
||||
|
||||
NOTE: LCLLinux has no RemoveProp function but Windows API requires all set
|
||||
properties to be removed, so I'm keeping a list of windows with properties
|
||||
for a properties-enumeration function that's called when the program is quit.
|
||||
------------------------------------------------------------------------------}
|
||||
Function TWin32Object.SetProp(Handle: HWND; Str: PChar; Data: Pointer): Boolean;
|
||||
Var
|
||||
C: Cardinal;
|
||||
WndListed: Boolean;
|
||||
Begin
|
||||
Assert(False, 'Trace:TWin32Object.SetProp - Start');
|
||||
WndListed := False;
|
||||
|
||||
If WndList.Count > 0 Then
|
||||
For C := 0 To WndList.Count - 1 Do
|
||||
If HWND(WndList[C]) = Handle Then
|
||||
WndListed := True;
|
||||
|
||||
If Not WndListed Then
|
||||
Begin
|
||||
WndList.Capacity := WndList.Count;
|
||||
WndList.Add(Pointer(Handle));
|
||||
End;
|
||||
|
||||
Result := Windows.SetProp(Handle, Str, Integer(Data));
|
||||
Assert(False, Format('Trace:TWin32Object.SetProp --> Window handle: 0x%X, Propery to set: %S, Data to set: 0x%P, Window was previously in list: %S, Property was successfully set: %S', [Handle, String(Str), Data, BOOL_RESULT[WndListed], BOOL_RESULT[Result]]));
|
||||
End;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1686,8 +1709,8 @@ End;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.1 2002/01/06 23:09:53 lazarus
|
||||
MG: added missing files
|
||||
Revision 1.2 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -34,11 +34,11 @@ Function CreateFontIndirect(Const LogFont: TLogFont): HFONT; Override;
|
||||
Function CreatePenIndirect(Const LogPen: TLogPen): HPEN; Override;
|
||||
{ Creates a bitmap from raw pixmap data }
|
||||
Function CreatePixmapIndirect(Const Data: Pointer; Const TransColor: LongInt): HBITMAP; Override;
|
||||
Function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
|
||||
Function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; Override;
|
||||
|
||||
Function DeleteDC(HDC: HDC): Boolean; Override;
|
||||
Function DeleteObject(GDIObject: HGDIOBJ): Boolean; Override;
|
||||
Function DestroyCaret(Handle: HWND): Boolean;
|
||||
Function DestroyCaret(Handle: HWND): Boolean; Override;
|
||||
Function DrawFrameControl(DC: HDC; Var Rect: TRect; UType, UState: Cardinal): Boolean; Override;
|
||||
Function DrawEdge(DC: HDC; Var Rect: TRect; Edge: Cardinal; GrfFlags: Cardinal): Boolean; Override;
|
||||
|
||||
@ -84,10 +84,10 @@ Function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YS
|
||||
Function MessageBox(HWnd: HWND; LPText, LPCaption: PChar; UType: Cardinal): Integer; Override;
|
||||
Function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; Override;
|
||||
|
||||
Function PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean; Override;
|
||||
Function PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean;
|
||||
Function Pie(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean; Override;
|
||||
Function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: Boolean): Boolean;
|
||||
Function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): Boolean;
|
||||
Function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: Boolean): Boolean; Override;
|
||||
Function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): Boolean; Override;
|
||||
Function PostMessage(HWnd: HWND; Msg: Cardinal; WParam: LongInt; LParam: LongInt): Boolean; Override;
|
||||
|
||||
Function RealizePalette(DC: HDC): Cardinal; Override;
|
||||
@ -115,7 +115,7 @@ Function SetSysColors(CElements: Integer; Const LPAElements; Const LPARgbValues)
|
||||
Function SetTextCharacterExtra(_HDC: HDC; NCharExtra: Integer): Integer; Override;
|
||||
Function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; Override;
|
||||
Function SetTimer(HWnd: HWND; NIDEvent, uElapse: Integer; LPTimerFunc: TFNTimerProc): Integer; Override;
|
||||
Function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: LongInt): LongInt;
|
||||
Function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: LongInt): LongInt; Override;
|
||||
Function SetWindowOrgEx(DC: HDC; NewX, NewY: Integer; Var Point: TPoint): Boolean; Override;
|
||||
Function SetWindowPos(HWnd: HWND; HWndInsertAfter: HWND; X, Y, CX, CY: Integer; UFlags: UINT): Boolean; Override;
|
||||
Function ShowCaret(HWnd: HWND): Boolean; Override;
|
||||
@ -131,6 +131,9 @@ Function WindowFromPoint(Point: TPoint): HWND; Override;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.2 2002/01/17 03:17:44 lazarus
|
||||
Keith: Fixed TPage creation
|
||||
|
||||
Revision 1.1 2002/01/06 23:09:53 lazarus
|
||||
MG: added missing files
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{
|
||||
Extra Win32 code that's not in the RTL.
|
||||
Copyright (C) 2001 Keith Bowes.
|
||||
Copyright (C) 2001, 2002 Keith Bowes.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
@ -15,6 +15,10 @@
|
||||
|
||||
Unit WinExt;
|
||||
|
||||
{$IFDEF TRACE}
|
||||
{$ASSERTIONS ON}
|
||||
{$ENDIF}
|
||||
|
||||
{$PACKRECORDS C}
|
||||
{$SMARTLINK ON}
|
||||
|
||||
@ -173,7 +177,8 @@ Try
|
||||
StrDispose(TmpStr);
|
||||
TmpStr := Nil;
|
||||
Except
|
||||
Exception.Create('Tried to deallocate a nil string');
|
||||
On E: Exception Do
|
||||
Assert(False, Format('Trace:Could not deallocate string --> %S', [E.Message]));
|
||||
End;
|
||||
|
||||
End.
|
||||
Loading…
Reference in New Issue
Block a user