알짜게시판

[Delphi] bsNone 인 폼에서 드래그 및 크기조절

[code]

unit Area;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, Vcl.ExtCtrls,
  JvExControls, JvButton, JvNavigationPane, Vcl.Buttons;

type
  TFrmArea = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Memo1: TMemo;
    JvNavIconButton1: TJvNavIconButton;
    Button1: TButton;
    BitBtn1: TBitBtn;
    SpeedButton1: TSpeedButton;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMNCHitTest(var message: TWMNCHitTest); message WM_NCHITTEST;
  private
  public
    { Public declarations }
  end;

const
  Edge = 5;

var
  FrmArea: TFrmArea;

implementation

{$R *.dfm}

{ TFrmArea }

procedure TFrmArea.CreateParams(var Params: TCreateParams);
begin
  BorderStyle := bsNone;

  inherited;

  Params.WndParent := 0;
  Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;

procedure TFrmArea.FormCreate(Sender: TObject);
begin
  FormResize(Sender);
end;

procedure TFrmArea.FormResize(Sender: TObject);
var
  WindowRgn, HoleRgn : HRgn;
begin
  WindowRgn := 0;
  GetWindowRgn(Handle, WindowRgn);
  DeleteObject(WindowRgn);
  WindowRgn := CreateRectRgn(0, 0, Width, Height);
  HoleRgn := CreateRectRgn(Edge, Edge+Panel1.Height+Edge, Width-Edge, Height-Edge);
  CombineRgn(WindowRgn, WindowRgn, HoleRgn, RGN_DIFF);
  SetWindowRgn(Handle, WindowRgn, TRUE);
  DeleteObject(HoleRgn);
end;

procedure TFrmArea.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, WM_NCLBUTTONDOWN, htCaption, 0);
end;

procedure TFrmArea.WMNCHitTest(var Message: TWMNCHitTest);
var
  P: TPoint;
begin
  inherited;

  P := ScreenToClient(Message.Pos);

  with Message do
  begin
    if Result = htClient then Exit;

    Result := htCaption;

    if P.Y < Edge then
    begin
      if P.X < Edge then
        Result := htTopLeft
      else if P.X > ClientWidth - Edge then
        Result := htTopRight
      else
        Result := htTop;
    end
    else if P.Y > ClientHeight - Edge then
    begin
      if P.X < Edge then
        Result := htBottomLeft
      else if P.X > ClientWidth - Edge then
        Result := htBottomRight
      else
        Result := htBottom;
    end
    else
    begin
      if P.X < Edge then
        Result := htLeft
      else if P.X > ClientWidth - Edge then
        Result := htRight
    end;
  end;
end;

end.
[/code]

로그인 후 댓글내용을 입력해주세요

번호 제목 글쓴이 조회 날짜
243 [파이썬] 동영상 특정 영역 모자이크(흐리게) 하기 7,946 04-30
242 [리눅스] 구글 크롬 콘솔 'Attestation check for Topics on' 에러 원인 & 해결방… 23,177 04-11
241 [크롬] 개발자 도구(DevTools)에서 붙여넣기 안될때 47,684 03-10
240 [그누보드] SmartEditor2Skin.html 다운로드 되는 현상 95,495 01-08
239 [윈도우] 네트워크 탐지 102,601 12-31
238 [Delphi] TrayIcon 이 흐릿하게 보이는 버그? 수정 117,482 12-12
237 [Delphi] 실행 중인 프로세스가 활성 창인지 확인하는 함수 144,855 11-02
236 [Delphi] 메세지 다이어그램(Message Dialog) 에 체크박스(CheckBox) 추가 131,746 10-30
235 [그누보드] 부트스트랩 테마 예제로 사용중인 main.php 114,898 10-21
234 [그누보드] 유튜브 스킨 74,219 10-14
233 [윈도우] TLS 연결 끊김 해결 방법 - Kyber 비활성화 135,671 10-12
232 [PHP] 검색 로봇 접속시 종료 55,901 10-07
231 [윈도우] WinDivert 사용중인 어플리케이션 검색 44,501 09-12
230 [워드프레스] 답글 남기기 메시지 변경 42,371 09-05
229 [리눅스] PHP-FPM 튜닝을 위한 메모리 계산 40,904 08-29
228 [윈도우] 아이폰 벨소리 쉽게 추가하기 93,752 06-14
227 [윈도우] C:\Windows\Installer 폴더 다른 드라이브로 옮기기 104,367 05-29
226 작업 표시줄 (기타 시스템 트레이 아이콘) 제거 프로그램 110,130 05-18
225 [워드프레스] cdn.jsdelivr.net 에서 ssl 인증서 오류 문제 101,804 05-02
224 [그누보드] cdn.jsdelivr.net 에서 ssl 인증서 오류 문제 97,260 05-02
223 [PHP] REQUEST 값 받기(application/json 포함) 98,833 04-20
222 [Linux] 데몬(systemd service) 작성 및 실행하기 65,767 03-14
221 [PHP] Porto 테마에서 포스팅만 Loading Overlay 58,016 03-08
220 [그누보드] 아이디 대신 이메일로 회원 가입하기 89,158 02-02
219 [시크릿DNS] Kaspersky 백신 사용시 DNS 암호화 관련 3 98,773 01-04
218 [칼무리] 영역화면 크기 오류인 경우 121,793 12-12
217 [MySQL] 업데이트 이후 에러 발생([ERROR] Incorrect definition of table … 91,487 12-08
216 구글 크롬 탭검색 비활성화 72,344 12-04
215 [MySQL] MySQL, MariaDB 업데이트 73,595 11-24
214 [아이폰] HTTPS 감청 우회하기 266,859 11-01
213 Windows에 Rust 설치하기 57,499 10-05