I try to change the class name of TForm instance on win32.
The simple way is to change the ClsName variable in lazarus\lcl\interfaces\win32\win32int.pp.
But, I want to change the class name of TFormMine instance.
Below is modified code of lazarus/lcl/interfaces/win32/win32wsforms.pp.
Lazarus-0.9.31-35255-fpc-2.6.1-20120209-win32.exe is used.
As, I am a begginer for lazarus and pascal, it doesn't looks graceful.
Also, I attach the patch file.
Alhough it works for me and tested on Win7, XP.
if Ansi mode (WindowsUnicodeSupport not defined or UnicodeEnabledOS False ) build, it crashed.
What is wrong?
Who help me?
unit Win32WSForms;
{$mode objfpc}{$H+}
{$I win32defines.inc} // added
interface
class function TWin32WSCustomForm.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Params: TCreateWindowExParams;
lForm: TCustomForm absolute AWinControl;
Bounds: TRect;
SystemMenu: HMenu;
// addtion start
WindowClass: WndClass;
{$ifdef WindowsUnicodeSupport}
WindowClassW: WndClassW;
{$endif}
AErrorCode: Cardinal;
// addtion end
begin
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
// customization of Params
with Params do
begin
if (Parent = 0) then
begin
......
end;
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName[0];
// addtion start
if AParams.WinClassName[0] <> #0 then
begin
pClassName := @AParams.WinClassName[0];
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
begin
if not GetClassInfoW(System.HInstance(), PWideChar(WideString(pClassName)), @WindowClassW) then
begin
if GetClassInfoW(System.HInstance(), PWideChar(WideString(ClsName)), @WindowClassW) then
begin
WindowClassW.lpszClassName:=PWideChar(WideString(pClassName));
if Windows.RegisterClassW(@WindowClassW) = 0 then
begin
AErrorCode := GetLastError;
//DebugLn(['Failed to RegisterClassW, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to RegisterClassW, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end
else
begin
AErrorCode := GetLastError;
//DebugLn(['Failed to GetClassInfoW, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to GetClassInfoW, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end;
end
else
{$endif}
begin
FillChar(WindowClass, SizeOf(WindowClass),0);
if not GetClassInfo(System.HInstance(), pClassName, @WindowClass) then
begin
if GetClassInfo(System.HInstance(), PChar(AnsiString(ClsName)), @WindowClass) then
begin
WindowClass.lpszClassName:=pClassName;
if Windows.RegisterClass(@WindowClass) = 0 then
begin
AErrorCode := GetLastError;
//DebugLn(['Failed to RegisterClass, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to RegisterClass, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end
else
begin
AErrorCode := GetLastError;
//DebugLn(['Failed to GetClassInfo, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to GetClassInfo, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end;
end;
end;
// addtion end
WindowTitle := StrCaption;
AdjustFormBounds(lForm, Bounds);
if (lForm.Position in [poDefault, poDefaultPosOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Recent
