diff --git a/lcl/interfaces/wince/wincememostrings.inc b/lcl/interfaces/wince/wincememostrings.inc index 12f807bf8e..c21d1c54bc 100644 --- a/lcl/interfaces/wince/wincememostrings.inc +++ b/lcl/interfaces/wince/wincememostrings.inc @@ -34,25 +34,22 @@ TWinCEMemoStrings = class(TStrings) function TWinCEMemoStrings.GetLineLength(Index: Integer): Integer; begin - Result := SendMessage(fHandle, EM_LINELENGTH, SendMessage(fHandle, EM_LINEINDEX, Index, 0),0); + Result := SendMessageW(fHandle, EM_LINELENGTH, SendMessage(fHandle, EM_LINEINDEX, Index, 0),0); end; function TWinCEMemoStrings.GetLineStart(Index: Integer): Integer; begin - Result := SendMessage(fHandle, EM_LINEINDEX, Index, 0); + Result := SendMessageW(fHandle, EM_LINEINDEX, Index, 0); end; function TWinCEMemoStrings.GetTextStr: string; -var - CapLen: dword; - Caption: PChar; begin Result := GetControlText(fHandle); end; function TWinCEMemoStrings.GetRealCount: integer; begin - Result := SendMessage(fHandle, EM_GETLINECOUNT, 0, 0); + Result := SendMessageW(fHandle, EM_GETLINECOUNT, 0, 0); end; function TWinCEMemoStrings.GetCount: integer; @@ -63,16 +60,17 @@ end; function TWinCEMemoStrings.Get(Index: Integer): string; var -textbuf: PWideChar; -fLength: Integer; + textbuf: PWideChar; + fLength: Integer; begin fLength := GetLineLength(Index); if fLength = 0 then Result := '' - else begin + else + begin textbuf := PWideChar(SysAllocStringLen(nil,fLength+1)); PWord(textbuf)^ := Word(fLength+1); - SendMessage(fHandle, EM_GETLINE, Index, lparam(textbuf)); - Result := WideStringToString(WideString(textbuf)); + SendMessageW(fHandle, EM_GETLINE, Index, lparam(textbuf)); + Result := UTF8Encode(WideString(textbuf)); SysFreeString(textbuf); end; end; diff --git a/lcl/interfaces/wince/winceproc.pp b/lcl/interfaces/wince/winceproc.pp index b050f557a4..a44f2ceead 100644 --- a/lcl/interfaces/wince/winceproc.pp +++ b/lcl/interfaces/wince/winceproc.pp @@ -43,8 +43,6 @@ Type ); end; -function LCLStringToPWideChar(inString: string): PWideChar; -function WideStringToString(inWideString : WideString) : String; function WM_To_String(WM_Message: Integer): string; function WindowPosFlagsToString(Flags: UINT): string; procedure EventTrace(Message: String; Data: TObject); @@ -114,45 +112,6 @@ uses SysUtils, LCLStrConsts, Dialogs, StdCtrls, ExtCtrls, LCLIntf; //remove this unit when GetWindowSize is moved to TWSWinControl -{ Converts a LCL string into a PWideChar. - - With Unicode support activated the input string must be in - UTF-8 encoding. - - Note that this function will alloc a new PWideChar - and the caller is responsible for freeing it with FreeMem -} -function LCLStringToPWideChar(inString: string): PWideChar; -var - WideBuffer: widestring; -begin - { Converts to a buffer } - WideBuffer := Utf8Decode(inString); - - { Allocates memory for the string } - Result := GetMem(Length(WideBuffer) * 2 + 2); - - { Copies to the final destination } - WideStrLCopy(PWideChar(WideBuffer), Result, Length(WideBuffer)); -end; - -{ well this is different from normal string(widestring) - or other rtl functions because it uses windows local codepage - better name for this?! } -function WideStringToString(inWideString : WideString) : String; -var - tmpStr : PChar; - inStrLen: integer; -begin - inStrLen := Length(inWideString); - tmpStr := StrAlloc(inStrLen+1); - WideCharToMultiByte(CP_ACP, 0, PWideChar(inWideString), -1, tmpStr, inStrLen,nil,nil); - char((tmpStr+inStrLen)^) := #0; - Result := string(tmpStr); - StrDispose(tmpStr); -end; - - {------------------------------------------------------------------------------ Function: WM_To_String Params: WM_Message - a WinDows message @@ -1139,22 +1098,21 @@ var buf: pointer; lenBuf: dword; fixedInfo: ^VS_FIXEDFILEINFO; - tmpText : PWideChar; + WideBuffer: widestring; begin Result := $FFFFFFFF; - tmpText := LCLStringToPWideChar(FileName); - lenBuf := GetFileVersionInfoSizeW(tmpText, lenBuf); + WideBuffer := UTF8Decode(FileName); + lenBuf := GetFileVersionInfoSizeW(PWideChar(WideBuffer), lenBuf); if lenBuf > 0 then begin GetMem(buf, lenBuf); - if GetFileVersionInfoW(tmpText, 0, lenBuf, buf) then + if GetFileVersionInfoW(PWideChar(WideBuffer), 0, lenBuf, buf) then begin VerQueryValue(buf, '\', pointer(fixedInfo), lenBuf); Result := fixedInfo^.dwFileVersionMS; end; FreeMem(buf); end; - FreeMem(tmpText); end; function AllocWindowInfo(Window: HWND): PWindowInfo; @@ -1284,7 +1242,7 @@ begin TextLen := GetWindowTextLength(AHandle); tmpWideStr := PWideChar(SysAllocStringLen(nil,TextLen + 1)); GetWindowTextW(AHandle, tmpWideStr, TextLen + 1); - Result := WideStringToString(widestring(tmpWideStr)); + Result := UTF8Encode(widestring(tmpWideStr)); SysFreeString(tmpWideStr); end; diff --git a/lcl/interfaces/wince/wincewinapi.inc b/lcl/interfaces/wince/wincewinapi.inc index 367d0aca72..7c84b39078 100644 --- a/lcl/interfaces/wince/wincewinapi.inc +++ b/lcl/interfaces/wince/wincewinapi.inc @@ -1252,57 +1252,57 @@ function TWinCEWidgetSet.CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHead dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: UINT): HBITMAP; var -hbit,htargetbit : HBITMAP; -lpDestBits : PChar; -dwLen : longint; -lpH:TBitmapInfoHeader; -orig_bitcount,nPadWidth,pad:integer; -i,dwError:longint; -d:PByte; -s,s0:PWord; -pixel:word; -dc2:HDC; + hbit,htargetbit : HBITMAP; + lpDestBits : PChar; + dwLen : longint; + lpH:TBitmapInfoHeader; + orig_bitcount,nPadWidth,pad:integer; + i,dwError:longint; + d:PByte; + s,s0:PWord; + pixel:word; + dc2:HDC; begin -nPadWidth := 4; -lpH := InfoHeader; -lpH.biSize:=sizeof(TBitmapInfoHeader); + nPadWidth := 4; + lpH := InfoHeader; + lpH.biSize:=sizeof(TBitmapInfoHeader); -if lpH.biWidth mod nPadWidth <> 0 then -pad := nPadWidth - lpH.biWidth mod nPadWidth; -// there are problems with padding. i dont know the rules -// anymore... -pad := 0; -// This is wrong when the infoheader is followed by color data... -// We hope that biSizeImage is set then... -dwLen := ((lpH.biWidth+pad) * abs(lpH.biHeight) * lpH.biBitCount) div 8; -// includes colordata, if any... -if lpH.biSizeImage <> 0 then -dwLen := lpH.biSizeImage; -orig_bitcount := lpH.biBitCount; + if lpH.biWidth mod nPadWidth <> 0 then + pad := nPadWidth - lpH.biWidth mod nPadWidth; + // there are problems with padding. i dont know the rules + // anymore... + pad := 0; + // This is wrong when the infoheader is followed by color data... + // We hope that biSizeImage is set then... + dwLen := ((lpH.biWidth+pad) * abs(lpH.biHeight) * lpH.biBitCount) div 8; + // includes colordata, if any... + if lpH.biSizeImage <> 0 then + dwLen := lpH.biSizeImage; + orig_bitcount := lpH.biBitCount; -{if unaligned(InitInfo.bmiHeader.biBitCount) = 16 then -unaligned(InitInfo.bmiHeader.biBitCount) := 24;} + {if unaligned(InitInfo.bmiHeader.biBitCount) = 16 then + unaligned(InitInfo.bmiHeader.biBitCount) := 24;} -{hbit := windows.CreateDIBSection( dc, windows.PBITMAPINFO(@lph)^, - DIB_RGB_COLORS, lpDestBits, 0, 0);} -//getmem(lpDestBits,dwLen); -hbit := Windows.CreateBitmap( lpH.biWidth, abs(lpH.biHeight),1,InitInfo.bmiHeader.biBitCount,InitBits); + {hbit := windows.CreateDIBSection( dc, windows.PBITMAPINFO(@lph)^, + DIB_RGB_COLORS, lpDestBits, 0, 0);} + //getmem(lpDestBits,dwLen); + hbit := Windows.CreateBitmap( lpH.biWidth, abs(lpH.biHeight),1,InitInfo.bmiHeader.biBitCount,InitBits); -//dc2:=windows.getdc(0); -//htargetbit := Windows.CreateCompatibleBitmap( dc2,lpH.biWidth, abs(lpH.biHeight)); + //dc2:=windows.getdc(0); + //htargetbit := Windows.CreateCompatibleBitmap( dc2,lpH.biWidth, abs(lpH.biHeight)); -//SelectObject(dc,hbit); -//SelectObject(dc2,htargetbit); -//BitBlt(dc2,0, 0, lpH.biWidth, abs(lpH.biHeight), Dc, 0, 0, SRCPAINT); -result := hbit; -//DeleteObject(dc2); -//DeleteObject(hbit); + //SelectObject(dc,hbit); + //SelectObject(dc2,htargetbit); + //BitBlt(dc2,0, 0, lpH.biWidth, abs(lpH.biHeight), Dc, 0, 0, SRCPAINT); + result := hbit; + //DeleteObject(dc2); + //DeleteObject(hbit); -exit; + exit; -//hbit := CreateDIBSection(dc, InitInfo, DIB_RGB_COLORS, lpDestBits, 0, 0); -//if (hbit <> 0) then - begin + //hbit := CreateDIBSection(dc, InitInfo, DIB_RGB_COLORS, lpDestBits, 0, 0); + //if (hbit <> 0) then + begin if (orig_bitcount = 16) then begin @@ -1360,7 +1360,6 @@ end; The GetFocus function retrieves the handle of the window that has the focus. ------------------------------------------------------------------------------} - function TWinCEWidgetSet.GetFocus: HWND; begin Result := Windows.GetFocus; @@ -1592,7 +1591,7 @@ end; ------------------------------------------------------------------------------} function TWinCEWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; var -tmw: TTextMetricW; + tmw: TTextMetricW; begin Assert(False, Format('Trace:> TODO FINISH[TWinCEWidgetSet.GetTextMetrics] DC: 0x%x', [DC])); Result := Boolean(Windows.GetTextMetrics(DC, @TMw)); diff --git a/lcl/interfaces/wince/wincewsbuttons.pp b/lcl/interfaces/wince/wincewsbuttons.pp index 5db836902e..812034a379 100644 --- a/lcl/interfaces/wince/wincewsbuttons.pp +++ b/lcl/interfaces/wince/wincewsbuttons.pp @@ -160,7 +160,7 @@ begin // DFCS_ADJUSTRECT doesnot work InflateRect(DrawRect, -4, -4); - ButtonCaption := LCLStringToPWideChar(BitBtn.Caption); + ButtonCaption := PWideChar(UTF8Decode(BitBtn.Caption)); // gather info about bitbtn if BitBtn.Glyph.Empty then begin @@ -234,7 +234,6 @@ begin DrawBitmap; SelectObject(DrawStruct^._hDC, OldFontHandle); - FreeMem(ButtonCaption); end; diff --git a/lcl/interfaces/wince/wincewscomctrls.pp b/lcl/interfaces/wince/wincewscomctrls.pp index e90c9506b5..4c5b4c68fa 100644 --- a/lcl/interfaces/wince/wincewscomctrls.pp +++ b/lcl/interfaces/wince/wincewscomctrls.pp @@ -188,13 +188,6 @@ type private protected public -{$ifdef OldToolbar} - class function CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): HWND; override; - class function GetButtonCount(const AToolBar: TToolBar): integer; override; - class procedure InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); override; - class procedure DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); override; -{$endif} end; { TWinCEWSTrackBar } @@ -347,15 +340,12 @@ begin end; class procedure TWinCEWSStatusBar.SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); -var -tmpSimpleText : PWideChar; begin if AStatusBar.SimplePanel then - begin - tmpSimpleText := LCLStringToPWideChar(AStatusBar.SimpleText); - Windows.SendMessageW(AStatusBar.Handle, SB_SETTEXT, 255, LPARAM(PWideChar(tmpSimpleText))); - FreeMem(tmpSimpleText); - end + begin + Windows.SendMessageW(AStatusBar.Handle, SB_SETTEXT, 255, + LPARAM(PWideChar(UTF8Decode(AStatusBar.SimpleText)))); + end else UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]); end; @@ -442,84 +432,6 @@ begin Windows.SendMessage(AProgressBar.Handle, PBM_SETPOS, Windows.WPARAM(NewPosition), 0); end; -{ TWinCEWSToolbar} - -{$IFDEF OldToolbar} -class function TWinCEWSToolBar.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): HWND; -var - Params: TCreateWindowExParams; - init : TINITCOMMONCONTROLSEX; -begin - init.dwSize := Sizeof(TINITCOMMONCONTROLSEX); - init.dwICC := ICC_BAR_CLASSES; - InitCommonControlsEx(@init); - // general initialization of Params - PrepareCreateWindow(AWinControl, Params); - // customization of Params - with Params do - begin - FlagsEx := WS_EX_TOPMOST; - pClassName := TOOLBARCLASSNAME; - Flags := WS_CHILD or TBSTYLE_FLAT or TBSTYLE_LIST or WS_VISIBLE or TBS_HORZ or TBS_BOTH or TBS_NOTICKS or TBS_FIXEDLENGTH;//Flags {or CCS_ADJUSTABLE}; - end; - // create window - FinishCreateWindow(AWinControl, Params, false); - Result := Params.Window; -end; - -class function TWinCEWSToolbar.GetButtonCount(const AToolBar: TToolBar): integer; -begin - Result := SendMessage(AToolbar.Handle, TB_BUTTONCOUNT, 0, 0) -end; - -class procedure TWinCEWSToolbar.InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); -var - PStr, PStr2: PWideChar; - Num: Integer; - TBB: TBBUTTON; -begin - // TODO: check correctness / clean up - Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!'); - Assert(False, 'Trace:Toolbutton being inserted'); - Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!'); - If (AControl is TWinControl) Then - Begin - PStr := StringToPWideChar(TToolButton(AControl).Caption); - End - Else - Begin - Raise Exception.Create('Can not assign this control to the toolbar'); - Exit; - End; - - Num := TToolbar(TWinControl(AControl).Parent).Buttonlist.IndexOf(TControl(AControl)); - If Num < 0 Then - Num := TToolbar(TWinControl(AControl).Parent).Buttonlist.Count + 1; - Assert(False, Format('Trace:Num = %d in LM_INSERTTOOLBUTTON', [Num])); - - With tbb Do - Begin - iBitmap := Num; - idCommand := Num; - fsState := TBSTATE_ENABLED; - fsStyle := TBSTYLE_BUTTON; - iString := Integer(PStr); - End; - - SendMessage(TWinControl(AControl).Parent.Handle, TB_BUTTONSTRUCTSIZE, SizeOf(TBBUTTON), 0); - SendMessage(TWinControl(AControl).Parent.Handle, TB_ADDBUTTONS, 1, LParam(LPTBButton(@tbb))); - FreeMem(PStr); - Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!'); -end; - -class procedure TWinCEWSToolbar.DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); -begin - // TODO: code buggy, Index of button to delete ?! - SendMessage(AToolBar.Handle, TB_DELETEBUTTON, 0, 0); -end; -{$ENDIF} - { TWinCEWSTrackBar } class function TWinCEWSTrackBar.CreateHandle(const AWinControl: TWinControl; @@ -600,9 +512,6 @@ initialization // RegisterWSComponent(TCustomUpDown, TWinCEWSCustomUpDown); // RegisterWSComponent(TCustomUpDown, TWinCEWSUpDown); // RegisterWSComponent(TCustomToolButton, TWinCEWSToolButton); -{$ifdef OldToolbar} - RegisterWSComponent(TToolBar, TWinCEWSToolBar); -{$endif} RegisterWSComponent(TCustomTrackBar, TWinCEWSTrackBar); // RegisterWSComponent(TCustomTreeView, TWinCEWSCustomTreeView); // RegisterWSComponent(TCustomTreeView, TWinCEWSTreeView); diff --git a/lcl/interfaces/wince/wincewscustomlistview.inc b/lcl/interfaces/wince/wincewscustomlistview.inc index b2caff4f81..fc0fcc70f7 100644 --- a/lcl/interfaces/wince/wincewscustomlistview.inc +++ b/lcl/interfaces/wince/wincewscustomlistview.inc @@ -114,13 +114,12 @@ begin lvc.Mask := LVCF_TEXT; {$ifdef Win32} - lvc.pszText := PChar(LCLStringToPWideChar(AColumn.Caption)); + lvc.pszText := PChar(PWideChar(UTF8Decode(AColumn.Caption))); SendMessage(ALV.Handle, LVM_INSERTCOLUMNW, WPARAM(AIndex), LPARAM(@lvc)); {$else} - lvc.pszText := LCLStringToPWideChar(AColumn.Caption); + lvc.pszText := PWideChar(UTF8Decode(AColumn.Caption)); ListView_InsertColumn(ALV.Handle, AIndex, lvc); {$endif} - FreeMem(lvc.pszText); end; class procedure TWinCEWSCustomListView.ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn); @@ -204,13 +203,12 @@ begin lvc.Mask := LVCF_TEXT; {$ifdef Win32} - lvc.pszText := PChar(LCLStringToPWideChar(ACaption)); + lvc.pszText := PChar(PWideChar(UTF8Decode(ACaption))); SendMessageW(ALV.Handle, LVM_SETCOLUMNW, WPARAM(AIndex), LPARAM(@lvc)); {$else} - lvc.pszText := LCLStringToPWideChar(ACaption); + lvc.pszText := PWideChar(UTF8Decode(ACaption)); ListView_SetColumn(ALV.Handle, AIndex, lvc); {$endif} - FreeMem(lvc.pszText); end; class procedure TWinCEWSCustomListView.ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer); @@ -316,13 +314,12 @@ begin lvi.iSubItem := 0; {$ifdef Win32} - lvi.pszText := PChar(LCLStringToPWideChar(AItem.Caption)); + lvi.pszText := PChar(PWideChar(UTF8Decode(AItem.Caption))); SendMessageW(ALV.Handle, LVM_INSERTITEMW, 0, LPARAM(@lvi)); {$else} - lvi.pszText := LCLStringToPWideChar(AItem.Caption); + lvi.pszText := PWideChar(UTF8Decode(AItem.Caption)); ListView_InsertItem(ALV.Handle, lvi); {$endif} - FreeMem(lvi.pszText); end; class procedure TWinCEWSCustomListView.ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer); @@ -356,9 +353,8 @@ begin end; class procedure TWinCEWSCustomListView.ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex: Integer; const AText: String); -var - tmpAText : PWideChar; {$ifdef Win32} +var _gnu_lvi : LV_ITEM; {$endif} begin @@ -371,9 +367,7 @@ begin SendMessageW(ALV.Handle, LVM_SETITEMTEXTW, WPARAM(AIndex), LPARAM(@_gnu_lvi)); {$else} - tmpAText := LCLStringToPWideChar(AText); - ListView_SetItemText(ALV.Handle, AIndex, ASubIndex, tmpAText); - FreeMem(tmpAText); + ListView_SetItemText(ALV.Handle, AIndex, ASubIndex, PWideChar(UTF8Decode(AText))); {$endif} end; diff --git a/lcl/interfaces/wince/wincewsforms.pp b/lcl/interfaces/wince/wincewsforms.pp index cfe4998d45..06e46ddcc2 100644 --- a/lcl/interfaces/wince/wincewsforms.pp +++ b/lcl/interfaces/wince/wincewsforms.pp @@ -94,23 +94,18 @@ type TWinCEWSCustomForm = class(TWSCustomForm) private -// class procedure SetSlots(const QtCustomForm: TQtCustomForm); protected public - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; - -{ class procedure DestroyHandle(const AWinControl: TWinControl); override;} - - procedure SetBounds(const AWinControl: TWinControl; - const ALeft, ATop, AWidth, AHeight: Integer); - + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; + class procedure SetBounds(const AWinControl: TWinControl; + const ALeft, ATop, AWidth, AHeight: Integer); override; + class procedure SetBorderIcons(const AForm: TCustomForm; + const ABorderIcons: TBorderIcons); override; class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override; class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override; class procedure ShowModal(const ACustomForm: TCustomForm); override; - class procedure SetBorderIcons(const AForm: TCustomForm; - const ABorderIcons: TBorderIcons); override; end; { TWinCEWSForm } @@ -305,7 +300,7 @@ begin RecreateWnd(AForm); end; -procedure TWinCEWSCustomForm.SetBounds(const AWinControl: TWinControl; +class procedure TWinCEWSCustomForm.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); var SizeRect: Windows.RECT;