diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index 7b9955cc37..dbd2beb3f3 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -4,20 +4,6 @@ {$DEFINE ASSERT_IS_ON} {$ENDIF} - -// temp solution to fill msgqueue -function DeliverPostMessage(const Target: Pointer; var Message): Boolean; -begin -//writeln('delivermessage'); - if TObject(Target) is TWinControl - then begin - Result := PostMessage(TWinControl(Target).Handle, TLMessage(Message).Msg, TLMessage(Message).WParam, TLMessage(Message).LParam); - end - else begin - Result := DeliverMessage(TObject(Target), Message) = 0; - end; -end; - {*************************************************************} { callback routines } {*************************************************************} @@ -54,20 +40,9 @@ End; Function WindowProc(Window: HWnd; Msg: UInt; WParam: WParam; LParam: LParam): LResult; Var C: Cardinal; - CbObj: PObject; - Cls: PChar; - DataHandle: Handle; - DC: HDC; - I: Integer; List: TMsgArray; LMessage: TLMessage; - MsgColl: PList; - ObjCached: Boolean; OwnerObject: TObject; - PS: PaintStruct; - Pt: TPoint; - R: TRect; - Rec: PLazObject; WinProcess: Boolean; Begin Assert(False, 'Trace:WindowProc - Start'); @@ -79,10 +54,6 @@ Begin Assert(False, 'Trace:WindowProc - Getting Object With Callback Procedure'); OwnerObject := TObject(GetProp(Window, 'Lazarus')); Assert(False, 'Trace:WindowProc - Getting Callback Object'); - CbObj := GetProp(Window, 'CbObj'); - MsgColl := GetProp(Window, 'MsgColl'); - ObjCached := False; - Rec := LazObject; Assert(False, 'Trace:WindowProc - Checking Proc'); Assert(False, Format('Trace:WindowProc - Window Value: $%S; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), WM_To_String(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)])); @@ -470,1019 +441,6 @@ Begin Assert(False, 'Trace:WindowProc - Exit'); End; -{function Win32showCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMShowWindow; -begin - Result := True; - EventTrace('show', data); - Mess.Msg := LM_SHOWWINDOW; - Mess.Show := True; - - Result := DeliverMessage(Data, Mess) = 0; - end; - -function Win32HideCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMShowWindow; -begin - Result := True; - EventTrace('hide', data); - Mess.Msg := LM_SHOWWINDOW; - Mess.Show := False; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32activateCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('activate', data); - Mess.Msg := LM_ACTIVATE; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32changedCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('changed', data); - - Mess.Msg := LM_CHANGED; - Result := DeliverMessage(Data, Mess) = 0; -end; - -Function Win32changed_editbox( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('changed', data); - - Mess.Msg := CM_TEXTCHANGED; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32draw( Win32Control: PWin32Control; area : TRect; data: wPointer) : Boolean; cdecl; -var - Mess: TLMPaint; -begin - Result := True; - EventTrace('draw', data); - Mess.Msg := LM_PAINT; - Mess.DC := GetDC(THandle(Win32Control)); - Mess.Unused := 0; - - Result := DeliverPostMessage(Data, Mess); -// Result := DeliverMessage(Data, MSG) = 0; -end; - -function Win32FrmActivate(Control: PWin32Control; Event : Integer {TgdkEventFocus}; data: wPointer) : Boolean; cdecl; -var - Mess : TLMActivate; -begin - EventTrace('activate', data); - Mess.Msg := LM_ACTIVATE; - Result := DeliverPostMessage(Data, Mess); -end; - -function Win32FrmDeactivate( Control: PWin32Control; Event : Integer {TgdkEventFocus}; data: wPointer) : Boolean; cdecl; -var - Mess : TLMActivate; -begin - EventTrace('deactivate', data); - Mess.Msg := LM_DEACTIVATE; - Result := DeliverPostMessage(Data, Mess); -end; - -function Win32Map(Control: PWin32Control; Data: wPointer): Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('map', data); -end; - -function Win32configureevent( Win32Control: PWin32Control; {!}{event : PgdkEventConfigure;} data: wPointer) : Boolean; cdecl; -var - MessI : Integer; - DC : HDC; - Win32Control2 : PWin32Control; - PenColor : TColor; -begin - EventTrace('', data); - MessI := LM_CONFIGUREEVENT; - - //Get the widget owner because the 'fixed' widget called the signal - //create a pixmap for drawing behind the scenes - - //assign it to the object data for this widget so it's stored there - //Clear the canvas area - - MessI := LM_REDRAW; //Should I be sending the Draw event?????????? - TObject(data).Dispatch(MessI); - Assert(False, 'Trace:Exiting Configure'); -end; - -function Win32exposeevent( Win32Control: PWin32Control; {!}{event : PgdkEventExpose;} data: wPointer) : Boolean; cdecl; -var - - msg: TLMPaint; -begin - Result := True; - EventTrace('expose-event', data); - - msg.msg := LM_PAINT; - MSG.DC := GetDC(THandle(Win32Control)); - msg.Unused := 0; - - Result := DeliverPostMessage(Data, MSG); - -// Result := DeliverMessage(Data, msg) = 0; - -end; - -function Win32keydown( Win32Control: PWin32Control; {!}{event : pgdkeventkey;} data: wPointer) : Boolean; cdecl; -var - MessI : TLMKeyEvent; - -begin - EventTrace('key down', data); - MessI.msg := LM_KEYDOWN; -{!}// MessI.State := event^.state; -{!}// MessI.Key := Event^.KeyVal; -{!}// MessI.Length := Event^.Length; -// MessI.Str := Event^.String; - MessI.UserData := data; - Result := DeliverMessage(Data, MessI) = 0; - // TObject(data).Dispatch(MessI); -end; - -function Win32keyup( Win32Control: PWin32Control; {!}{event : pgdkEventKey;} data: wPointer) : Boolean; cdecl; -var - MessI : TLMKeyEvent; - -begin - EventTrace('Key Up', data); - MessI.msg := LM_KEYUP; -{!}// MessI.State := event^.state; -{!}// MessI.Key := Event^.KeyVal; -{!}// MessI.Length := Event^.Length; -// MessI.Str := Event^.String; - MessI.UserData := data; - - Result := DeliverMessage(Data, MessI) = 0; - // TObject(data).Dispatch(MessI); - end; - -function Win32KeyUpDown(Win32Control: PWin32Control; Event : PWin32KeyEvent; Data: Pointer) : Boolean; cdecl; -var - Msg: TLMKey; - KeyCode: Word; - Flags: Integer; - Toggle, Extended, SysKey: Boolean; -begin - GetWin32KeyInfo(Event, KeyCode, Msg.CharCode, SysKey, Extended, Toggle); -// Assert(False, Format('Trace:[GTKKeyUpDown] Type: %3:d, GTK: 0x%0:x(%0:d) LCL: 0x%1:x(%1:d) VK: 0x%2:x(%2:d)', [Event^.keyval, KeyCode, Msg.CharCode, Event^.theType])); - - Flags := 0; - - if Extended then Flags := KF_EXTENDED; - if SysKey then Flags := Flags or KF_ALTDOWN; - - - Msg.KeyData := $00000000; //TODO: OEM char - - // TODO: Get Win32 constants set up. - case Event^.theType of - - WIN32_KEY_RELEASE: // Key up - begin - EventTrace('key up', data); - if SysKey - then Msg.msg := LM_SYSKEYUP - else Msg.msg := LM_KEYUP; - - Flags := Flags or KF_UP or KF_REPEAT; - - Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {allways}; - Result := DeliverPostMessage(data, msg); - - end; - WIN32_KEY_PRESS: // Key press - begin - EventTrace('key down', data); - if SysKey - then Msg.msg := LM_SYSKEYDOWN - else Msg.msg := LM_KEYDOWN; - - // todo repeat - // Flags := Flags or KF_REPEAT; - - Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {TODO: repeatcount}; - Result := DeliverPostMessage(data, msg); - - if KeyCode <> $FFFF - then begin - EventTrace('char', data); - if SysKey then Msg.msg := LM_SYSCHAR - else Msg.msg := LM_CHAR; - Msg.CharCode := KeyCode; - Result := DeliverPostMessage(data, msg); - end; - end; - end; -end; - -function Win32focusCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -Var - Mess : TLMessage; -begin - EventTrace('focus', data); -// Writeln('Getting Focus...'); - //TODO: fill in old focus - Mess.msg := LM_SETFOCUS; - Assert(False, Format('Trace:TODO: [gtkfocusCB] %s finish', [TObject(Data).ClassName])); - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32KillFocusCB( Control: PWin32Control; event: Pointer {PGdkEventFocus}; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('killfocus', data); -// Writeln('Killing Focus...'); - Mess.msg := LM_KILLFOCUS; - //TODO: fill in new focus - Assert(False, Format('Trace:TODO: [gtkkillfocusCB] %s finish', [TObject(Data).ClassName])); - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32destroyCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess: TLMessage; - Info: PWinControlInfo; -begin - Result := True; - EventTrace('destroy', data); - Mess.msg := LM_DESTROY; - Result := DeliverMessage(Data, Mess) = 0; - - // NOTE: if the destroy message is posted - // we should post a info destroy message as well - Info := GetControlInfo(Win32Control, False); - if Info <> nil then Dispose(Info); -end; - -function Win32deleteCB( Control: PWin32Control; event : Pointer {PGdkEvent}; data : wPointer) : Boolean; cdecl; -var Mess : TLMessage; -begin - Mess.Msg:= LM_CLOSEQUERY; - { Message results : True - do nothing, False - destroy or hide window } - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32resizeCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; - -begin - EventTrace('resize', data); - Mess.Msg := LM_SIZE; - Result := DeliverMessage(Data, Mess) = 0; - // TObject(data).Dispatch(MessI); -end; - -// Commenting out until Win32 code for tracking motion is done. -{function GTKMotionNotify(widget:PGTKWidget; event: PGDKEventMotion; data: gPointer):GBoolean; cdecl; -var - Msg: TLMMouseMove; - ShiftState: TShiftState; -begin - - - ShiftState := GTKEventState2ShiftState(Event^.State); - with Msg do - begin - Msg := LM_MouseMove; - XPos := Round(Event^.X); - YPos := Round(Event^.Y); -// XPos := Trunc(Event^.X); -// YPos := trunc(Event^.Y); -{ Writeln('MOUSEMOVE Signal'); - Writeln('X = '); - Writeln(' '+inttostr(XPos)); - Writeln('Y = '); - Writeln(' '+inttostr(YPos)); - Writeln('X_root = '); - Writeln(' '+inttostr(round(Event^.X_Root))); - Writeln('Y_root = '); - Writeln(' '+inttostr(round(Event^.Y_Root))); - writeln('widget is ='+inttostr(longint(widget))); - if (TObject(data) is TCOntrol) then - writeln('Control is ='+TControl(data).classname); - Writeln('------------------'); - } - Keys := 0; - if ssShift in ShiftState then Keys := Keys or MK_SHIFT; - if ssCtrl in ShiftState then Keys := Keys or MK_CONTROL; - if ssLeft in ShiftState then Keys := Keys or MK_LBUTTON; - if ssRight in ShiftState then Keys := Keys or MK_RBUTTON; - if ssMiddle in ShiftState then Keys := Keys or MK_MBUTTON; - end; - Result := DeliverPostMessage(Data, Msg); - - //if ssLeft in ShiftState then WriteLN(Format('[GTKMotionNotify] widget: 0x%p', [widget])); - - if (Pointer(MCaptureHandle) <> widget) - and (MCaptureHandle <> 0) - then WriteLN(Format('[GTKMotionNotify] Capture differs --> cap:0x%x gtk:0x%p', [MCaptureHandle, gtk_grab_get_current])); -end;} - -function Win32MouseBtnPress( Win32Control: PWin32Control; {!}{event : pgdkEventButton;} data: wPointer) : Boolean; cdecl; -var - MessI : TLMMouseEvent; -begin - EventTrace('Mouse button Press', data); - MessI.Msg := LM_LBUTTONDOWN; - MessI.Button := -1; - MessI.WheelDelta:= 0; -{!}// MessI.State := Event^.State; -{!}// MessI.X := Trunc(Event^.X); -{!}// MessI.Y := trunc(Event^.Y); - MessI.UserData := Data; -{!}// case event^.Button of -{!}// 1 : -{!}// MessI.Button := 0; -{!}// 2 : -{!}// MessI.Button := 2; -{!}// 3 : -{!}// MessI.Button := 1; -{!}// 4 : -{!}// begin -{!}// MessI.Msg := LM_MOUSEWHEEL; -{!}// MessI.WheelDelta:=1; -{!}// end; -{!}// 5 : -{!}// begin -{!}// MessI.Msg := LM_MOUSEWHEEL; -{!}// MessI.WheelDelta:=-1; -{!}// end; -{!}// end; - TObject(data).Dispatch(MessI); -end; - -function Win32MouseBtnRelease( Win32Control: PWin32Control; {!}{event : pgdkEventButton;} data: wPointer) : Boolean; cdecl; -var - MessI : TLMMouseEvent; - -begin - EventTrace('Mouse button release', data); - MessI.Msg := LM_LBUTTONUP; - MessI.Button := -1; - MessI.WheelDelta:= 0; -{!}// MessI.State := Event^.State; -{!}// MessI.X := Trunc(Event^.X); -{!}// MessI.Y := trunc(Event^.Y); - MessI.UserData := Data; -{!}// case event^.Button of -{!}// 1 : -{!}// MessI.Button := 0; -{!}// 2 : -{!}// MessI.Button := 2; -{!}// 3 : -{!}// MessI.Button := 1; -{!}// end; - TObject(data).Dispatch(MessI); -end; - -function Win32clickedCB( OwnerObject: Pointer; AMessage, wParam, lParam: LongInt) : Boolean; cdecl; -var - MessI : Integer; - -begin - Assert(False, 'Trace:Callback Function - Win32clickedCB'); - EventTrace('clicked', OwnerObject); - MessI := LM_CLICKED; - TObject(OwnerObject).Dispatch(MessI); -end; - -function Win32DialogOKclickedCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -Type - TCustomColors = Array[1..16] Of COLORREF; -var - theDialog : TCommonDialog; - Fpointer : Pointer; - colorArray : array[0..2] of double; - colorsel : TChooseColor; - newColor : COLORREF; - FontName : String; - OpenFile: OpenFileName; - CustomColors: TCustomColors; - RGBIO: DWORD; - FontSel: TChooseFont; - LF: TLogFont; - Col: TGDIRGB; -Const - Filter: PChar = 'All Files'#0'*.*'#0#0; -begin - Result := True; - theDialog := TCommonDialog(data); - FPointer := Pointer(theDialog.Handle); - if theDialog is TFileDialog then - begin - ZeroMemory(@OpenFile, SizeOf(OpenFile)); - With OpenFile Do - Begin - LStructSize := SizeOf(OpenFile); - HWNDOwner := Win32Control^.Window; - LPStrFilter := Filter; - NMaxFile := MAX_PATH; - Flags := OFN_Explorer Or OFN_AllowMultiSelect Or OFN_CreatePrompt Or OFN_HideReadOnly Or OFN_OverwritePrompt; - End; - - If Not GetOpenFileName(@OpenFile) Then - Assert(False, 'ERROR: [Win32DialogOKclickedCB] got unopenable file'); - TFileDialog(data).FileName := OpenFile.LPStrFile; - end - else if theDialog is TColorDialog then - begin - ZeroMemory(@colorsel, SizeOf(colorsel)); - With colorsel Do - Begin - LStructSize := SizeOf(colorsel); - HWNDOwner := Win32Control^.Window; - RGBResult := RGBIO; - LPCustColors := LPDWORD(@CustomColors); - Flags := CC_FULLOPEN Or CC_RGBINIT; - End; - If Not ChooseColor(@colorsel) Then - Assert(False, 'ERROR: [Win32DialogOKclickedCB] got invalid color'); - Col.red := GetRValue(colorsel.RGBResult); - Col.green := GetGValue(colorsel.RGBResult); - Col.blue := GetBValue(colorsel.RGBResult); - - TColorDialog(theDialog).Color := TColor(Col); - end - else if theDialog is TFontDialog then - begin - Assert(False, 'Trace:Prssed OK in FontDialog'); - ZeroMemory(@FontSel, SizeOf(FontSel)); - With FontSel Do - Begin - LStructSize := SizeOf(FontSel); - HWNDOwner := Win32Control^.Window; - LPLogFont := @LF; - Flags := CF_InitToLogFontStruct Or CF_ScreenFonts Or CF_Effects Or CF_ForceFontExist; - End; - - // FontName := gtk_font_selection_dialog_get_font_name(pgtkfontselectiondialog(FPointer)); - TFontDialog(theDialog).FontName := FontSel.LPLogFont^.LFFaceName; - Assert(False, 'Trace:-----'+TFontDialog(theDialog).FontName+'----'); - end; - { -// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle)); - if theDialog is TFileDialog then - begin - TFileDialog(data).FileName := gtk_file_selection_get_filename(PGtkFileSelection(FPointer)); - end - else if theDialog is TColorDialog then - begin - colorSel := GTK_COLOR_SELECTION((GTK_COLOR_SELECTION_DIALOG(FPointer))^.colorsel); - gtk_color_selection_get_color(colorsel, @colorArray[0]); - newColor.pixel := 0; - newColor.red := Trunc(colorArray[0] * $FFFF); - newColor.green := Trunc(colorArray[1] * $FFFF); - newColor.blue := Trunc(colorArray[2] * $FFFF); - - TColorDialog(theDialog).Color := TGDKColorToTColor(newcolor); - end - else if theDialog is TFontDialog then - begin - Assert(False, 'Trace:Prssed OK in FontDialog'); - FontName := gtk_font_selection_dialog_get_font_name(pgtkfontselectiondialog(FPointer)); - TFontDialog(theDialog).FontName := FontName; - Assert(False, 'Trace:-----'+TFontDialog(theDialog).FontName+'----'); - end;} - - theDialog.UserChoice := mrOK; -end; - -function Win32DialogCancelclickedCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - theDialog : TCommonDialog; -begin - Result := True; - theDialog := TCommonDialog(data); - if theDialog is TFileDialog then - begin - TFileDialog(data).FileName := ''; - end; - theDialog.UserChoice := mrCancel; -end; - -function Win32DialogDestroyCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - theDialog : TCommonDialog; -begin - Result := True; - theDialog := TCommonDialog(data); -// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle)); - { if theDialog is TFileDialog then - begin - TFileDialog(data).FileName := ''; - end; -} - theDialog.UserChoice := -1; -end; - -function Win32pressedCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('pressed', data); - Mess.msg := LM_PRESSED; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32enterCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('enter', data); - Mess.msg := LM_ENTER; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32leaveCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('leave', data); - Mess.msg := LM_LEAVE; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32movecursorCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - Result := True; - EventTrace('move-cursor', data); - Mess.msg := LM_MOVECURSOR; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32size_allocateCB( Win32Control: PWin32Control; {!}{size :pGtkAllocation;} data: wPointer) : Boolean; cdecl; -var -MessI : Integer; -msg : TLMResize; -begin - EventTrace('size-allocate', data); - MessI := LM_WINDOWPOSCHANGED; - msg.msg := MessI; -{!}// Msg.Left := Size^.X; -{!}// Msg.Top := Size^.Y; -{!}// Msg.Width := Size^.width; -{!}// Msg.Height := Size^.height; - Msg.Userdata := Data; - TObject(data).Dispatch(msg); -end; - -function Win32switchpage(Control: PWin32Control; page: PWin32Control; pagenum : integer; data: wPointer) : Boolean; cdecl; -var - Mess : TLMNotify; - T : tagNMHDR; -begin - Result := True; - EventTrace('switch-page', data); - Mess.Msg := LM_NOTIFY; - //this is the - T.code := TCN_SELCHANGE;//(0-550)-1; - T.hwndfrom := longint(Control); - T.idfrom := pagenum; //use this to set pageindex to the correct page. - Mess.NMHdr := @T; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32releasedCB( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMEssage; -begin - Result := True; - EventTrace('released', data); - Mess.msg := LM_RELEASED; - Result := DeliverMessage(Data, Mess) = 0; -end; - -function Win32InsertText( Win32Control: PWin32Control; char : pChar; NewTextLength : Integer; {!}{Position : pgint;} data: wPointer) : Boolean; cdecl; -var - MessI : Integer; - Msg : TLMInsertText; - I : Integer; -begin - EventTrace('Insert Text', data); - MessI := LM_INSERTTEXT; - - Msg.Msg := MessI; - Msg.NewText := ''; - For I := 1 to NewTextLength do - Msg.NewText := Msg.Newtext+Char[i-1]; -// Msg.NewText := String(Char); - Msg.Length := NewTextLength; -{!}// Msg.Position := Position^; - Msg.Userdata := data; - Result := DeliverMessage(Data, Msg) = 0; -end; - -function Win32DeleteText( Win32Control: PWin32Control; Startpos, EndPos : Integer; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Delete Text', data); - Mess.msg := LM_DELETETEXT; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32SetEditable( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Set Editable', data); - Mess.msg := LM_SETEDITABLE; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32MoveWord( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Move Word', data); - Mess.msg := LM_MOVEWORD; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32MovePAge( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Move Page', data); - Mess.msg := LM_MOVEPAGE; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32MoveToRow( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Move To Row!!', data); - Mess.msg := LM_MOVETOROW; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32MoveToColumn( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('MoveToColumn', data); - Mess.msg := LM_MOVETOCOLUMN; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32KillChar( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Kill Char', data); - Mess.msg := LM_KILLCHAR; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32KillWord( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Kill Word', data); - Mess.msg := LM_KILLWORD; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32KillLine( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Kill Line', data); - Mess.msg := LM_KILLLINE; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32CutToClip( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Cut to clip', data); - Mess.msg := LM_CUTTOCLIP; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32CopyToClip( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Copy to Clip', data); - Mess.msg := LM_COPYTOCLIP; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32PasteFromClip( Win32Control: PWin32Control; data: wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Paste from clip', data); - Mess.msg := LM_PASTEFROMCLIP; - Result:= DeliverMessage(Data, Mess) = 0; -end; - -function Win32MoveResize( Win32Control: PWin32Control; X, Y, Width, Height : PInteger; data: wPointer) : Boolean; cdecl; -var -MessI : Integer; -msg : TLMResize; -begin - EventTrace('size-allocate', data); - MessI := LM_USER + 29 {LM_MOVERESIZE}; - msg.msg := MessI; -{!}// Msg.Left := X^; -{!}// Msg.Top := Y^; -{!}// Msg.Width := Width^; -{!}// Msg.Height := Height^; - Msg.Userdata := Data; - - TObject(data).Dispatch(msg); -end; - -function Win32valuechanged ( Control: PWin32Control; data : wPointer) : Boolean; cdecl; -var - Mess : TLMessage; -begin - EventTrace('Value changed', data); - Mess.msg := LM_CHANGED; - Result := DeliverMessage(Data, Mess) = 0; -end; - -{ - Directly call the Timer function of the TTimer object. - (As far as I know this can't be dispatched like it's done in the other callbacks!) -} -function Win32TimerCB (data : wPointer) : Integer; cdecl; -var - P : ^TTimer; -begin - EventTrace('timer', data); - P := @data; - {$IFDEF VER1_1} - P^.Timer(TTimer(data)); - {$ELSE} - Assert(False, 'TRACE: Cannot dispatch timer in Win32TimerCB'); - {$ENDIF} - result := 1; { returning 0 would stop the timer, 1 will restart it } -end; - -function Win32FocusInNotifyCB (Control: PWin32Control; event : Pointer {PGdkEvent}; data : wpointer) : Boolean; cdecl; -var - MessI : TLMEnter; -begin - EventTrace ('FocusInNotify (alias Enter)', data); - MessI.msg := LM_Enter; - Result:= DeliverMessage(Data, MessI) = 0; -end; - -function Win32FocusOutNotifyCB (Control: PWin32Control; event : Pointer {PGdkEvent}; data : wpointer) : Boolean; cdecl; -var - MessI : TLMExit; -begin - EventTrace ('FocusOutNotify (alias Exit)', data); - MessI.msg := LM_Exit; - Result:= DeliverMessage(Data, MessI) = 0; -end; - -{ - Msg : Cardinal; - ScrollCode : SmallInt; - Pos : SmallInt; - ScrollBar : HWND; - Result : LongInt; -} - -function Win32HScrollCB(Scroll: PHandle; data: wPointer): Boolean; cdecl; -var - Msg: TLMHScroll; - OldValue, - V, U, L, - StepI, PageI, Page: Integer; - //Scroll: PGTKHScrollBar; - X, Y: Integer {GInt}; - Mask: Handle {TGdkModifierType}; - SI: TAGSCROLLINFO; - R: Windows.RECT; -begin - //Assert(False, Format('Trace:[GTKHScrollCB] Value: %d', [Round(Adjustment^.Value)])); - - ZeroMemory(@SI, SizeOf(SI)); - With SI Do - Begin - CBSize := SizeOf(SCROLLINFO); - FMask := SIF_PAGE Or SIF_POS Or SIF_RANGE Or SIF_TRACKPOS; - GetScrollInfo(Scroll^, SB_CTL, SI); - OldValue := nPos; - L := nMin; - U := nMax; - StepI := nPos; - PageI := nTrackPos; - Page := nPage; - End; - - {OldValue := Integer(gtk_object_get_data(PGTKObject(Adjustment), 'OldValue')); - gtk_object_set_data(PGTKObject(Adjustment), 'OldValue', Pointer(Round(Adjustment^.Value))); - Scroll := gtk_object_get_data(PGTKObject(Adjustment), 'ScrollBar'); - - // Get rounded values - with Adjustment^ do - begin - V := Round(Value); - U := Round(Upper); - L := Round(Lower); - StepI := Round(Step_Increment); - PageI := Round(Page_Increment); - Page := Round(Page_Size); - end;} - - // get keystates - if Scroll <> nil - then //gdk_window_get_pointer(PGTKWidget(Scroll)^.Window, @X, @Y, @Mask); - Windows.GetClientRect(Scroll^, @R); - X := R.Right - R.Left; - Y := R.Top - R.Bottom; - - with Msg do - begin - msg := LM_HSCROLL; - // Get scrollcode - //if ssLeft in GTKEventState2ShiftState(Mask) - if StepI - U >= 0 - then ScrollCode := SB_THUMBTRACK - else if V - OldValue = StepI - then ScrollCode := SB_LINERIGHT - else if OldValue - V = StepI - then ScrollCode := SB_LINELEFT - else if V - OldValue = PageI - then ScrollCode := SB_PAGERIGHT - else if OldValue - V = PageI - then ScrollCode := SB_PAGELEFT - else if V >= U - then ScrollCode := SB_ENDSCROLL - else ScrollCode := SB_THUMBPOSITION; - Pos := V; - ScrollBar := HWND(Scroll^); - end; - Result := DeliverMessage(Data, Msg) = 0; -end; - -function Win32VScrollCB(Scroll: PHandle; data: wPointer): Boolean; cdecl; -var - Msg: TLMVScroll; - OldValue, - V, U, L, - StepI, PageI, Page: Integer; - //Scroll: PGTKHScrollBar; - X, Y: Integer {GInt}; - Mask: Integer {TGdkModifierType}; - SI: TAGSCROLLINFO; - R: Windows.RECT; -begin - //Assert(False, Format('Trace:[GTKVScrollCB] Value: %d', [Round(Adjustment^.Value)])); - - ZeroMemory(@SI, SizeOf(SI)); - With SI Do - Begin - CBSize := SizeOf(SCROLLINFO); - FMask := SIF_PAGE Or SIF_POS Or SIF_RANGE Or SIF_TRACKPOS; - GetScrollInfo(Scroll^, SB_CTL, SI); - OldValue := nPos; - L := nMin; - U := nMax; - StepI := nPos; - PageI := nTrackPos; - Page := nPage; - End; - - {OldValue := Integer(gtk_object_get_data(PGTKObject(Adjustment), 'OldValue')); - gtk_object_set_data(PGTKObject(Adjustment), 'OldValue', Pointer(Round(Adjustment^.Value))); - Scroll := gtk_object_get_data(PGTKObject(Adjustment), 'ScrollBar'); - - // Get rounded values - with Adjustment^ do - begin - V := Round(Value); - U := Round(Upper); - L := Round(Lower); - StepI := Round(Step_Increment); - PageI := Round(Page_Increment); - Page := Round(Page_Size); - end;} - - // get keystates - if Scroll <> nil - then //gdk_window_get_pointer(PGTKWidget(Scroll)^.Window, @X, @Y, @Mask); - Windows.GetClientRect(Scroll^, @R); - X := R.Right - R.Left; - Y := R.Top - R.Bottom; - - with Msg do - begin - msg := LM_VSCROLL; - // Get scrollcode - //if ssLeft in GTKEventState2ShiftState(Mask) - if StepI - U >= 0 - then ScrollCode := SB_THUMBTRACK - else if V - OldValue = StepI - then ScrollCode := SB_LINERIGHT - else if OldValue - V = StepI - then ScrollCode := SB_LINELEFT - else if V - OldValue = PageI - then ScrollCode := SB_PAGERIGHT - else if OldValue - V = PageI - then ScrollCode := SB_PAGELEFT - else if V >= U - then ScrollCode := SB_ENDSCROLL - else ScrollCode := SB_THUMBPOSITION; - Pos := V; - ScrollBar := HWND(Scroll^); - end; - Result := DeliverMessage(Data, Msg) = 0; -end; - -{------------------------------------------------------------------------------ - Function: GTKKeySnooper - Params: Widget: The widget for which this event is fired - Event: The keyevent data - FuncData: the user parameter passed when the snooper was installed - Returns: True if other snoopers shouldn't handled - - Keeps track of which keys are pressed. The keycode is casted to a pointer and - if it exists in the KeyStateList, it is pressed. - ------------------------------------------------------------------------------} -function Win32KeySnooper(Win32Control: PWin32Control; Event: PWin32KeyEvent; FuncData: wPointer): Int; cdecl; -type - PList = ^TList; -var - Msg: TLMKey; - KeyCode, VirtKeyCode: Word; - ListCode: Integer; - Toggle, Extended, SysKey: Boolean; -begin - GetWin32KeyInfo(Event, KeyCode, VirtKeyCode, SysKey, Extended, Toggle); - with Event^ do - begin - if VirtKeyCode = VK_UNKNOWN - then ListCode := KEYMAP_VKUNKNOWN and KeyCode - else ListCode := VirtKeyCode; - if Extended then ListCode := ListCode or KEYMAP_EXTENDED; - - case theType of - WIN32_KEY_PRESS: - begin - if PList(FuncData)^.IndexOf(Pointer(ListCode)) = -1 - then begin - PList(FuncData)^.Add(Pointer(ListCode)); - if Toggle then PList(FuncData)^.Add(Pointer(ListCode or KEYMAP_TOGGLE)); - end - else WriteLn(Format('WARNING: [GTKKeySnooper] Pressed key (0x%x) already pressed (LC=0x%x)', [KeyCode, ListCode])); - end; - WIN32_KEY_RELEASE: - begin - if PList(FuncData)^.Remove(Pointer(ListCode)) = -1 - then WriteLn(Format('WARNING: [GTKKeySnooper] Released key (0x%x) not pressed (LC=0x%x)', [KeyCode, ListCode])); - // just remove the togglekey if present - if not Toggle then PList(FuncData)^.Remove(Pointer(ListCode or KEYMAP_TOGGLE)); - end; - else - WriteLn(Format('ERROR: [GTKKeySnooper] Got unknown event %d', [Integer(theType)])); - end; - - - Assert(False, Format('trace:' + -// WriteLN(Format( - '[GTKKeySnooper] Type %d, window $%x, send_event %d, time %d, state %d, keyval %d, length %d, string %s', - [ Integer(thetype), Integer(window), send_event, time, state, keyval, Event^.length, thestring]) - ); - end; - Result := 0; -end;} - {$IFDEF ASSERT_IS_ON} {$UNDEF ASSERT_IS_ON} {$C-} @@ -1490,6 +448,9 @@ end;} { $Log$ + Revision 1.11 2002/04/03 01:52:42 lazarus + Keith: Removed obsolete code, in preperation of a pending TWin32Object cleanup + Revision 1.10 2002/02/07 08:35:12 lazarus Keith: Fixed persistent label captions and a few less noticable things diff --git a/lcl/interfaces/win32/win32listsl.inc b/lcl/interfaces/win32/win32listsl.inc index 48d530be8b..7db11912de 100644 --- a/lcl/interfaces/win32/win32listsl.inc +++ b/lcl/interfaces/win32/win32listsl.inc @@ -101,8 +101,6 @@ End; Function TWin32ListStringList.Get(Index: Integer): String; Var Item: PChar; - ALabel: HWND; - ListItem: HWND; Begin If (Index < 0) Or (Index >= Count) Then Raise Exception.Create('Out of bounds.') @@ -156,8 +154,6 @@ End; ------------------------------------------------------------------------------} Procedure TWin32ListStringList.Insert(Index: Integer; Const S: String); -Var - Li: HWND; Begin If GetCount <> 0 Then FSender.Height := (FSender.Height + (FSender.Height Div GetCount)); @@ -304,15 +300,6 @@ End; ------------------------------------------------------------------------------} Procedure TWin32CListStringList.Insert(Index: Integer; Const S: String); -Type - TCSArr = Record - Arr: Array[0..15] Of PChar; - Str: Array[0..0] Of Char; - End; -Var - CS: ^TCSArr; - CSize: Integer; - K: Integer; Begin SendMessage(FWin32CList, LB_INSERTSTRING, Index, LPARAM(PChar(S))); End; @@ -337,6 +324,9 @@ End; { ============================================================================= $Log$ + Revision 1.5 2002/04/03 01:52:42 lazarus + Keith: Removed obsolete code, in preperation of a pending TWin32Object cleanup + Revision 1.4 2002/02/04 10:54:33 lazarus Keith: * Fixes for Win32 diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 958cce5c2a..48f23b79bd 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -27,8 +27,6 @@ End; Destructor for the class. ------------------------------------------------------------------------------} Destructor TWin32Object.Destroy; -Var - I: Integer; Begin Assert(False, 'Trace:TWin32Object is being destroyed'); FMessageQueue.Free; @@ -50,8 +48,6 @@ End; ------------------------------------------------------------------------------} Procedure TWin32Object.Init; Var - AMessage: Msg; - HWindow: HWnd; LogBrush: TLOGBRUSH; Begin Assert(False, 'Trace:Win32Object.Init - Start'); @@ -157,13 +153,9 @@ End; ------------------------------------------------------------------------------} Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer); Var - Handle, HOwner, Wnd: HWnd; - I: Integer; - P: Pointer; + Handle, HOwner: HWnd; R: TRect; - TbBI: TBBUTTONINFO; TCI: TC_ITEM; - PLabel: PChar; Const TermChar: PChar = #0#0; Begin @@ -174,9 +166,7 @@ Begin Handle := (Sender As TWinControl).Handle; HOwner := GetAncestor(Handle, GA_ROOTOWNER); - P := Pointer(Handle); - Wnd := PWin32Control(@Sender)^.Window; - Assert(P = Nil, 'Trace:WARNING: [TWin32Object.SetLabel] --> Got nil pointer'); + Assert(Handle = 0, 'Trace:WARNING: [TWin32Object.SetLabel] --> Got NULL handle'); Assert(False, 'Trace:Setting the label in TWin32Object.SetLabel'); Case TControl(Sender).FCompStyle Of @@ -234,95 +224,6 @@ Begin End; End; -{------------------------------------------------------------------------------ - Method: TWin32Object.IntSendMessage - Params: LM_Message - Message Sent - CompStyle - Component Style - P - Generic out parameter - Val1 - Message-dependant value - Str1 - Result output string - Returns: Nothing - - Obsolete message processing method (superseded by IntSendMessage3) --------------------------------------------------------------------------------} -Procedure TWin32Object.IntSendMessage(LM_Message: Integer; CompStyle: Integer; Var P: Pointer; Val1: Integer; Var Str1: String); -Var - Obj: TObject; -Begin - Assert(False, 'Trace:IntSendMessage - Start, Received (' + LM_To_String(LM_Message) + ')'); - Obj := TObject.Create; - TWinControl(Obj).fCompStyle := CompStyle; - Str1 := IntToStr(IntSendMessage3(LM_Message, Obj, P)); - {Case LM_Message of - //LM_SetLabel : SetLabel(CompStyle, P, Str1); - LM_GetLabel : Str1 := GetLabel(CompStyle,P); - Else - Assert(False, 'Trace:IntSendMessage - ERROR DETECTED - The message sent was invalid -'+Inttostr(LM_Message)); - End; {Case}} - Obj.Free; - Assert(False, 'Trace:IntSendMessage - Exit'); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.IntSendMessage2 - Params: LM_Message - Message sent - Parent - Parent of control - Child - Target child of parent - Data - Pointer to message-dependant data (can be Nil) - Returns: A message-dependant integer result - - Obsolete message processing method (superseded by IntSendMessage3) - ------------------------------------------------------------------------------} -Function TWin32Object.IntSendMessage2(LM_Message: Integer; Parent, Child, Data: Pointer): Integer; -Var - Obj: TObject; - R: TRect; -Begin - Assert(False, 'Trace:IntSendMessage2 - Start, Received (' + LM_To_String(LM_Message) + ')'); - Obj := TObject(Child); - TWinControl(Obj).Parent := TWinControl(Parent); - Result := IntSendMessage3(LM_Message, Obj, Data); - {case LM_Message of - LM_SetSize : Begin - Assert(False, 'Trace:IntSendMessage2 - Resizing a control'); -{!}// R := pTRect(Data)^; -{!}// ResizeChild(Parent,Child,pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom); - End; - LM_AssignSelf : AssignSelf(Child,Data); - LM_SetName : SetName(Child,Data); - LM_AddPage : AddNBPage(Parent, Child, Integer(Data)); - LM_RemovePage : RemoveNBPage(Parent, Child, Integer(Data)); - LM_ShowTabs : ; - LM_SetTabPosition : Begin - End; - End; {Case} - -// START These messages were added by Michal Bukovjan - -{!}// If TObject(Parent) is TControl then - Case LM_Message of - LM_GETITEMS : Begin - End; - LM_GETTEXT : Begin - End; - LM_GETITEMINDEX : Begin - End; - LM_SETITEMINDEX : Begin - End; - LM_GETSELSTART : Begin - End; - LM_GETSELLEN : Begin - End; - LM_GETLIMITTEXT : Begin - End; - LM_GETSELCOUNT : Begin - End; - LM_GETSEL : Begin - End; - End; {Case}} - Assert(False, 'Trace:IntSendMessage2 - Exit'); -End; - {------------------------------------------------------------------------------ Method: TWin32Object.IntSendMessage3 Params: LM_Message - message to be processed @@ -337,23 +238,17 @@ End; ------------------------------------------------------------------------------} Function TWin32Object.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; Var - AOwner: TControl; Bitmap: HBITMAP; // Pixel map type image - Box1, Control, Handle, ListItem, PLabel: HWND; CBI: COMBOBOXINFO; DC: HDC; + Handle: HWND; I, Num: Integer; ListItemIndex: TListItem; LVI: LV_ITEM; PStr, PStr2: PChar; R, R2: TRECT; - SData: String; SelectionMode: DWORD; // currently only used for listboxes TBB: Array[0..1] Of TBBUTTON; // Limited to 2 buttons at present - { Soon-to-be-obsolete vars (do not use) } - AParent: TWinControl; // only used twice, replace with typecasts! - GList: Pointer; // Only used for listboxes, replace with control!!!!! - PixmapWid: HWND; // Pixmap HWND; possibly replace with pixmap!!!! Begin Result := 0; //default value just in case nothing sets it Assert(False, 'Trace:IntSendMessage3 - Start, Received (' + GetMessageName(LM_Message) + ')'); @@ -411,11 +306,10 @@ Begin End Else Begin - AParent := (Sender as TWinControl).Parent; With (Sender As TWinControl) Do Begin Assert(False, Format('Trace:[TWin32Object.IntSendMessage3] %S --> Calling Add Child: %S', [Parent.ClassName, ClassName])); - AddChild(Parent.Handle, Handle, Parent.Left, Parent.Top); + AddChild(Parent.Handle, Handle); End; End; End; @@ -722,23 +616,11 @@ activate_time : the time at which the activation event occurred. Begin If (Sender as TControl).fCompStyle = csCListBox Then Begin - Control := GetCoreChildControl(Handle); Data := TWin32CListStringList.Create(Handle); Result := Integer(Data); End Else Begin - Case (Sender as TControl).FCompStyle Of - csComboBox: - Begin - GetComboBoxInfo(Handle, @CBI); - Control := CBI.hwndList; - End; - csListBox: - Control := GetCoreChildControl(Handle); - Else - Raise Exception.Create('Message LM_GETITEMS - Not implemented'); - End; Data := TWin32ListStringList.Create(Handle{Control}); Result := Integer(Data); End; @@ -841,7 +723,6 @@ activate_time : the time at which the activation event occurred. Begin If ((Sender As TWinControl).FCompStyle = csListBox) Or ((Sender As TControl).FCompStyle = csCListBox) then Begin - ListItem := IntSendMessage3(LM_GETITEMINDEX, Sender, Data); Result := Windows.SendMessage(Handle, LB_GETSEL, WParam(Data), 0); End End; @@ -922,23 +803,8 @@ End; ------------------------------------------------------------------------------} Procedure TWin32Object.SetCallback(Msg: LongInt; Sender: TObject); Var - GSignal: PChar; - I: Integer; List: TMsgArray; - LMessage: TLMessage; - LPar: LParam; - Mess: UINT; - MessFunc: CallbackProcedure; - MsgCached: Boolean; - MsgColl: TList; - ObjCached: Boolean; - PrevWndProc: LongInt; - Rec: PLazObject; - Signal: String; - SignalFunc: Pointer; - WinObject: HWND; Window: HWnd; - WPar: WParam; Begin Assert(False, 'Trace:TWin32Object.SetCallback - Start'); Assert(False, Format('Trace:TWin32Object.SetCallback - Class Name --> %S', [Sender.ClassName])); @@ -949,7 +815,6 @@ Begin Window := (Sender As TCustomForm).Handle Else Window := (Sender as TWinControl).Handle; - Signal := ''; {$IFDEF VER1_1} List := TMsgArray(GetProp(Window, 'MsgList')); @@ -972,8 +837,6 @@ End; Procedure TWin32Object.RemoveCallbacks(Sender: TObject); Var List: TMsgArray; - Rec: PLazObject; - MsgColl: PList; Window: HWnd; Begin If Sender Is TControlCanvas Then @@ -1301,7 +1164,6 @@ Const Var CC: TChooseColor; CF: TChooseFont; - FN: String; LF: LogFont; OpenFile: OpenFileName; Ret: Boolean; @@ -1436,14 +1298,12 @@ End; ------------------------------------------------------------------------------} Procedure TWin32Object.SetCursor(Sender: TObject); Var - Child: HWND; Cursor: PChar; Res: HCURSOR; Begin Assert(False, 'Trace:TWin32Object.SetCursor - Start'); Assert(False, Format('Trace:TWin32Object.SetCursor - Sender --> %S', [Sender.ClassName])); Assert(False, 'Trace:TWin32Object.SetCursor - Getting the window'); - //Child := (Sender As TWinControl).Handle; Assert(False, 'Trace:TWin32Object.SetCursor - Getting the cursor'); Cursor := MakeIntResource(Word(Integer(((Sender As TControl).Cursor)))); Assert(False, 'Trace:TWin32Object.SetCursor - Loading the cursor'); @@ -1464,7 +1324,6 @@ Procedure TWin32Object.ResizeChild(Sender: TObject; Left, Top, Width, Height: In Var DC: HDC; Handle: HWND; - R: TRect; TM: TEXTMETRICA; Begin Handle := (Sender As TWinControl).Handle; @@ -1477,31 +1336,21 @@ Begin End; If Handle <> HWND(Nil) Then MoveWindow(Handle, Left, Top, Width, Height, True) - {Else - Begin - GetClientRect(Handle, R); - MoveWindow(Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, True); - End;} End; {------------------------------------------------------------------------------ Method: TWin32Object.AddChild Params: Parent - Parent to which the child will be added Child - Child to add - Left, Top - The X and Y coordinates of the new child Returns: Nothing Adds A Child to a Parent ------------------------------------------------------------------------------} -Procedure TWin32Object.AddChild(Parent, Child: HWND; Left, Top: Integer); -Var - R: TRect; +Procedure TWin32Object.AddChild(Parent, Child: HWND); Begin Assert(False, 'Trace:AddChild - Parent Window Handle is $' + IntToHex(LongInt(Parent), 8)); Assert(False, 'Trace:AddChild - Child Window Handle is $' + IntToHex(LongInt(Child), 8)); SetParent(Child, Parent); - //GetClientRect(Parent, R); - //MoveWindow(Child, Left, Top, R.Right - Left, R.Bottom - Top, True); End; {------------------------------------------------------------------------------ @@ -1519,8 +1368,6 @@ End; Procedure TWin32Object.SetText(Window: HWND; Data: Pointer); Type PMsg = ^TLMSetControlText; -Var - Num: Integer; Begin Case PMsg(Data)^.FCompStyle Of csStatusBar: @@ -1570,33 +1417,21 @@ End; Tells Windows to create a control ------------------------------------------------------------------------------} Procedure TWin32Object.CreateComponent(Sender: TObject); -Type - PLMNotebookEvent = ^TLMNotebookEvent; - TCustomColors = Array[1..16] Of ColorRef; Var AccelIndex: Byte; - AItems: TMenuItem; AProcess: TProcess; - Bottom, CompStyle, I, J, K, Left, Right, Top: Integer; - Buddy, Handle, ParentWindow, Window: HWnd; + Buddy, Handle, Window: HWnd; Caption : String; - ColorSelect: TChooseColor; - CustomColors: TCustomColors; + CompStyle, I, J, K, Left, Top: Integer; DC: HDC; - Flags, RGBIO: DWord; + Flags: DWord; Height, Width: Integer; - MnuIdx: Cardinal; - OpenFile: OpenFileName; Parent: HWND; - ParentControl: TObject; PStr, StrTemp: PChar; R: TRect; TCI: TC_ITEM; Const BitsPerPixel: Array[Boolean] Of Cardinal = (3, 1); - Ext: PChar = 'txt'; - Filter: PChar = 'Pascal Files (*.pas)'#0'*.pas'#0'All Files(*.*)'#0'*.*'#0#0; - StFl: PChar = #0''; Begin Assert(False, 'Trace:CreateComponent - Start'); Assert(False, 'Trace:CreateComponent - Value of Sender is $' + IntToHex(LongInt(Sender), 8)); @@ -1690,22 +1525,11 @@ Begin csButton: Begin Assert(False, 'Trace:CreateComponent - Creating Button'); - Assert(False, 'Trace:CreateComponent - Value of Button Parent is $' + IntToHex(LongInt((Sender as TControl).Parent), 8)); - Assert(False, 'Trace:CreateComponent - Value of Button Owner is $' + IntToHex(LongInt((Sender as TControl).Owner), 8)); - ParentControl := (Sender As TControl).Owner; - Assert(False, 'Trace:CreateComponent - Value of ParentControl is $' + IntToHex(LongInt(ParentControl), 8)); - Assert(False, 'Trace:CreateComponent - Value of Button Parent Window is $' + IntToHex(LongInt(ParentWindow), 8)); - Assert(False, 'Trace:CreateComponent - Value of Button Left is $' + IntToHex((Sender as TControl).Left , 4)); - Assert(False, 'Trace:CreateComponent - Value of Button Top is $' + IntToHex((Sender as TControl).Top , 4)); - Assert(False, 'Trace:CreateComponent - Value of Button Width is $' + IntToHex((Sender as TControl).Width , 4)); - Assert(False, 'Trace:CreateComponent - Value of Button Height is $' + IntToHex((Sender as TControl).Height, 4)); If Not (Sender As TButton).Default Then Flags := Flags Or BS_PUSHBUTTON Else Flags := Flags Or BS_DEFPUSHBUTTON; Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height - 8, Parent, HMENU(Nil), HInstance, Nil); - 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); SetName(Window, StrTemp); @@ -1714,13 +1538,9 @@ Begin Begin Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Code style csCalendar'); Assert(False, 'Trace:TODO: TWin32Object.CreateComponent (style csCalendar) - Opening the date/time control applet. This will have to be good enough for now.'); - {$IFDEF VER1_0_4} - AProcess := TProcess.Create('control timedate.cpl', [poNoConsole]); - {$ELSE} - AProcess := TProcess.Create(TComponent(Sender).Owner); - AProcess.CommandLine := 'control timedate.cpl'; - AProcess.Options := [poNoConsole]; - {$ENDIF} + AProcess := TProcess.Create(TComponent(Sender).Owner); + AProcess.CommandLine := 'control timedate.cpl'; + AProcess.Options := [poNoConsole]; AProcess.Execute; Window := HWND(AProcess); //Window := CreateWindow('CalendarWndClass', StrTemp, Flags, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil); @@ -2163,30 +1983,6 @@ Begin Assert(False, 'Trace:Leaving CreateComponent'); End; -{------------------------------------------------------------------------------ - Method: TWin32Object.GetLabel - Params: CompStyle - The style of the component from which to extract the - label - Window - The window from which to extract the text - Retuens: The component's label - - Retrieves the text (label) from a control. - ------------------------------------------------------------------------------} -Function TWin32Object.GetLabel(CompStyle: Integer; Window: HWND): String; -Var - PLabel: Pointer; - ValLen: Integer; - Value: PChar; - Wnd: HWND; -Begin - Assert(False, 'TRACE: [TWin32Object.GetLabel] getting label.'); - PLabel := @Window; - Wnd := HWND(PLabel^); - ValLen := GetWindowTextLength(Wnd); - GetWindowText(Wnd, @Value, (ValLen + 1)); - Result := StrPas(Value); -End; - {------------------------------------------------------------------------------ Method: TWin32Object.AssignSelf Params: Window - The window to assign @@ -2238,33 +2034,8 @@ End; Adds a new page to a notebook ------------------------------------------------------------------------------} Procedure TWin32Object.AddNBPage(Parent, Child: TObject; Index: Integer); -Var - PStr: PChar; - Wnd: HWND; - TCI: TC_ITEM; Begin Assert(False, 'Trace:TWin32Object.AddNBPage - Start'); - Assert(False, Format('Trace:Adding notebook page %D', [Index])); - - {PStr := StrAlloc(Length(TPage(Child).Caption) + 1); - Try - StrPCopy(PStr, TPage(Child).Caption); - With TCI Do - Begin - Mask := TCIF_TEXT; - PSzText := PStr; - End; - SendMessage((Parent As TNotebook).Handle, TCM_INSERTITEM, Index, LPARAM(@TCI)); - {SetParent((Child As TWinControl).Handle, (Parent As TWinControl).Handle); - TControl(Child).Visible := True; - ShowHide(Child);} - Finally - StrDispose(PStr); - End; - - PTabInfo(@Child)^.Caption := PChar(TPage(Child).Caption); - PTabInfo(@Child)^.Index := Index;} - Assert(False, 'Trace:TWin32Object.AddNBPage - Exit'); End; {------------------------------------------------------------------------------ @@ -2307,11 +2078,7 @@ End; Set the color of the specified pixel on the window?screen?object? ------------------------------------------------------------------------------} Procedure TWin32Object.SetPixel(Sender: TObject; Data: Pointer); -Type - TBmI = Array[0..SizeOf(Integer)] Of Char; Var - BM: Windows.BITMAP; - BMI: TBmI; DC: HDC; Handle: HWnd; Begin @@ -2414,16 +2181,13 @@ End; one property changed use the SetProperties function instead; ------------------------------------------------------------------------------} Function TWin32Object.SetValue(Sender: TObject; Data: Pointer): Integer; -Type - LUID_AND_ATTRIBUTES = Array[0..1] Of LARGE_INTEGER; Var Cur: PChar; Date: TDateTime; - Day, Month, Year: Integer; Handle: HWnd; HTkn: Integer; IsNT: Boolean; - OTP, Priv: LUID; + OTP: LUID; OTPS: DWord; OVI: OSVersionInfo; ST: SystemTime; @@ -2511,11 +2275,10 @@ End; ------------------------------------------------------------------------------} Function TWin32Object.SetProperties(Sender: TObject): Integer; Var - Control, Handle: HWND; + Handle: HWND; I: Integer; LVC: LV_COLUMN; Style: DWord; - XAlign, YAlign: Real; begin Result := 0; // default if nobody sets it @@ -2689,245 +2452,8 @@ End; Attaches the calling Menu to its Parent ------------------------------------------------------------------------------} Procedure TWin32Object.AttachMenu(Sender: TObject); -Var - AccelKey: Integer; - AccelGroup: HACCEL; - MenuParent, MenuItem: HMENU; - MI: TMenuItem; - PStr: PChar; Begin - {PStr := StrAlloc(Length((Sender As TMenuItem).Caption) + 1); - StrPCopy(PStr, (Sender As TMenuItem).Caption); - Windows.AppendMenu((Sender As TMenuItem).Parent.GetParentMenu.Handle, MF_STRING OR MF_POPUP, (Sender As TMenuItem).Handle, PStr); - StrDispose(PStr);} - {Assert(False, 'Trace:TODO: Code TWin32Object.AttachMenu'); - Assert(False, Format('Trace:[TWin32Object.AttachMenu] Sender is %S', [Sender.ClassName])); - Assert(False, Format('Trace:[TWin32Object.AttachMenu] Sending windowed control is %S', [(Sender As TComponent).Owner.ClassName])); - If Sender Is TMenu Then - Begin - SetMenu(((Sender As TComponent).Owner As TWinControl).Handle, (Sender As TMenu).Handle); - DrawMenuBar(((Sender As TComponent).Owner As TWinControl).Handle); - End - Else If Sender Is TMenuItem Then - Begin - Assert(False, Format('Trace:[TWin32Object.AttachMenu] Parent is %S', [(Sender As TMenuItem).Parent.GetParentMenu.ClassName])); - //SetAccelKey(((Sender As TComponent).Owner As TWinControl).Handle, Pointer(73)); - If ((Sender As TMenuItem).Parent.GetParentMenu <> Nil) And ((Sender As TMenuItem).Parent.GetParentMenu.Items.IndexOf(TMenuItem(Sender)) <> - 1) Then - AppendMenu((Sender As TMenuItem).Parent.GetParentMenu.Handle, MF_String Or MF_Popup, (Sender As TMenuItem).Handle, PChar((Sender As TMenuItem).Caption)); - End; - Assert(False, 'Trace:TWin32Object.AttachMenu: exiting');} - {with (Sender as TMenuItem) do - begin - MenuItem := Handle; - - if (Parent.GetParentMenu <> nil) and - (Parent.GetParentMenu.Items.IndexOf(TMenuItem(Sender)) <> -1) then //mainmenu - begin - MenuParent := Parent.Handle; - AppendMenu(Parent.Handle, MF_POPUP, Handle, StrToPChar(Caption)); - Windows.SetMenu(FParentWindow, Parent.Handle); - DrawMenuBar(FParentWindow); - end - else begin - // find the menu container - MenuParent := HMENU(GetProp(Parent.Handle, 'ContainerMenu')); - if MenuParent = HMENU(Nil) then - begin - MenuParent := CreateMenu; - SetProp(Parent.Handle, 'ContainerMenu', Pointer(MenuParent)); - - Windows.SetMenu(Parent.Handle, MenuParent); - - AccelGroup := CreateAcceleratorTable(LPACCEL(Nil), 0); - end; - Windows.AppendMenu(HMENU(HMENU(Nil)), MF_POPUP, FSubMenu, StrToPChar(Caption)); - end; - - AccelGroup := GetAccelGroup(MenuParent); - AccelKey := GetAccelKey(MenuItem); - if (AccelGroup <> HAccel(nil)) and (AccelKey <> 0) - then begin - end; - end;} -End; - - -{------------------------------------------------------------------------------ - Method: TWin32Object.IsValidDC - Params: DC - a (LCL) device context - Returns: True if valid - - Checks if the given DC is valid. - ------------------------------------------------------------------------------} -Function TWin32Object.IsValidDC(Const DC: HDC): Boolean; -Begin - Result := FDeviceContexts.Contains(Pointer(DC)); - Assert(False, Format('Trace:[TWin32Object.IsValidDC] DC: 0x%x --> %s', [Integer(DC), BOOL_RESULT[Result]])); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.IsValidGDIObject - Params: GDIObject - a (LCL) GDI Object - Returns: True if valid - - Checks if the given GDIObject is valid - ------------------------------------------------------------------------------} -function TWin32Object.IsValidGDIObject(Const GDIObject: HGDIOBJ): Boolean; -begin - Result := FGDIObjects.Contains(Pointer(GDIObject)); - If Result Then - Try - With PGdiObject(GDIObject)^ Do - Case GDIType Of - gdiBitmap: - Begin - Case GDIBitmapType Of - gbPixmap: - Result := GDIPixmapObject <> Integer(Nil); - gbBitmap: - Result := GDIBitmapObject <> Integer(Nil); - gbImage: - Result := GDIRawImageObject <> Nil; - Else - Result := False; - end; - end; - gdiBrush: - Result := True; //Result := GDIBrushPixmap <> Nil; //GDIBrushPixmap may be nil - gdiFont: - Result := GDIFontObject <> Integer(Nil); - gdiPen: - Result := True; - Else - Result := False; - End; - Except - On Exception Do - Result := False; - End; - Assert(False, Format('Trace: [TgtkObject.IsValidGDIObject] GDIObject: 0x%x --> %s', [Integer(GDIObject), BOOL_RESULT[Result]])); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.IsValidGDIObjectTyp - Params: GDIObject - a (LCL) GDI Object - GDIType - the requested type - Returns: True if valid - - Checks if the given GDIObject is valid and the GDItype is the requested type - ------------------------------------------------------------------------------} -Function TWin32Object.IsValidGDIObjectType(Const GDIObject: HGDIOBJ; Const GDIType: TGDIType): Boolean; -Begin - Result := IsValidGDIObject(GDIObject) And (PGdiObject(GDIObject)^.GDIType = GDIType); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.NewDC - Params: none - Returns: pointer to a psedo-GDI Win32-API Device Context - - Creates an initial DC - ------------------------------------------------------------------------------} -Function TWin32Object.NewDC: PDeviceContext; -Begin - Assert(False, 'Trace:> [TgtkObject.NewDC]'); - New(Result); - With Result^ Do - Begin - HWnd := 0; - GC := ULONG(Nil); - Drawable := Nil; - PenPos.X := 0; - PenPos.Y := 0; - CurrentBitmap := Nil; - CurrentFont := Nil; - CurrentPen := Nil; - CurrentBrush := Nil; - SavedContext := Nil; - CurrentTextColor := 0; - CurrentBackColor := $FFFFFF; - End; - FDeviceContexts.Add(Result); -End; - -{------------------------------------------------------------------------------ - Method TWin32Object.NewGDIObject - Params: GDIType - a GDI type - Returns: a GDI object - - Creates a GDI ibject - ------------------------------------------------------------------------------} -Function TWin32Object.NewGDIObject(Const GDIType: TGDIType): PGdiObject; -Begin - Assert(False, Format('Trace:> [TWin32Object.NewGDIObject]', [])); - New(Result); - FillChar(Result^, SizeOf(TGDIObject), 0); - Result^.GDIType := GDIType; - FGDIObjects.Add(Result); - Assert(False, Format('Trace:< [TWin32Object.NewGDIObject] FGDIObjects --> 0x%p', [Result])); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.CreateDefaultBrush - Params: none - Returns: a Brush GDI Object - - Creates an default brush, used for initial values - ------------------------------------------------------------------------------} -Function TWin32Object.CreateDefaultBrush: PGdiObject; -Begin - Result := NewGDIObject(gdiBrush); - Result^.GDIBrushFill := RGB(255, 255, 255); - CreateSolidBrush(Result^.GDIBrushFill); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.CreateDefaultFontt - Params: none - Returns: a Font GDI Object - - Creates an default font, used for initial values - ------------------------------------------------------------------------------} -Function TWin32Object.CreateDefaultFont: PGdiObject; -type - TFontArr = Array[0..63] Of Byte; - PFontArr = ^TFontArr; -var - ELF: Windows.ENUMLOGFONTEX; - Fn: PChar; - LF: TAGLOGFONTA; -Begin - With LF Do - Begin - lfWeight := FW_BOLD; - lfCharSet := DEFAULT_CHARSET; - lfFaceName := 'Helvetica'; - End; - Result := NewGDIObject(gdiFont); - Result^.GDIFontObject := CreateFontIndirect(LF); -End; - -{------------------------------------------------------------------------------ - Function: TWin32Object.CreateDefaultPen - Params: none - Returns: a Pen GDI Object - - Creates an default pen, used for initial values - ------------------------------------------------------------------------------} -Function TWin32Object.CreateDefaultPen: PGdiObject; -Var - GO: PGDIObject; -Begin - New(GO); - Result := GO; - With Result^ Do - Begin - GDIPenStyle := PS_SOLID; - GDIPenColor := RGB(0, 0, 0); - CreatePen(GDIPenStyle, (PS_DASH + 1), GDIPenColor); - End; - Dispose(GO); End; {------------------------------------------------------------------------------ @@ -2957,158 +2483,11 @@ Begin SetProp(Window, 'MsgList', Nil); End; -{------------------------------------------------------------------------------ - Method: TWin32Object.ShowHide - Params: CompStyle - The component style (cs* constant) - P - Pointer to an object to show - Visible - Is the window to be shown - Returns: Nothing - - Hides or shows an object - ------------------------------------------------------------------------------} -Procedure TWin32Object.ShowHide(CompStyle: Integer; P: Pointer ; Visible: Boolean); -Begin - Assert(False, 'Trace:ShowHide - Start'); - Assert(False, 'Trace:ShowHide - Value of Pointer P = $' + IntToHex(LongInt(P), 8)); - If LongInt(P) <> 0 Then - Begin - If Visible Then - ShowWindow(TWinControl(P).Handle, SW_SHOW) - Else - ShowWindow(TWinControl(P).Handle, SW_HIDE); - End; - Assert(False, 'Trace:ShowHide - End'); -end; - -{------------------------------------------------------------------------------ - Method: TWin32Object.AddNBPage - Params: Parent - Notebook object to which a page will be added - Child - Page object to add - Index - The page's target index - Returns: Nothing - - Adds a page to a notebook - ------------------------------------------------------------------------------} -Procedure TWin32Object.AddNBPage(Parent, Child: Pointer; Index: Integer); -Begin - Assert(False, 'Trace:AddNBPage - Start, Adding a notebook page'); - AddNBPage(TObject(Parent), TObject(Child), Index); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.RemoveNBPage - Params: Parent - Parent notebook - Child - Page to remove - Index - Index of page - Returns: Nothing - - Removes a page from a notebook - ------------------------------------------------------------------------------} -Procedure TWin32Object.RemoveNBPage(Parent, Child: Pointer; Index: Integer); -Begin - Assert(False, 'Trace:RemoveNBPage - Removing a notebook page'); - RemoveNBPage(TObject(Parent), Index); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.DrawFillRect - Params: Child - Object onto which to draw - Data - Pointer to GDI information - Returns: Nothing - - Draws a filled rectangle - ------------------------------------------------------------------------------} -Procedure TWin32Object.DrawFillRect(Child: TObject; Data: Pointer); -Var - DC: HDC; - R: Windows.Rect; - Wnd: HWND; -Begin - Wnd := (Child As TWinControl).Handle; - DC := GetDC(Wnd); - Windows.GetClientRect(Wnd, @R); - Windows.FillRect(DC, R, PGDIObject(Data)^.GDIPenColor); - ReleaseDC(Wnd, DC); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.DrawRect - Params: Child - Child on which a rectangle will be drawn - Data - Data used to draw the rectangle - Returns: Nothing - - Draws a rectangle on an object - ------------------------------------------------------------------------------} -Procedure TWin32Object.DrawRect(Child: TObject; Data: PRect); -Var - DC: HDC; - Wnd: HWND; -Begin - Wnd := (Child As TWinControl).Handle; - DC := GetDC(Wnd); - With Data^ Do - {Windows.}Rectangle(DC, Left, Top, Right, Bottom); - ReleaseDC(Wnd, DC); -end; - -{------------------------------------------------------------------------------ - Method: TWin32Object.DrawLine - Params: Child - Object onto which a line will be drawn - Data - Information for drawing a line - Returns: Nothing - - Draws a line on an object - ------------------------------------------------------------------------------} -Procedure TWin32Object.DrawLine(Child: TObject; Data: Pointer); -Var - DC: HDC; - Wnd: HWND; -Begin - Assert(False, 'Trace:TODO: Code DrawLine'); - Wnd := (Child As TWinControl).Handle; - DC := GetDC(Wnd); - With PPoint(Data)^ Do - LineTo(DC, X, Y); - ReleaseDC(Wnd, DC); -End; - -{------------------------------------------------------------------------------ - Method: TWin32Object.DrawText - Params: Child - Object on which text will be drawn - Data - Information needed to draw the text - Returns: Nothing - - Draws text on an object - ------------------------------------------------------------------------------} -Procedure TWin32Object.DrawText(Child: TObject; Data: Pointer); -Var - DC: HDC; - Str: String; - Wnd: HWND; -Begin - Str := (Child As TWinControl).Caption; - Wnd := (Child As TWinControl).Handle; - DC := GetDC(Wnd); - Windows.DrawText(DC, PChar(Str), Length(Str), Data, DT_Bottom Or DT_Left); - ReleaseDC(Wnd, DC); -end; - -{------------------------------------------------------------------------------ - Method: TWin32Object.GetFontInfo - Params: Sender - The font object from which to extract the data - Data - Pointer that stores the information - Returns: Nothing - - Retrieves font information - ------------------------------------------------------------------------------} -Procedure TWin32Object.GetFontInfo(Sender: TObject; Data: Pointer); -Begin - Assert(False, 'Trace:TODO: Code TWin32Object.GetFontinfo.'); - Data := Pointer(PLMCanvasDrawText(@Sender)^.Font); -End; - { $Log$ + Revision 1.18 2002/04/03 01:52:42 lazarus + Keith: Removed obsolete code, in preperation of a pending TWin32Object cleanup + Revision 1.17 2002/03/17 21:36:52 lazarus Keith: Fixed Win32 compilation problems diff --git a/lcl/interfaces/win32/win32proc.inc b/lcl/interfaces/win32/win32proc.inc index 04804f1ae4..9d7b5ae127 100644 --- a/lcl/interfaces/win32/win32proc.inc +++ b/lcl/interfaces/win32/win32proc.inc @@ -131,21 +131,6 @@ Begin End; {Case} End; -{------------------------------------------------------------------------------ - Function: LM_To_String - Params: LM_Message - Input lazarus message - Returns: Lazarus message name - - Converts a lazarus message identIfier to the appropriate name - - NOTE: This Function has been superseded by and simply calls - LMessages.GetMessageName - ------------------------------------------------------------------------------} -Function LM_To_String(LM_Message: Integer): String; -Begin - Result := GetMessageName(LM_Message); -End; - {------------------------------------------------------------------------------ Function: WM_To_String Params: WM_Message - a WinDows message @@ -444,124 +429,6 @@ Begin AssertEx(Message, False, 0); End; - -{------------------------------------------------------------------------------ - Function: NewGDIRawImage - Params: Width, Height - Size of the image - Depth - Depth of the image - Returns: a GDIRawImage - - Creates a RawImage - ------------------------------------------------------------------------------} -Function NewGDIRawImage(Const AWidth, AHeight: Integer; Const ADepth: Byte): PGDIRawImage; -Begin - Result := AllocMem(SizeOf(TGDIRawImage) + ((AWidth * AHeight) - 1) * SizeOf(TGDIRGB)); - With Result^ Do - Begin - Height := AHeight; - Width := AWidth; - Depth := ADepth; - End; -End; - - -{------------------------------------------------------------------------------ - Function: CopyDCData - Params: DestinationDC - a dc to copy data to - SourceDC - a dc to copy data from - Returns: True If succesfu - - Creates a copy DC from the given DC - ------------------------------------------------------------------------------} -Function CopyDCData(Const DestinationDC, SourceDC: PDeviceContext): Boolean; -Begin - Assert(False, Format('Trace:> [CopyDCData] DestDC:0x%x, SourceDC:0x%x', [Integer(DestinationDC), Integer(SourceDC)])); - Result := (DestinationDC <> nil) and (SourceDC <> nil); - If Result - Then Begin - With DestinationDC^ Do - Begin - hWnd := SourceDC^.hWnd; - Drawable := SourceDC^.Drawable; - If (SourceDC^.GC = HDC(Nil)) or (Drawable = Nil) Then - GC := HDC(Nil) - Else - Begin - - End; - PenPos := SourceDC^.PenPos; - CurrentBitmap := SourceDC^.CurrentBitmap; - CurrentFont := SourceDC^.CurrentFont; - CurrentPen := SourceDC^.CurrentPen; - CurrentBrush := SourceDC^.CurrentBrush; - CurrentTextColor := SourceDC^.CurrentTextColor; - CurrentBackColor := SourceDC^.CurrentBackColor; - SavedContext := nil; - End; - End; - Assert(False, Format('Trace:< [CopyDCData] DestDC:0x%x, SourceDC:0x%x --> %d', [Integer(DestinationDC), Integer(SourceDC), Integer(Result)])); -End; - -{------------------------------------------------------------------------------ - Procedure: SelectGDKBrushProps - Params: DC - a (LCL) device context - Returns: Nothing - - Sets the forecolor and fill according to the brush - ------------------------------------------------------------------------------} -Procedure SelectWin32BrushProps(Const DC: HDC); -var - LB: LogBrush; -Begin - With LB, PDeviceContext(DC)^, CurrentBrush^ Do - Begin - Assert(False, 'TODO: Code SelectWin32BrushProps'); - //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])); - LBStyle := GDIBrushFill; - LBColor := GDIBrushColor; - SelectObject(GC, CreateBrushIndirect(TagLogBrush(LB))); - SetBkColor(GC, CurrentBackCOlor); - //TODO: Brush pixmap - End; -End; - -{------------------------------------------------------------------------------ - Procedure: SelectWin32PenProps - Params: DC - a (LCL) device context - Returns: Nothing - - Sets the forecolor and fill according to the pen - ------------------------------------------------------------------------------} -Procedure SelectWin32PenProps(Const DC: HDC); -Var - Pen: HPEN; -Begin - Assert(False, 'Trace:TODO: Code SelectWin32PenProps'); - With PDeviceContext(DC)^, CurrentPen^ Do - Begin - Pen := CreatePen(GDIPenStyle, GDIPenWidth, GDIPenColor); - SetBkColor(GC, CurrentBackColor); - SelectObject(GC, Pen); - End; -End; - -{------------------------------------------------------------------------------ - Procedure: SelectWin32TextProps - Params: DC - a (LCL)devicecontext - Returns: Nothing - - Sets the forecolor and fill according to the Textcolor - ------------------------------------------------------------------------------} -Procedure SelectWin32TextProps(Const DC: HDC); -Begin - Assert(False, 'TODO: Code SelectWin32TextProps'); - With PDeviceContext(DC)^ Do - Begin - SetBkColor(GC, CurrentBackColor); - SetTextColor(GC, CurrentTextColor); - End; -End; - {------------------------------------------------------------------------------ Function: GetShiftState Params: None @@ -600,19 +467,6 @@ Begin //TODO: ssAltGr End; -{------------------------------------------------------------------------------ - Function: Win32KeyState2ShiftState - Params: KeyState - The Windows key state - Returns: the TShiftState for the given KeyState - - Win32KeyState2ShiftState converts a Windows key state to a LCL/Delphi TShiftState - ------------------------------------------------------------------------------} -Function Win32KeyState2ShiftState(KeyState: Word): TShiftState; -Begin - Assert(False, 'TRACE:Using Function Win32KeyState2ShiftState which isn''t implemented yet'); - Result := GetShiftState; -End; - {------------------------------------------------------------------------------ Procedure: GetWin32KeyInfo Params: Event - Requested info @@ -626,18 +480,13 @@ End; GetWin32KeyInfo returns information about the given key event ------------------------------------------------------------------------------} Procedure GetWin32KeyInfo(Const Event: Integer; Var KeyCode, VirtualKey: Word; Var SysKey, Extended, Toggle: Boolean); -Var - TempKeyCode: Word; - CtrlDown: Boolean; Const MVK_UNIFY_SIDES = 1; Begin Assert(False, 'TRACE:Using function GetWin32KeyInfo which isn''t implemented yet'); KeyCode := Word(Event); VirtualKey := MapVirtualKey(KeyCode, MVK_UNIFY_SIDES); - TempKeyCode := KeyCode; SysKey := (VirtualKey = VK_SHIFT) Or (VirtualKey = VK_CONTROL) Or (VirtualKey = VK_MENU); - CtrlDown := GetAsyncKeyState(VK_CONTROL) <> 0; ExtEnded := (SysKey) Or (VirtualKey = VK_INSERT) Or (VirtualKey = VK_HOME) Or (VirtualKey = VK_LEFT) Or (VirtualKey = VK_UP) Or (VirtualKey = VK_RIGHT) Or (VirtualKey = VK_DOWN) Or (VirtualKey = VK_PRIOR) Or (VirtualKey = VK_NEXT) Or (VirtualKey = VK_END) Or (VirtualKey = VK_DIVIDE); Toggle := Lo(GetKeyState(VirtualKey)) = 1; End; @@ -760,113 +609,6 @@ End; Widget member Functions ************************************************************************) -// ---------------------------------------------------------------------- -// Creates a WinControlInfo record for the given window -// Info needed by the API of a HWND -// -// This structure obsoletes: -// "core-child", "fixed", "class" -// ---------------------------------------------------------------------- -Function CreateControlInfo(Const Control: HWND): PWinControlInfo; -Var - R: TRect; -Begin - Assert(False, 'TRACE:Using function CreateControlInfo which isn''t implemented yet'); - If Control = HWND(Nil) Then - Begin - Result := Nil; - End - Else - Begin - New(Result); - FillChar(Result^, SizeOf(Result^), 0); - With Result^ Do - Begin - GetUpdateRect(Control, @R, False); - ImplementationControl := Control; - UpdateRect := R; - WndProc := GetWindowLong(Control, GWL_WNDPROC); - Style := GetWindowLong(Control, GWL_STYLE); - ExStyle := GetWindowLong(Control, GWL_EXSTYLE); - UserData := GetWindowLong(Control, GWL_USERDATA); - End; - SetProp(Control, 'Control_Info', Result); - End; -End; - -Function GetControlInfo(Const Control: HWND; Const Create: Boolean): PWinControlInfo; -Begin - Assert(False, 'TRACE: Using Function GetControlInfo which isn''t implemented yet'); - If Control = HWND(Nil) Then - Begin - Result := Nil; - End - Else - Begin - Result := PWinControlInfo(GetProp(Control, 'Control_Info')); - If (Result = Nil) and (Create) Then - Result := CreateControlInfo(Control); - End; -End; - -// ---------------------------------------------------------------------- -// the core_child widget points to the actual widget which implements the -// Functionality we needed. It is mainly used in composed controls like -// a listbox. In that case the core_child is the listbox, where a scrolling -// widget is main. -// ---------------------------------------------------------------------- -Function GetCoreChildControl(Const Control: HWND): HWND; -Begin - Assert(False, 'TRACE:Using function GetCoreChildControl which isn''t implemented yet'); - Result := HWND(GetProp(Control, 'Core_Child')); - If Result = HWND(Nil) Then - Result := Control; -End; - -Procedure SetCoreChildControl(Const ParentControl, ChildControl: HWND); -Begin - Assert(False, 'TRACE:Using Function SetCoreChildControl which isn''t implemented yet'); - If (ParentControl <> HWND(Nil)) And (ChildControl <> HWND(Nil)) Then - SetProp(ParentControl, 'Core_Child', Pointer(ChildControl)); -End; - -// ---------------------------------------------------------------------- -// the main widget is the widget passed as handle to the winAPI -// main data is stored in the fixed form to get a reference to its parent -// ---------------------------------------------------------------------- -Function GetMainControl(Const Control: HWND): HWND; -Begin - Assert(False, 'TRACE:Using function GetMainControl which isn''t implemented yet'); - Result := HWND(GetProp(Control, 'Main')); - If Result = HWND(Nil) Then - Result := Control; -End; - -Procedure SetMainControl(Const ParentControl, ChildControl: HWND); -Begin - Assert(False, 'TRACE: Using Function SetMainControl which isn''t implemented yet'); - If (ParentControl <> HWND(Nil)) and (ChildControl <> HWND(Nil)) Then - SetProp(ChildControl, 'Main', Pointer(ParentControl)); -End; - -// ---------------------------------------------------------------------- -// the fixed control is the container for controls. By default a control -// scales/places a control. with the use of a fixed we can place them. -// NOTE: This should only be true for GTK. -// ---------------------------------------------------------------------- -Function GetFixedControl(Const Control: HWND): HWND; -Begin - Assert(False, 'TRACE: Using Function GetFixedControl which isn''t implemented yet'); - Result := HWND(GetProp(Control, 'Fixed')); -End; - -Procedure SetFixedControl(Const ParentControl, FixedControl: HWND); -Begin - Assert(False, 'TRACE: Using Function SetFixedControl which isn''t implemented yet'); - If (ParentControl <> HWND(Nil)) and (FixedControl <> HWND(Nil)) Then - SetProp(ParentControl, 'Fixed', Pointer(FixedControl)); -End; - // ---------------------------------------------------------------------- // Some need the LCLobject which created this control. // @@ -879,12 +621,6 @@ Begin SetProp(Control, 'Class', Pointer(AnObject)); End; -Function GetLCLObject(Const Control: HWND): TObject; -Begin - Assert(False, 'TRACE:Using function GetLCLObject which isn''t implemented yet'); - Result := TObject(GetProp(Control, 'Class')); -End; - // ---------------------------------------------------------------------- // The Accelgroup and AccelKey is needed by menus // ---------------------------------------------------------------------- @@ -921,6 +657,9 @@ End; { ============================================================================= $Log$ + Revision 1.7 2002/04/03 01:52:43 lazarus + Keith: Removed obsolete code, in preperation of a pending TWin32Object cleanup + Revision 1.6 2002/02/07 08:35:12 lazarus Keith: Fixed persistent label captions and a few less noticable things diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index e669d999e4..c021a82925 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -16,15 +16,6 @@ // {$C+} // {$DEFINE ASSERT_IS_ON} {$ENDIF} - -Const - SYes = 'Yes'; - SNo = 'No'; - SOK = 'OK'; - SCancel = 'Cancel'; - SAbort = 'Abort'; - SRetry = 'Retry'; - SIgnore = 'Ignore'; Const BOOL_TEXT: Array[Boolean] Of String = ('False', 'True'); @@ -372,17 +363,13 @@ Type PPixmapArray = ^TPixmapArray; TPixmapArray = Array[0..1000] Of PChar; Var - AliasLen, BitCount, C, Planes: Cardinal; + AliasLen: Cardinal; AList: TList; - Bits: PBitData; ColorArray: PColorArray; ColorCount: Integer; DC: HDC; - GDIObject: PGDIObject; Height, Width: Integer; OldObject: HGDIOBJ; - P: Pointer; - PixIndex: Byte; PixmapArray: PPixmapArray; PixmapInfo: TStringList; Const @@ -493,7 +480,7 @@ Const Begin Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Start'); - Height := 0; + {Height := 0; Width := 0; ColorCount := 0; AliasLen := 0; @@ -540,7 +527,7 @@ Begin PixmapInfo := Nil; PixmapArray := Nil; SelectObject(DC, OldObject); - DeleteDC(DC); + DeleteDC(DC);} Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Exit'); End; @@ -725,9 +712,6 @@ End; Draws a character string by using the currently selected font. ------------------------------------------------------------------------------} Function TWin32Object.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; -Var - PStr: PChar; - Width, Height: Integer; Begin Assert(False, Format('trace:> [TWin32Object.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); Result := Windows.ExtTextOut(DC, X, Y, Options, LPRECT(Rect), Str, Count, Dx); @@ -990,8 +974,6 @@ End; Computes the width and height of the specified string of text. ------------------------------------------------------------------------------} Function TWin32Object.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; Var Size: TSize): Boolean; -Var - NMax, NWd: Integer; Begin Assert(False, 'Trace:[TWin32Object.GetTextExtentPoint] - Start'); Result := Windows.GetTextExtentPoint32(DC, Str, Count, @Size); @@ -1022,9 +1004,6 @@ End; Retrieves information about the specified window. ------------------------------------------------------------------------------} Function TWin32Object.GetWindowLong(Handle: HWND; Int: Integer): LongInt; -Var - Data: TObject; - P: Pointer; Begin //TODO:Started but not finished Assert(False, Format('Trace:> [TWin32Object.GETWINDOWLONG] HWND: 0x%x, int: 0x%x (%d)', [Handle, int, int])); @@ -1191,10 +1170,7 @@ End; Checks a thread message queue for a message. ------------------------------------------------------------------------------} Function TWin32Object.PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean; -Var - Message: PMsg; Begin - //TODO Filtering Result := Windows.PeekMessage(@LPMsg, Handle, WMsgFilterMin, WMsgFilterMax, WRemoveMsg); End; @@ -1304,8 +1280,6 @@ End; the current pen and filled by using the current brush. ------------------------------------------------------------------------------} Function TWin32Object.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; -Var - Width, Height: Integer; Begin Assert(False, Format('Trace:> [TWin32Object.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2])); Result := Windows.Rectangle(DC, X1, Y1, X2, Y2); @@ -1824,7 +1798,6 @@ End; ------------------------------------------------------------------------------} Function TWin32Object.TextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): Boolean; Begin - // Your code here Result := Windows.TextOut(DC, X, Y, Str, Count); End; @@ -1850,6 +1823,9 @@ End; { ============================================================================= $Log$ + Revision 1.8 2002/04/03 01:52:43 lazarus + Keith: Removed obsolete code, in preperation of a pending TWin32Object cleanup + Revision 1.7 2002/02/07 08:35:12 lazarus Keith: Fixed persistent label captions and a few less noticable things diff --git a/lcl/interfaces/win32/winext.pas b/lcl/interfaces/win32/winext.pas index fb6723f5ee..a47c4ac307 100644 --- a/lcl/interfaces/win32/winext.pas +++ b/lcl/interfaces/win32/winext.pas @@ -90,11 +90,6 @@ Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): St Str into substrings around SplitStr } Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList; -{ Creates a string list limited to Count (-1 for no limit) entries by splitting - Str into substrings around any character or string that matches the pattern - of SplitStr } -Function Split(Const Str: PChar; SplitStr: TRegExprEngine; Count: Integer; Const CaseSensitive: Boolean): TStringList; - Implementation Uses SysUtils; @@ -160,40 +155,6 @@ Begin End; End; -Function Split(Const Str: PChar; SplitStr: TRegExprEngine; Count: Integer; Const CaseSensitive: Boolean): TStringList; -Var - Index, Index2, Len, Len2: Integer; - LastIndex: Byte; - OrigCt: Integer; - S, S2: String; -Begin - Result := TStringList.Create; - OrigCt := Count; - S := String(Str); - RegExprPos(SplitStr, Str, Index, Len); - Repeat - If OrigCt = 0 Then - Break; - S := Copy(S, Index + 1, Length(S)); - Result.Capacity := Result.Count; - S2 := Copy(S, Index + 1, Length(S)); - RegExprPos(SplitStr, PChar(S2), Index2, Len2); - Result.Add(Copy(S, Index + Len, (Index2 - Index) + 1)); - RegExprPos(SplitStr, PChar(S), Index, Len); - If Index > 0 Then - LastIndex := Index; - If Count > -1 Then - Dec(Count) - Until (Index < 1) Or (Count = 0); - Result.Capacity := Result.Count; - Result.Insert(0, Copy(Str, Length(String(Str)) - Length(S), Index + 1)); - If Count <> 0 Then - Begin - Result.Capacity := Result.Count; - Result.Add(Copy(S, LastIndex + Len + (Index2 - Index), Length(S))); - End; -End; - Initialization TmpStr := StrNew('');