FreePascal Programming Forum
C++Builder  |  Delphi  |  FireMonkey  |  C/C++  |  Free Pascal  |  Firebird
볼랜드포럼 BorlandForum
 경고! 게시물 작성자의 사전 허락없는 메일주소 추출행위 절대 금지
FreePacal 포럼
Q & A
FAQ
팁&트릭
강좌/문서
자료실
볼랜드포럼 홈
헤드라인 뉴스
IT 뉴스
공지사항
자유게시판
해피 브레이크
공동 프로젝트
구인/구직
회원 장터
건의사항
운영진 게시판
회원 메뉴
북마크
델마당
볼랜드포럼 광고 모집

FreePascal 팁&트릭
[7] [라자루스] TForm 생성시 class name 바꾸기..
MarunGuy [marunguy] 6611 읽음    2012-02-09 19:28
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

+ -

관련 글 리스트
7 [라자루스] TForm 생성시 class name 바꾸기.. MarunGuy 6611 2012/02/09
Google
Copyright © 1999-2015, borlandforum.com. All right reserved.