::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2003-03-04 21:37:01, Hit : 4437, Vote : 1178
 Hook 을 사용한 커서(캐럿)모양 바꾸기

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
   Edit1: TEdit;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
private
   { Private declarations }
public
   { Public declarations }
   CaretBm : TBitmap;
   CaretBmBk : TBitmap;
   OldEditsWindowProc : Pointer;
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

type
WParameter = LongInt;
LParameter = LongInt;

{New windows procedure for the edit control}
function NewWindowProc(WindowHandle : hWnd;
                      TheMessage   : WParameter;
                      ParamW       : WParameter;
                      ParamL       : LParameter): LongInt stdcall;
begin
{Call the old edit controls windows procedure}
NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc,
                                 WindowHandle,
                                 TheMessage,
                                 ParamW,
                                 ParamL);
if TheMessage = WM_SETFOCUS then begin
   CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
   ShowCaret(WindowHandle);
end;
if TheMessage = WM_KILLFOCUS then begin
   HideCaret(WindowHandle);
   DestroyCaret;
end;
if TheMessage = WM_KEYDOWN then begin
   if ParamW = VK_BACK then
     CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0) else
     CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
   ShowCaret(WindowHandle);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Create a smiling bitmap using the wingdings font}
CaretBm := TBitmap.Create;
CaretBm.Canvas.Font.Name := 'WingDings';
CaretBm.Canvas.Font.Height := Edit1.Font.Height;
CaretBm.Canvas.Font.Color := clWhite;
CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
CaretBm.Canvas.Brush.Color := clBlue;
CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
CaretBm.Canvas.TextOut(1, 1, 'J');

{Create a frowming bitmap using the wingdings font}
CaretBmBk := TBitmap.Create;
CaretBmBk.Canvas.Font.Name := 'WingDings';
CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
CaretBmBk.Canvas.Font.Color := clWhite;
CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
CaretBmBk.Canvas.Brush.Color := clBlue;
CaretBmBk.Canvas.FillRect(Rect(0,
                                0,
                                CaretBmBk.Width,
                                CaretBmBk.Height));
CaretBmBk.Canvas.TextOut(1, 1, 'L');

{Hook the edit controls window procedure}
OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,
                               GWL_WNDPROC,
                               LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Unhook the edit controls window procedure and clean up}
SetWindowLong(Edit1.Handle,
               GWL_WNDPROC,
               LongInt(OldEditsWindowProc));
CaretBm.Free;
CaretBmBk.Free;
end;

end.





651   [데이터베이스] Record number for SQL Query in DBGrid #2  김영대 2003/03/05 4397 1091
650   [윈도우즈 API] 내 프로그램의 화면을 가리는 프로그램 리스트  김영대 2004/07/24 4399 1164
649   [일반/컴포넌트] ListView 의 item 을 강제로 편집상태로 만들기  김영대 2003/03/07 4402 1129
648   [윈도우즈 API] 실행중인 모든 프로그램 Minimized 시키기  김영대 2003/03/06 4405 1175
647   [윈도우즈 API] 윈도우즈"시작" 버튼 Disable/Enable  김영대 2003/03/07 4406 1160
646   [시스템] 윈도우즈 전체의 키보드 입력 금지  김영대 2003/03/07 4407 1169
645   [윈도우즈 API] 휴지통에 파일을 버리는 법  신훈재 2003/03/10 4411 1151
644   [일반/컴포넌트] 문자열의 다음 찾기  김영대 2003/03/07 4414 1299
643   [일반/컴포넌트] StringGrid 에 ReadOnly 제한두기  김영대 2003/03/05 4415 1248
642   [윈도우즈 API] treeview 에 있는 내용을 출력하기  신훈재 2003/03/10 4415 1031
641   [일반/컴포넌트] Adobe Acrobat 이 설치되었는지 검사하기  김영대 2004/08/06 4416 1094
640   [윈도우즈 API] 외부 프로그램의 크기를 내 프로그램에서 변경하기  김영대 2003/03/07 4417 1155
639   [데이터베이스] DBGrid 의 특정필드만 Highlighting 시키기  김영대 2003/03/06 4418 1082
638   [윈도우즈 API] Type Library 목록 구하기  김영대 2004/08/06 4420 1189
637   [시스템] 현재 내 PC의 비디오 정보  김영대 2003/03/04 4421 1170
636   [일반/컴포넌트] RichEdit 에서 문자(열)를 찾아 글자속성 바꾸기  김영대 2003/03/06 4421 1157
635   [일반/컴포넌트] QReport에서 출력된 자료를 Text화일로 저장  김영대 2003/03/04 4422 1219
634   [윈도우즈 API] IE의 현재 url 가져오기  김영대 2003/03/07 4425 1102
633   [윈도우즈 API] 윈도우즈 '시작' 메뉴 Refresh 시키기  김영대 2003/03/07 4426 1371
632   [시스템] 윈도우즈 재시작  김영대 2004/08/30 4427 1129
631   [윈도우즈 API] Taskbar 의 특정 위치에 popup 메뉴 띄우기  김영대 2004/07/24 4432 1160
630   [윈도우즈 API] 모서리가 둥근(rounded ends) TEdit 만들기  김영대 2003/03/07 4433 1236
  [윈도우즈 API] Hook 을 사용한 커서(캐럿)모양 바꾸기  김영대 2003/03/04 4437 1178
628   [데이터베이스] DBGrid 에서 수직 Scroll Bar 감추기  김영대 2003/03/05 4437 1208
627   [윈도우즈 API] 윈도우즈 "시작" 메뉴를 내 프로그램 안으로...  김영대 2003/03/07 4437 1197
626   [일반/컴포넌트] TPanel 로 만든 힌트  김영대 2004/08/05 4438 1110
625   [윈도우즈 API] 클립보드의 내용을 파일로 저장하기  김영대 2003/03/04 4443 1295
624   [윈도우즈 API] 폼에 애니메이션 효과 주기  김영대 2004/07/25 4445 1187
623   [데이터베이스] 델파이 에러코드의 설명(?) 구하기  김영대 2003/03/05 4446 1075
622   [일반/컴포넌트] 제어판의 applet 리스트 (51개)  김영대 2003/03/07 4446 1075
621   [시스템] 기본 프린터가 있어야 실행하지 ?  김영대 2003/03/05 4447 1169
620   [윈도우즈 API] Windows error beep 켜기/끄기  김영대 2003/03/07 4448 1266
619   [일반/컴포넌트] 윈도우즈 제어판 화면 띄우기  김영대 2003/03/07 4450 1200
618   [윈도우즈 API] 레지스트리(registry)를 바꾼후...  김영대 2003/03/05 4451 1196
617   [시스템] 디스플레이 어댑터 목록 구하기  김영대 2004/08/11 4453 1176
616   [시스템] 두개의 파일이 완전히 동일한지 검사하기(CRC32)  김영대 2003/03/05 4454 1048
615   [일반/컴포넌트] TListView Subcolumn Sorting  김영대 2003/03/06 4456 1146
614   [일반/컴포넌트] URL encoding 하기  김영대 2003/03/30 4456 1142
613   [일반/컴포넌트] 커서(Cursor)의 이미지 구하기  김영대 2003/03/27 4457 1231
612   [일반/컴포넌트] 화면변경시 콤포넌트 위치와 크기를 조정  김영대 2003/03/06 4458 1073

[1][2][3][4][5][6][7][8] 9 [10]..[25] [다음 10개]
 

Copyright 1999-2020 Zeroboard / skin by zero