http://marunguy.blogspot.com/2012/02/tform-class-name.html 에 올린 글을 백업차원에서 여기에 남깁니다.
고수님들의 많은 지적 바랍니다.^^;;
-------------------------------------------------------------------
아래링크를 참조하여 윈도용 라자루스에서 TForm 의 Class Name 을 바꿔보려 했습니다.
http://cbuilder.borlandforum.com/impboard/impboard.dll?action=read&db=bcb_tip&no=1072
라자루스에서 TForm 의 기본 class name 은 'Window' 인데 아래와 같이 해도 'MyClass' 로 바뀌지는 않습니다.
type
{ TFormMain }
TFormMain = class(TForm)
....
protected
PrevWndProc: Windows.WNDPROC;
procedure WndProc( var TheMessage: TLMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TFormMain.CreateParams(var Params: TCreateParams);
begin
inherited;
StrCopy(Params.WinClassName, 'MyClass');
end;
procedure TFormMain.MenuItem2Click(Sender: TObject);
var
class_name :array [0..255] of Char;
ret :LongInt;
begin
ret := GetClassName(WindowHandle, class_name, SizeOf(class_name));
if ret > 0 then
begin
MessageDlg(class_name, mtInformation, [mbOK], 0 )
end;
end;
그래서, 라자루스 포럼에 질문을 올렸더니, 직접 패치를 만들어보라는 대답이 돌아왔습니다. TT_TT;;
http://www.lazarus.freepascal.org/index.php/topic,15941.msg86071.html#msg86071
그래서, 직접 수정해보았습니다.
라자루스 소스를 분석해보면 TCreateParams.WinClassName 를 전혀 사용하지 않고 있습니다.
아래 코드와 같이 대충 동작하도록 만들어보았는데, 윈7, XP 에서 동작하는 것을 확인했습니다.
Ansi 쪽이 호출되는 상황이면 충돌이 발생하는데 그 원인을 모르겠습니다.
파스칼,델파이,라자루스 모두 익숙하지 않은지라 그리 깔끔해보지는 않네요.
고수님들이 손길이 닿으면 좀 더 좋은 코드가 나오리라고 생각됩니다. ^^;;
아, Lazarus-0.9.31-35255-fpc-2.6.1-20120209-win32.exe 에 포함된 소스를 기준으로 작업했습니다.
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