{ $Id$} { ***************************************************************************** * Win32WSStdCtrls.pp * * ------------------ * * * * * ***************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } unit Win32WSStdCtrls; {$mode objfpc}{$H+} {$I win32defines.inc} interface uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// Classes, SysUtils, CommCtrl, StdCtrls, Controls, Graphics, Forms, Themes, //////////////////////////////////////////////////// WSControls, WSStdCtrls, WSLCLClasses, WSProc, Windows, LCLType, LCLProc, InterfaceBase, LMessages, LCLMessageGlue, Win32Int, Win32Proc, Win32WSControls, Win32Extra, Win32Themes; type { TWin32WSScrollBar } TWin32WSScrollBar = class(TWSScrollBar) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure SetParams(const AScrollBar: TCustomScrollBar); override; end; { TWin32WSCustomGroupBox } TWin32WSCustomGroupBox = class(TWSCustomGroupBox) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override; end; { TWin32WSGroupBox } TWin32WSGroupBox = class(TWSGroupBox) published end; { TWin32WSCustomComboBox } TWin32WSCustomComboBox = class(TWSCustomComboBox) private class function GetStringList(const ACustomComboBox: TCustomComboBox): TWin32ComboBoxStringList; published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure AdaptBounds(const AWinControl: TWinControl; var Left, Top, Width, Height: integer; var SuppressMove: boolean); override; class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; class function GetDroppedDown(const ACustomComboBox: TCustomComboBox): Boolean; override; class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; override; class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; override; class function GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; override; class function GetMaxLength(const ACustomComboBox: TCustomComboBox): integer; override; class function GetText(const AWinControl: TWinControl; var AText: string): boolean; override; class procedure SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox; NewTraverseList: boolean); override; class procedure SetDropDownCount(const ACustomComboBox: TCustomComboBox; NewCount: Integer); override; class procedure SetDroppedDown(const ACustomComboBox: TCustomComboBox; ADroppedDown: Boolean); override; class procedure SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); override; class procedure SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override; class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override; class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override; class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override; class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override; class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override; class function GetItemHeight(const ACustomComboBox: TCustomComboBox): Integer; override; class procedure SetItemHeight(const ACustomComboBox: TCustomComboBox; const AItemHeight: Integer); override; end; { TWin32WSComboBox } TWin32WSComboBox = class(TWSComboBox) published end; { TWin32WSCustomListBox } TWin32WSCustomListBox = class(TWSCustomListBox) published class procedure AdaptBounds(const AWinControl: TWinControl; var Left, Top, Width, Height: integer; var SuppressMove: boolean); override; class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; override; class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override; class function GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): boolean; override; class function GetScrollWidth(const ACustomListBox: TCustomListBox): Integer; override; class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override; class function GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; override; class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override; class function GetTopIndex(const ACustomListBox: TCustomListBox): integer; override; class procedure SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean); override; class procedure SetBorder(const ACustomListBox: TCustomListBox); override; class procedure SetColumnCount(const ACustomListBox: TCustomListBox; ACount: Integer); override; class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override; class procedure SetScrollWidth(const ACustomListBox: TCustomListBox; const AScrollWidth: Integer); override; class procedure SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect, AMultiSelect: boolean); override; class procedure SetStyle(const ACustomListBox: TCustomListBox); override; class procedure SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); override; class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); override; end; { TWin32WSListBox } TWin32WSListBox = class(TWSListBox) published end; { TWin32WSCustomEdit } TWin32WSCustomEdit = class(TWSCustomEdit) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class function GetCanUndo(const ACustomEdit: TCustomEdit): Boolean; override; class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override; class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override; class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override; class function GetMaxLength(const ACustomEdit: TCustomEdit): integer; {override;} class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; class function GetText(const AWinControl: TWinControl; var AText: string): boolean; override; class procedure SetAlignment(const ACustomEdit: TCustomEdit; const AAlignment: TAlignment); override; class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override; class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override; class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override; class procedure SetHideSelection(const ACustomEdit: TCustomEdit; NewHideSelection: Boolean); override; class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override; class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override; class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override; class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override; class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; class procedure Cut(const ACustomEdit: TCustomEdit); override; class procedure Copy(const ACustomEdit: TCustomEdit); override; class procedure Paste(const ACustomEdit: TCustomEdit); override; class procedure Undo(const ACustomEdit: TCustomEdit); override; end; { TWin32WSCustomMemo } TWin32WSCustomMemo = class(TWSCustomMemo) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override; class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override; class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override; class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override; class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override; end; { TWin32WSEdit } TWin32WSEdit = class(TWSEdit) published end; { TWin32WSMemo } TWin32WSMemo = class(TWSMemo) published end; { TWin32WSCustomStaticText } TWin32WSCustomStaticText = class(TWSCustomStaticText) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar: Boolean); override; class procedure SetAlignment(const ACustomStaticText: TCustomStaticText; const NewAlignment: TAlignment); override; class procedure SetStaticBorderStyle(const ACustomStaticText: TCustomStaticText; const NewBorderStyle: TStaticBorderStyle); override; class procedure SetText(const AWinControl: TWinControl; const AText: String); override; end; { TWin32WSStaticText } TWin32WSStaticText = class(TWSStaticText) published end; { TWin32WSButtonControl } TWin32WSButtonControl = class(TWSButtonControl) published class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; end; { TWin32WSButton } TWin32WSButton = class(TWSButton) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; class procedure SetShortCut(const AButton: TCustomButton; const ShortCutK1, ShortCutK2: TShortCut); override; end; { TWin32WSCustomCheckBox } TWin32WSCustomCheckBox = class(TWSCustomCheckBox) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override; class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox; const ShortCutK1, ShortCutK2: TShortCut); override; class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override; class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override; end; { TWin32WSCheckBox } TWin32WSCheckBox = class(TWSCheckBox) published end; { TWin32WSToggleBox } TWin32WSToggleBox = class(TWSToggleBox) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; end; { TWin32WSRadioButton } TWin32WSRadioButton = class(TWSRadioButton) published class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; end; { useful helper functions } function EditGetSelStart(WinHandle: HWND): integer; function EditGetSelLength(WinHandle: HWND): integer; procedure EditSetSelStart(WinHandle: HWND; NewStart: integer); procedure EditSetSelLength(WinHandle: HWND; NewLength: integer); {$DEFINE MEMOHEADER} {$I win32memostrings.inc} {$UNDEF MEMOHEADER} function ListBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; implementation const AlignmentToEditFlags: array[TAlignment] of DWord = ( { taLeftJustify } ES_LEFT, { taRightJustify } ES_RIGHT, { taCenter } ES_CENTER ); AlignmentToStaticTextFlags: array[TAlignment] of DWord = ( { taLeftJustify } SS_LEFT, { taRightJustify } SS_RIGHT, { taCenter } SS_CENTER ); BorderToStaticTextFlags: array[TStaticBorderStyle] of DWord = ( 0, WS_BORDER, // generic border SS_SUNKEN // the only one special border for text static controls ); AccelCharToStaticTextFlags: array[Boolean] of LONG = ( SS_NOPREFIX, 0 ); {$I win32memostrings.inc} {------------------------------------------------------------------------------ Function: ComboBoxWindowProc Params: Window - The window that receives a message Msg - The message received WParam - Word parameter LParam - Long-integer parameter Returns: 0 if Msg is handled; non-zero long-integer result otherwise Handles the messages sent to a combobox control by Windows or other applications ------------------------------------------------------------------------------} function ComboBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var Info: TComboboxInfo; WindowInfo: PWin32WindowInfo; NCCreateParams: PNCCreateParams; LMessage: TLMessage; begin // darn MS: if combobox has edit control, and combobox receives focus, it // passes it on to the edit, so it will send a WM_KILLFOCUS; inhibit // also don't pass WM_SETFOCUS to the lcl, // it will get one from the edit control case Msg of WM_NCCREATE: begin NCCreateParams := PCREATESTRUCT(lParam)^.lpCreateParams; if Assigned(NCCreateParams) then begin WindowInfo := AllocWindowInfo(Window); WindowInfo^.WinControl := NCCreateParams^.WinControl; WindowInfo^.WinControl.Handle := Window; WindowInfo^.DefWndProc := NCCreateParams^.DefWndProc; WindowInfo^.needParentPaint := False; SetWindowLong(Window, GWL_ID, PtrInt(NCCreateParams^.WinControl)); NCCreateParams^.Handled := True; end; end; WM_KILLFOCUS, WM_SETFOCUS: begin Info.cbSize := SizeOf(Info); Win32Extra.GetComboBoxInfo(Window, @Info); if (HWND(WParam) = Info.hwndItem) or (HWND(WParam) = Info.hwndList) then begin // continue normal processing, don't send to lcl Exit(CallDefaultWindowProc(Window, Msg, WParam, LParam)); end; end; WM_PAINT, WM_ERASEBKGND: begin WindowInfo := GetWin32WindowInfo(Window); if not WindowInfo^.WinControl.DoubleBuffered then begin LMessage.msg := Msg; LMessage.wParam := WParam; LMessage.lParam := LParam; LMessage.Result := 0; Exit(DeliverMessage(WindowInfo^.WinControl, LMessage)); end else Exit(WindowProc(Window, Msg, WParam, LParam)); end; WM_PRINTCLIENT: Exit(CallDefaultWindowProc(Window, Msg, WParam, LParam)); WM_MEASUREITEM: begin WindowInfo := GetWin32WindowInfo(Window); LMessage.Msg := LM_MEASUREITEM; LMessage.LParam := LParam; LMessage.WParam := WParam; LMessage.Result := 0; Exit(DeliverMessage(WindowInfo^.WinControl, LMessage)); end; end; // normal processing Result := WindowProc(Window, Msg, WParam, LParam); end; function ScrollBarWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var LMessage: TLMessage; Control: TWinControl; begin case Msg of WM_PRINTCLIENT: Exit(CallDefaultWindowProc(Window, Msg, WParam, LParam)); WM_PAINT, WM_ERASEBKGND: begin Control := GetWin32WindowInfo(Window)^.WinControl; if not Control.DoubleBuffered then begin LMessage.msg := Msg; LMessage.wParam := WParam; LMessage.lParam := LParam; LMessage.Result := 0; Result := DeliverMessage(Control, LMessage); Exit; end; end; end; Result := WindowProc(Window, Msg, WParam, LParam); end; { TWin32WSScrollBar } class function TWin32WSScrollBar.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := 'SCROLLBAR'; SubClassWndProc := @ScrollBarWindowProc; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; end; class procedure TWin32WSScrollBar.SetParams(const AScrollBar: TCustomScrollBar); var ScrollInfo: TScrollInfo; AMax: Integer; begin with AScrollBar do begin AMax := Max - 1; if AMax < Min then AMax := Min; if AMax < Max then AMax := Max; ScrollInfo.cbSize := SizeOf(TScrollInfo); ScrollInfo.fMask := SIF_POS or SIF_Range or SIF_PAGE; ScrollInfo.nMin := Min; ScrollInfo.nMax := AMax; ScrollInfo.nPage := PageSize; ScrollInfo.nPos := Position; SendMessage(Handle, SBM_SETSCROLLINFO, WParam(True), LParam(@ScrollInfo)); case Kind of sbHorizontal: SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or SBS_HORZ); sbVertical: SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or SBS_VERT); end; end; end; { TWin32WSCustomGroupBox } function GroupBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; begin // move groupbox specific code here case Msg of WM_NCHITTEST: begin Result := HTCLIENT; Exit; end; WM_ENABLE: begin Result := WindowProc(Window, Msg, WParam, LParam); // if it is groupbox and themed app then invalidate it on enable change // to redraw graphic controls on it (issue 0007877) if ThemeServices.ThemesAvailable then InvalidateRect(Window, nil, True); Exit; end; end; Result := WindowProc(Window, Msg, WParam, LParam); end; function GroupBoxParentMsgHandler(const AWinControl: TWinControl; Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam; var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean; var Info: PWin32WindowInfo; begin Result := False; case Msg of WM_CTLCOLORSTATIC: begin Info := GetWin32WindowInfo(HWND(LParam)); Result := Assigned(Info) and ThemeServices.ThemesEnabled and (Info^.WinControl.Color = AWinControl.Color); if Result then begin ThemeServices.DrawParentBackground(HWND(LParam), HDC(WParam), nil, False); MsgResult := GetStockObject(HOLLOW_BRUSH); WinProcess := False; SetBkMode(HDC(WParam), TRANSPARENT); end; end; end; end; class function TWin32WSCustomGroupBox.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin SubClassWndProc := @GroupBoxWindowProc; pClassName := @ButtonClsName[0]; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, False); Result := Params.Window; Params.WindowInfo^.ParentMsgHandler := @GroupBoxParentMsgHandler; end; class procedure TWin32WSCustomGroupBox.SetBiDiMode( const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); begin RecreateWnd(AWinControl); end; { TWin32WSCustomListBox } function ListBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var WindowInfo: PWin32WindowInfo; NCCreateParams: PNCCreateParams; LMessage: TLMessage; begin case Msg of WM_NCCREATE: begin NCCreateParams := PCREATESTRUCT(lParam)^.lpCreateParams; if Assigned(NCCreateParams) then begin WindowInfo := AllocWindowInfo(Window); WindowInfo^.WinControl := NCCreateParams^.WinControl; WindowInfo^.WinControl.Handle := Window; WindowInfo^.DefWndProc := NCCreateParams^.DefWndProc; // listbox is not a transparent control -> no need for parentpainting WindowInfo^.needParentPaint := False; SetWindowLong(Window, GWL_ID, PtrInt(NCCreateParams^.WinControl)); NCCreateParams^.Handled := True; end; end; WM_MEASUREITEM: begin WindowInfo := GetWin32WindowInfo(Window); LMessage.Msg := LM_MEASUREITEM; LMessage.LParam := LParam; LMessage.WParam := WParam; LMessage.Result := 0; Exit(DeliverMessage(WindowInfo^.WinControl, LMessage)); end; end; // normal processing Result := WindowProc(Window, Msg, WParam, LParam); end; class procedure TWin32WSCustomListBox.AdaptBounds( const AWinControl: TWinControl; var Left, Top, Width, Height: integer; var SuppressMove: boolean); var ColCount: Integer; DW: Integer; ARect: TRect; begin ColCount := TCustomListBox(AWinControl).Columns; if ColCount > 1 then begin // Listbox has a border and Width argument is a window rect => // Decrease it by border width Windows.GetClientRect(AWinControl.Handle, ARect); DW := ARect.Right - ARect.Left; Windows.GetWindowRect(AWinControl.Handle, ARect); DW := ARect.Right - ARect.Left - DW; SendMessage(AWinControl.Handle, LB_SETCOLUMNWIDTH, Max(1, (Width - DW) div ColCount), 0); end; end; class function TWin32WSCustomListBox.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); with Params do begin pClassName := ListBoxClsName; pSubClassName := LCLListboxClsName; SubClassWndProc := @ListBoxWindowProc; end; // create window FinishCreateWindow(AWinControl, Params, False, True); Result := Params.Window; end; class function TWin32WSCustomListBox.GetIndexAtXY( const ACustomListBox: TCustomListBox; X, Y: integer): integer; begin Result := Windows.SendMessage(ACustomListBox.Handle, LB_ITEMFROMPOINT, 0, MakeLParam(X,Y)); if hi(Result)=0 then Result := lo(Result) else Result := -1; end; class function TWin32WSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer; begin if ACustomListBox.MultiSelect then // Return focused item for multiselect listbox Result := SendMessage(ACustomListBox.Handle, LB_GETCARETINDEX, 0, 0) else // LB_GETCURSEL is only for single select listbox Result := SendMessage(ACustomListBox.Handle, LB_GETCURSEL, 0, 0); end; class function TWin32WSCustomListBox.GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): Boolean; var Handle: HWND; begin Handle := ACustomListBox.Handle; // The check for GetProp is required because of some division error which happens // if call LB_GETITEMRECT on window initialization Result := (GetProp(Handle, 'WinControl') <> 0) and (Windows.SendMessage(Handle, LB_GETITEMRECT, Index, LPARAM(@ARect)) <> LB_ERR); end; class function TWin32WSCustomListBox.GetScrollWidth(const ACustomListBox: TCustomListBox): Integer; begin Result := Windows.SendMessage(ACustomListBox.Handle, LB_GETHORIZONTALEXTENT, 0, 0); end; class function TWin32WSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer; begin // GetSelCount only works for multiple-selection listboxes if ACustomListBox.MultiSelect then Result := Windows.SendMessage(ACustomListBox.Handle, LB_GETSELCOUNT, 0, 0) else begin if Windows.SendMessage(ACustomListBox.Handle, LB_GETCURSEL, 0, 0) = LB_ERR then Result := 0 else Result := 1; end; end; class function TWin32WSCustomListBox.GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; var WindowInfo: PWin32WindowInfo; winHandle: HWND; begin winHandle := ACustomListBox.Handle; WindowInfo := GetWin32WindowInfo(winHandle); // if we're handling a WM_DRAWITEM, then LB_GETSEL is not reliable, check stored info if (WindowInfo^.DrawItemIndex <> -1) and (WindowInfo^.DrawItemIndex = AIndex) then Result := WindowInfo^.DrawItemSelected else Result := Windows.SendMessage(winHandle, LB_GETSEL, Windows.WParam(AIndex), 0) > 0; end; class function TWin32WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings; var Handle: HWND; begin Handle := ACustomListBox.Handle; Result := TWin32ListStringList.Create(Handle, ACustomListBox); GetWin32WindowInfo(Handle)^.List := Result; end; class function TWin32WSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox): integer; begin Result:=Windows.SendMessage(ACustomListBox.Handle, LB_GETTOPINDEX, 0, 0); end; class procedure TWin32WSCustomListBox.SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean); begin if ACustomListBox.MultiSelect then Windows.SendMessage(ACustomListBox.Handle, LB_SETSEL, Windows.WParam(ASelected), Windows.LParam(AIndex)) else if ASelected then SetItemIndex(ACustomListBox, AIndex) else SetItemIndex(ACustomListBox, -1); end; class procedure TWin32WSCustomListBox.SetBorder(const ACustomListBox: TCustomListBox); var Handle: HWND; StyleEx: PtrInt; begin Handle := ACustomListBox.Handle; StyleEx := GetWindowLong(Handle, GWL_EXSTYLE); if ACustomListBox.BorderStyle = TBorderStyle(bsSingle) Then StyleEx := StyleEx or WS_EX_CLIENTEDGE else StyleEx := StyleEx and not WS_EX_CLIENTEDGE; SetWindowLong(Handle, GWL_EXSTYLE, StyleEx); end; class procedure TWin32WSCustomListBox.SetColumnCount(const ACustomListBox: TCustomListBox; ACount: Integer); begin // The listbox styles can't be updated, so recreate the listbox RecreateWnd(ACustomListBox); end; class procedure TWin32WSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); var Handle: HWND; begin Handle := ACustomListBox.Handle; if ACustomListBox.MultiSelect then begin // deselect all items first Windows.SendMessage(Handle, LB_SETSEL, Windows.WParam(false), -1); if AIndex >= 0 then begin Windows.SendMessage(Handle, LB_SETSEL, Windows.WParam(true), Windows.LParam(AIndex)); end; Windows.SendMessage(Handle, LB_SETCARETINDEX, Windows.WParam(AIndex), 0); end else Windows.SendMessage(Handle, LB_SETCURSEL, Windows.WParam(AIndex), 0); end; class procedure TWin32WSCustomListBox.SetScrollWidth( const ACustomListBox: TCustomListBox; const AScrollWidth: Integer); begin Windows.SendMessage(ACustomListBox.Handle, LB_SETHORIZONTALEXTENT, AScrollWidth, 0); end; class procedure TWin32WSCustomListBox.SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect, AMultiSelect: boolean); begin RecreateWnd(ACustomListBox); end; class procedure TWin32WSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox); begin // The listbox styles can't be updated, so recreate the listbox RecreateWnd(ACustomListBox); end; class procedure TWin32WSCustomListBox.SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); begin TWin32ListStringList(AList).Sorted := ASorted; end; class procedure TWin32WSCustomListBox.SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); begin Windows.SendMessage(ACustomListBox.Handle, LB_SETTOPINDEX, NewTopIndex, 0); end; { TWin32WSCustomComboBox } const ComboBoxStylesMask = CBS_DROPDOWN or CBS_DROPDOWN or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_OWNERDRAWVARIABLE; function CalcComboBoxWinFlags(AComboBox: TCustomComboBox): dword; const ComboBoxStyles: array[TComboBoxStyle] of dword = ( CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST, CBS_OWNERDRAWFIXED, CBS_OWNERDRAWVARIABLE); ComboBoxReadOnlyStyles: array[boolean] of dword = ( CBS_DROPDOWN, CBS_DROPDOWNLIST); begin Result := ComboBoxStyles[AComboBox.Style]; if AComboBox.Style in [csOwnerDrawFixed, csOwnerDrawVariable] then Result := Result or ComboBoxReadOnlyStyles[AComboBox.ReadOnly]; end; class function TWin32WSCustomComboBox.GetStringList( const ACustomComboBox: TCustomComboBox): TWin32ComboBoxStringList; begin Result := nil; if ACustomComboBox.Style <> csSimple then Result := TWin32ComboBoxStringList(GetWin32WindowInfo(ACustomComboBox.Handle)^.List); end; class function TWin32WSCustomComboBox.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; Info: TComboboxInfo; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := ComboboxClsName; pSubClassName := LCLComboboxClsName; SubClassWndProc := @ComboBoxWindowProc; end; // create window FinishCreateWindow(AWinControl, Params, False, True); Info.cbSize := SizeOf(Info); Win32Extra.GetComboBoxInfo(Params.Window, @Info); // get edit window within with Params do begin // win32 bug? sometimes, if combo should not have edit (apropriate style), hwndItem = hwndCombo if Info.hwndItem <> Info.hwndCombo then Buddy := Info.hwndItem else Buddy := 0; // If the style is CBS_DROPDOWNLIST, Info.hwndItem is null, // because the combobox has no edit in that case. if Buddy <> HWND(nil) then begin SubClassWndProc := @WindowProc; WindowCreateInitBuddy(AWinControl, Params); BuddyWindowInfo^.isChildEdit := true; BuddyWindowInfo^.isComboEdit := true; end else BuddyWindowInfo:=nil; end; Result := Params.Window; end; class procedure TWin32WSCustomComboBox.AdaptBounds(const AWinControl: TWinControl; var Left, Top, Width, Height: integer; var SuppressMove: boolean); var StringList: TWin32ComboBoxStringList; begin if TCustomComboBox(AWinControl).Style = csSimple then Exit; StringList := GetStringList(TCustomComboBox(AWinControl)); if Assigned(StringList) then Height := StringList.ComboHeight; end; class procedure TWin32WSCustomComboBox.GetPreferredSize( const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin PreferredHeight := 0; if (AWinControl.HandleAllocated) and (TCustomComboBox(AWinControl).Style <> csSimple) then PreferredHeight := AWinControl.Height; end; class function TWin32WSCustomComboBox.GetDroppedDown( const ACustomComboBox: TCustomComboBox): Boolean; begin if not WSCheckHandleAllocated(ACustomComboBox, 'TWin32WSCustomComboBox.GetDroppedDown') then Exit(False); Result := LongBool(SendMessage(ACustomComboBox.Handle, CB_GETDROPPEDSTATE, 0, 0)); end; class function TWin32WSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer; begin if not WSCheckHandleAllocated(ACustomComboBox, 'TWin32WSCustomComboBox.GetSelStart') then Exit(-1); SendMessage(ACustomComboBox.Handle, CB_GETEDITSEL, Windows.WPARAM(@Result), Windows.LPARAM(nil)); end; class function TWin32WSCustomComboBox.GetSelLength(const ACustomComboBox: TCustomComboBox): integer; var startPos, endPos: dword; begin SendMessage(ACustomComboBox.Handle, CB_GETEDITSEL, Windows.WPARAM(@startPos), Windows.LPARAM(@endPos)); Result := endPos - startPos; end; class procedure TWin32WSCustomComboBox.SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); var CurrentStyle: DWord; begin CurrentStyle := GetWindowLong(ACustomComboBox.Handle, GWL_STYLE); if (CurrentStyle and ComboBoxStylesMask) = CalcComboBoxWinFlags(ACustomComboBox) then Exit; RecreateWnd(ACustomComboBox); end; class function TWin32WSCustomComboBox.GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; begin Result := SendMessage(ACustomComboBox.Handle, CB_GETCURSEL, 0, 0); end; class function TWin32WSCustomComboBox.GetMaxLength(const ACustomComboBox: TCustomComboBox): integer; begin Result := GetWin32WindowInfo(ACustomComboBox.Handle)^.MaxLength; end; class function TWin32WSCustomComboBox.GetText(const AWinControl: TWinControl; var AText: string): boolean; begin Result := AWinControl.HandleAllocated; if not Result then exit; AText := GetControlText(AWinControl.Handle); end; class procedure TWin32WSCustomComboBox.SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox; NewTraverseList: boolean); begin // TODO: implement me? end; class procedure TWin32WSCustomComboBox.SetDropDownCount( const ACustomComboBox: TCustomComboBox; NewCount: Integer); var StringList: TWin32ComboBoxStringList; begin StringList := GetStringList(ACustomComboBox); if StringList <> nil then StringList.DropDownCount := NewCount; end; class procedure TWin32WSCustomComboBox.SetDroppedDown( const ACustomComboBox: TCustomComboBox; ADroppedDown: Boolean); begin if WSCheckHandleAllocated(ACustomComboBox, 'TWin32WSCustomComboBox.SetDroppedDown') then SendMessage(ACustomComboBox.Handle, CB_SHOWDROPDOWN, WPARAM(ADroppedDown), 0); end; class procedure TWin32WSCustomComboBox.SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); begin SendMessage(ACustomComboBox.Handle, CB_SETEDITSEL, 0, MakeLParam(NewStart, NewStart)); end; class procedure TWin32WSCustomComboBox.SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); var startpos, endpos: integer; winhandle: HWND; begin winhandle := ACustomComboBox.Handle; SendMessage(winhandle, CB_GETEDITSEL, Windows.WParam(@startpos), Windows.LParam(@endpos)); endpos := startpos + NewLength; SendMessage(winhandle, CB_SETEDITSEL, 0, MakeLParam(startpos, endpos)); end; class procedure TWin32WSCustomComboBox.SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); begin SendMessage(ACustomComboBox.Handle, CB_SETCURSEL, Windows.WParam(NewIndex), 0); end; class procedure TWin32WSCustomComboBox.SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); var winhandle: HWND; begin winhandle := ACustomComboBox.Handle; SendMessage(winhandle, CB_LIMITTEXT, NewLength, 0); GetWin32WindowInfo(winhandle)^.MaxLength := NewLength; end; class procedure TWin32WSCustomComboBox.SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); begin RecreateWnd(ACustomComboBox); end; class procedure TWin32WSCustomComboBox.SetText(const AWinControl: TWinControl; const AText: string); var Handle: HWND; {$ifdef WindowsUnicodeSupport} AnsiBuffer: ansistring; WideBuffer: widestring; {$endif} begin // not necessary. Change is already done in TCustomComboBox.RealSetText if TCustomComboBox(AWinControl).ReadOnly then Exit; Handle := AWinControl.Handle; {$ifdef WindowsUnicodeSupport} if UnicodeEnabledOS then begin WideBuffer := UTF8ToUTF16(AText); Windows.SendMessageW(Handle, WM_SETTEXT, 0, LPARAM(PWideChar(WideBuffer))); end else begin AnsiBuffer := UTF8ToAnsi(AText); Windows.SendMessage(Handle, WM_SETTEXT, 0, LPARAM(PChar(AnsiBuffer))); end; {$else} Windows.SendMessage(Handle, WM_SETTEXT, 0, LPARAM(PChar(AText))); {$endif} end; class function TWin32WSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox): TStrings; var winhandle: HWND; begin winhandle := ACustomComboBox.Handle; Result := TWin32ComboBoxStringList.Create(winhandle, ACustomComboBox); GetWin32WindowInfo(winhandle)^.List := Result; end; class procedure TWin32WSCustomComboBox.Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); begin TWin32ListStringList(AList).Sorted := IsSorted; end; class function TWin32WSCustomComboBox.GetItemHeight(const ACustomComboBox: TCustomComboBox): Integer; begin if not WSCheckHandleAllocated(ACustomComboBox, 'GetItemHeight') then Result := 0 else Result := SendMessage(ACustomComboBox.Handle, CB_GETITEMHEIGHT, 0, 0); end; class procedure TWin32WSCustomComboBox.SetItemHeight(const ACustomComboBox: TCustomComboBox; const AItemHeight: Integer); begin if not WSCheckHandleAllocated(ACustomComboBox, 'SetItemHeight') then Exit; // size requests are done through WM_MeasureItem // SendMessage(ACustomComboBox.Handle, CB_SETITEMHEIGHT, AItemHeight, -1); // SendMessage(ACustomComboBox.Handle, CB_SETITEMHEIGHT, AItemHeight, 0); RecreateWnd(ACustomComboBox); end; { TWin32WSCustomEdit helper functions } function EditGetSelStart(WinHandle: HWND): integer; begin Windows.SendMessage(WinHandle, EM_GETSEL, Windows.WPARAM(@Result), 0); end; function EditGetSelLength(WinHandle: HWND): integer; var startpos, endpos: integer; begin Windows.SendMessage(WinHandle, EM_GETSEL, Windows.WPARAM(@startpos), Windows.LPARAM(@endpos)); Result := endpos - startpos; end; procedure EditSetSelStart(WinHandle: HWND; NewStart: integer); begin Windows.SendMessage(WinHandle, EM_SETSEL, Windows.WParam(NewStart), Windows.LParam(NewStart)); // scroll caret into view Windows.SendMessage(WinHandle, EM_SCROLLCARET, 0, 0); end; procedure EditSetSelLength(WinHandle: HWND; NewLength: integer); var startpos, endpos: integer; begin Windows.SendMessage(WinHandle, EM_GETSEL, Windows.WParam(@startpos), Windows.LParam(@endpos)); endpos := startpos + NewLength; Windows.SendMessage(WinHandle, EM_SETSEL, Windows.WParam(startpos), Windows.LParam(endpos)); end; { TWin32WSCustomEdit } class function TWin32WSCustomEdit.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @EditClsName[0]; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, false); // edit is not a transparent control -> no need for parentpainting Params.WindowInfo^.needParentPaint := false; Result := Params.Window; end; class function TWin32WSCustomEdit.GetCanUndo(const ACustomEdit: TCustomEdit): Boolean; begin Result := False; if not WSCheckHandleAllocated(ACustomEdit, 'GetCanUndo') then Exit; Result := Windows.SendMessage(ACustomEdit.Handle, EM_CANUNDO, 0, 0) <> 0; end; class function TWin32WSCustomEdit.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; var BufferX: Longword; begin // EM_GETSEL expects a pointer to 32-bits buffer in lParam Windows.SendMessageW(ACustomEdit.Handle, EM_GETSEL, 0, PtrInt(@BufferX)); Result.X := BufferX; Result.Y := 0; end; class function TWin32WSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer; begin Result := EditGetSelStart(ACustomEdit.Handle); end; class function TWin32WSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer; begin Result := EditGetSelLength(ACustomEdit.Handle); end; class function TWin32WSCustomEdit.GetMaxLength(const ACustomEdit: TCustomEdit): integer; begin Result := GetWin32WindowInfo(ACustomEdit.Handle)^.MaxLength; end; class procedure TWin32WSCustomEdit.GetPreferredSize( const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin if MeasureText(AWinControl, 'Fj', PreferredWidth, PreferredHeight) then begin PreferredWidth := 0; Inc(PreferredHeight, 8); end; end; class function TWin32WSCustomEdit.GetText(const AWinControl: TWinControl; var AText: string): boolean; begin Result := AWinControl.HandleAllocated; if not Result then exit; AText := GetControlText(AWinControl.Handle); end; class procedure TWin32WSCustomEdit.SetAlignment(const ACustomEdit: TCustomEdit; const AAlignment: TAlignment); var CurrentStyle: DWord; begin CurrentStyle := GetWindowLong(ACustomEdit.Handle, GWL_STYLE); if (CurrentStyle and 3) = AlignmentToEditFlags[AAlignment] then Exit; RecreateWnd(ACustomEdit); end; class procedure TWin32WSCustomEdit.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); begin Windows.SendMessageW(ACustomEdit.Handle, EM_SETSEL, NewPos.X, NewPos.X); end; class procedure TWin32WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); const EditStyles: array[TEditCharCase] of integer = (0, ES_UPPERCASE, ES_LOWERCASE); EditStyleMask = ES_UPPERCASE or ES_LOWERCASE; begin UpdateWindowStyle(ACustomEdit.Handle, EditStyles[NewCase], EditStyleMask); end; class procedure TWin32WSCustomEdit.SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); begin // nothing to do, SetPasswordChar will do the work end; class procedure TWin32WSCustomEdit.SetHideSelection(const ACustomEdit: TCustomEdit; NewHideSelection: Boolean); var CurrentStyle: DWord; begin CurrentStyle := GetWindowLong(ACustomEdit.Handle, GWL_STYLE); if (CurrentStyle and ES_NOHIDESEL = 0) = NewHideSelection then Exit; RecreateWnd(ACustomEdit); end; class procedure TWin32WSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); var winhandle: HWND; begin winhandle := ACustomEdit.Handle; SendMessage(winhandle, EM_LIMITTEXT, NewLength, 0); GetWin32WindowInfo(winhandle)^.MaxLength := NewLength; end; class procedure TWin32WSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); begin SendMessage(ACustomEdit.Handle, EM_SETPASSWORDCHAR, WParam(NewChar), 0); end; class procedure TWin32WSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); begin Windows.SendMessage(ACustomEdit.Handle, EM_SETREADONLY, Windows.WPARAM(NewReadOnly), 0); end; class procedure TWin32WSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); begin EditSetSelStart(ACustomEdit.Handle, NewStart); end; class procedure TWin32WSCustomEdit.SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); begin EditSetSelLength(ACustomEdit.Handle, NewLength); end; class procedure TWin32WSCustomEdit.SetText(const AWinControl: TWinControl; const AText: string); var ACustomEdit: TCustomEdit absolute AWinControl; begin if (ACustomEdit.MaxLength > 0) and (UTF8Length(AText) > ACustomEdit.MaxLength) then TWin32WSWinControl.SetText(ACustomEdit, UTF8Copy(AText, 1, ACustomEdit.MaxLength)) else TWin32WSWinControl.SetText(ACustomEdit, AText); end; class procedure TWin32WSCustomEdit.Cut(const ACustomEdit: TCustomEdit); begin SendMessage(ACustomEdit.Handle, WM_CUT, 0, 0) end; class procedure TWin32WSCustomEdit.Copy(const ACustomEdit: TCustomEdit); begin SendMessage(ACustomEdit.Handle, WM_COPY, 0, 0) end; class procedure TWin32WSCustomEdit.Paste(const ACustomEdit: TCustomEdit); begin SendMessage(ACustomEdit.Handle, WM_PASTE, 0, 0) end; class procedure TWin32WSCustomEdit.Undo(const ACustomEdit: TCustomEdit); begin SendMessage(ACustomEdit.Handle, EM_UNDO, 0, 0) end; { TWin32WSCustomMemo } class function TWin32WSCustomMemo.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @EditClsName[0]; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, false); // memo is not a transparent control -> no need for parentpainting Params.WindowInfo^.needParentPaint := false; Result := Params.Window; end; class function TWin32WSCustomMemo.GetStrings(const ACustomMemo: TCustomMemo): TStrings; begin Result := TWin32MemoStrings.Create(ACustomMemo.Handle, ACustomMemo) end; class procedure TWin32WSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string); var S: string; begin if Length(AText) > 0 then begin GetText(ACustomMemo, S); S := S + AText; SetText(ACustomMemo, S); end; end; { The index of the first line is zero The index of the caret before the first char is zero If there is a selection, the caret is considered to be right after the last selected char, being that "last" here means the right-most char. } class function TWin32WSCustomMemo.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; var BufferX: Longword; begin { X position calculation } { EM_GETSEL returns the char index of the caret, but this index doesn't go back to zero in new lines, so we need to subtract the char index from the line EM_GETSEL expects a pointer to 32-bits buffer in lParam } Windows.SendMessageW(ACustomEdit.Handle, EM_GETSEL, 0, PtrInt(@BufferX)); { EM_LINEINDEX returns the char index of a given line wParam = -1 indicates the line of the caret } Result.X := BufferX - Windows.SendMessageW(ACustomEdit.Handle, EM_LINEINDEX, -1, 0); { Y position calculation } { EM_LINEFROMCHAR returns the number of the line of a given char index. } Result.Y := Windows.SendMessageW(ACustomEdit.Handle, EM_LINEFROMCHAR, BufferX, 0); end; class procedure TWin32WSCustomMemo.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); var CharIndex: Longword; begin { EM_LINEINDEX returns the char index of a given line } CharIndex := Windows.SendMessageW(ACustomEdit.Handle, EM_LINEINDEX, NewPos.Y, 0) + NewPos.X; { EM_SETSEL expects the character position in char index, which doesn't go back to zero in new lines } Windows.SendMessageW(ACustomEdit.Handle, EM_SETSEL, CharIndex, CharIndex); end; class procedure TWin32WSCustomMemo.SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); begin // TODO: check if can be done without recreation RecreateWnd(ACustomMemo); end; class procedure TWin32WSCustomMemo.SetText(const AWinControl: TWinControl; const AText: string); begin {$ifdef WindowsUnicodeSupport} if UnicodeEnabledOS then SendMessageW(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PWideChar(UTF8ToUTF16(AText)))) else SendMessage(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PChar(Utf8ToAnsi(AText)))); {$else} SendMessage(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PChar(AText))); {$endif} end; class procedure TWin32WSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); begin // TODO: check if can be done without recreation RecreateWnd(ACustomMemo); end; { TWin32WSCustomStaticText } function StaticTextWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var WindowInfo: PWin32WindowInfo; begin // move static text specific code here case Msg of WM_NCPAINT: begin WindowInfo := GetWin32WindowInfo(Window); if Assigned(WindowInfo) and TWin32ThemeServices(ThemeServices).ThemesEnabled and (GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0) then begin TWin32ThemeServices(ThemeServices).PaintBorder(WindowInfo^.WinControl, True); Result := 0; end else Result := WindowProc(Window, Msg, WParam, LParam); end; else Result := WindowProc(Window, Msg, WParam, LParam); end; end; function StaticTextParentMsgHandler(const AWinControl: TWinControl; Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam; var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean; var Info: PWin32WindowInfo; TextColor: TColor; begin Result := False; case Msg of WM_CTLCOLORSTATIC: begin Info := GetWin32WindowInfo(HWND(LParam)); Result := Assigned(Info) and ThemeServices.ThemesEnabled and TCustomStaticText(Info^.WinControl).Transparent; if Result then begin ThemeServices.DrawParentBackground(HWND(LParam), HDC(WParam), nil, False); MsgResult := Windows.GetStockObject(HOLLOW_BRUSH); WinProcess := False; Windows.SetBkMode(HDC(WParam), TRANSPARENT); TextColor := Info^.WinControl.Font.Color; if TextColor = clDefault then TextColor := Info^.WinControl.GetDefaultColor(dctFont); Windows.SetTextColor(HDC(WParam), ColorToRGB(TextColor)); end; end; end; end; function CalcStaticTextFlags( const AAlignment: TAlignment; const ABorder: TStaticBorderStyle; const AShowAccelChar: Boolean): dword; begin Result := AlignmentToStaticTextFlags[AAlignment] or BorderToStaticTextFlags[ABorder] or DWORD(AccelCharToStaticTextFlags[AShowAccelChar]); end; class function TWin32WSCustomStaticText.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := 'STATIC'; WindowTitle := StrCaption; // if control style have SS_NOTIFY then HTCLIENT otherwise HTTRANSPARENT => // so it will not understand mouse if there is no SS_NOTIFY Flags := Flags or SS_NOTIFY or CalcStaticTextFlags(TCustomStaticText(AWinControl).Alignment, TCustomStaticText(AWinControl).BorderStyle, TCustomStaticText(AWinControl).ShowAccelChar); if (TCustomStaticText(AWinControl).BorderStyle = sbsSingle) and ThemeServices.ThemesEnabled then begin Flags := Flags and not WS_BORDER; // under XP WS_BORDER is not themed and there are some problems with redraw FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; // this is themed-border end; SubClassWndProc := @StaticTextWndProc; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; Params.WindowInfo^.ParentMsgHandler := @StaticTextParentMsgHandler; end; class procedure TWin32WSCustomStaticText.GetPreferredSize( const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then begin Inc(PreferredHeight); if TCustomStaticText(AWinControl).BorderStyle <> sbsNone then begin if ThemeServices.ThemesEnabled and (TCustomStaticText(AWinControl).BorderStyle = sbsSingle) then begin inc(PreferredWidth, 4); inc(PreferredHeight, 4); end else begin inc(PreferredWidth, 2); inc(PreferredHeight, 2); end; end; end; end; class procedure TWin32WSCustomStaticText.SetBiDiMode( const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar: Boolean); begin if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then exit; RecreateWnd(AWinControl);//to adjust the update the Alignment end; class procedure TWin32WSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText; const NewAlignment: TAlignment); begin if not WSCheckHandleAllocated(ACustomStaticText, 'SetAlignment') then exit; // can not apply on the fly: needs window recreate RecreateWnd(ACustomStaticText); end; class procedure TWin32WSCustomStaticText.SetStaticBorderStyle( const ACustomStaticText: TCustomStaticText; const NewBorderStyle: TStaticBorderStyle); begin if not WSCheckHandleAllocated(ACustomStaticText, 'SetStaticBorderStyle') then exit; // can not apply on the fly: needs window recreate RecreateWnd(ACustomStaticText); end; class procedure TWin32WSCustomStaticText.SetText( const AWinControl: TWinControl; const AText: String); begin if not WSCheckHandleAllocated(AWinControl, 'SetText') then exit; // maybe we need TWSCustomStaticText.SetShowAccelChar ? if (GetWindowLong(AWinControl.Handle, GWL_STYLE) and SS_NOPREFIX) <> AccelCharToStaticTextFlags[TCustomStaticText(AWinControl).ShowAccelChar] then RecreateWnd(AWinControl); TWSWinControlClass(ClassParent).SetText(AWinControl, AText); end; { TWin32WSButtonControl } class procedure TWin32WSButtonControl.GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then begin Inc(PreferredWidth, 20); Inc(PreferredHeight, 4); if WithThemeSpace then begin Inc(PreferredWidth, 6); Inc(PreferredHeight, 6); end; end; end; { TWin32WSButton } function ButtonWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var Control: TWinControl; LMessage: TLMessage; begin case Msg of WM_PAINT, WM_ERASEBKGND: begin Control := GetWin32WindowInfo(Window)^.WinControl; if not Control.DoubleBuffered then begin LMessage.msg := Msg; LMessage.wParam := WParam; LMessage.lParam := LParam; LMessage.Result := 0; Result := DeliverMessage(Control, LMessage); end else Result := WindowProc(Window, Msg, WParam, LParam); end; WM_PRINTCLIENT: Result := CallDefaultWindowProc(Window, Msg, WParam, LParam); else Result := WindowProc(Window, Msg, WParam, LParam); end; end; class function TWin32WSButton.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @ButtonClsName[0]; SubClassWndProc := @ButtonWndProc; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; end; class procedure TWin32WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); var WindowStyle: dword; begin if not WSCheckHandleAllocated(AButton, 'SetDefault') then Exit; WindowStyle := GetWindowLong(AButton.Handle, GWL_STYLE) and not (BS_DEFPUSHBUTTON or BS_PUSHBUTTON); if ADefault then WindowStyle := WindowStyle or BS_DEFPUSHBUTTON else WindowStyle := WindowStyle or BS_PUSHBUTTON; Windows.SendMessage(AButton.Handle, BM_SETSTYLE, WindowStyle, 1); end; class procedure TWin32WSButton.SetShortCut(const AButton: TCustomButton; const ShortCutK1, ShortCutK2: TShortCut); begin if not WSCheckHandleAllocated(AButton, 'SetShortcut') then Exit; // TODO: implement me! end; { TWin32WSCustomCheckBox } class function TWin32WSCustomCheckBox.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @ButtonClsName[0]; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; end; class procedure TWin32WSCustomCheckBox.GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var iconHeight: integer; begin if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then begin Inc(PreferredWidth, GetSystemMetrics(SM_CXMENUCHECK)); // pixels spacing between checkbox and text if ThemeServices.ThemesEnabled then Inc(PreferredWidth, 4) else Inc(PreferredWidth, 6); iconHeight := GetSystemMetrics(SM_CYMENUCHECK); if iconHeight > PreferredHeight then PreferredHeight := iconHeight; if WithThemeSpace then begin Inc(PreferredWidth, 1); Inc(PreferredHeight, 4); end; end; end; class function TWin32WSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; begin case SendMessage(ACustomCheckBox.Handle, BM_GETCHECK, 0, 0) of BST_CHECKED: Result := cbChecked; BST_INDETERMINATE: Result := cbGrayed; else {BST_UNCHECKED:} Result := cbUnChecked; end; end; class procedure TWin32WSCustomCheckBox.SetShortCut(const ACustomCheckBox: TCustomCheckBox; const ShortCutK1, ShortCutK2: TShortCut); begin // TODO: implement me! end; class procedure TWin32WSCustomCheckBox.SetBiDiMode( const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); begin // UpdateStdBiDiModeFlags(AWinControl); not worked RecreateWnd(AWinControl); end; class procedure TWin32WSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); var Flags: WPARAM; begin case NewState of cbChecked: Flags := Windows.WParam(BST_CHECKED); cbUnchecked: Flags := Windows.WParam(BST_UNCHECKED); else Flags := Windows.WParam(BST_INDETERMINATE); end; //Pass SKIP_LMCHANGE through lParam to avoid the OnChange event be fired Windows.SendMessage(ACustomCheckBox.Handle, BM_SETCHECK, Flags, SKIP_LMCHANGE); end; { TWin32WSToggleBox } class function TWin32WSToggleBox.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @ButtonClsName[0]; WindowTitle := StrCaption; Flags:= Flags or BS_MULTILINE; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; end; { TWin32WSRadioButton } class function TWin32WSRadioButton.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; const BM_SETDONTCLICK = $00F8; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @ButtonClsName[0]; WindowTitle := StrCaption; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; // don't generate a BM_CLICK on focus SendMessage(Result, BM_SETDONTCLICK, 1, 0); end; end.