Понедельник, 13.05.2024, 16:12
Приветствую Вас Гость

LabSoft

Меню сайта
Категории каталога
Статьи по кодингу [24]
Материалы по кодингу
КреатиFF [144]
Рассказы, истории, анекдоты...
Разное [8]
Советы, трюки, полезные рекомендации, статьи о новом и забытом старом...
Наш опрос
Какой язык программирования Вы используете?
Всего ответов: 40
Главная » Статьи » Статьи по кодингу

Создание скинов на WinAPI в Delphi.
program custwinskin;
uses Windows, Messages;
type
HANDLE = HWND;
POINT = TPOINT;
RECT = TRECT;
const
NULL = 0;
const
CAPTIONHEIGHT =16;
SIZEBORDER =4;
MINIMUMWIDTH=64;
MINIMUMHEIGHT=CAPTIONHEIGHT;
INNERBORDER=FALSE;
var
//.data
szApplicationName :Pchar='Custom Window & Skins Example';
szBackMain :Pchar='images\back_01.bmp';
szBackCapt :Pchar='images\capt_01.bmp';
szSkinsMain:Pchar='skins\';
szSkinsMainFind:Pchar='skins\*.*';
szSkinsDefault:Pchar='default';
szSk_Title_Left:Pchar='\title_l.bmp';
szSk_Title_Right:Pchar='\title_r.bmp';
szSk_Title_Middle:Pchar='\title_m.bmp';
szSk_Title_Rollup:Pchar='\title_u.bmp';
szSk_Title_Minimize:Pchar='\title_n.bmp';
szSk_Title_Close:Pchar='\title_c.bmp';
szSk_Title_RollupS:Pchar='\title_us.bmp';
szSk_Title_RollupP:Pchar='\title_up.bmp';
szSk_Title_MinimizeS:Pchar='\title_ns.bmp';
szSk_Title_MinimizeP:Pchar='\title_np.bmp';
szSk_Title_CloseS:Pchar='\title_cs.bmp';
szSk_Title_CloseP:Pchar='\title_cp.bmp';
szSk_Title_Title:Pchar='\title_t.bmp';
szSk_Main_Back:Pchar='\main_b.bmp';

var
hSkinTitle_Left:HANDLE;
hSkinTitle_Right:HANDLE;
hSkinTitle_Middle:HANDLE;
hSkinTitle_Rollup:HANDLE;
hSkinTitle_Minimize:HANDLE;
hSkinTitle_Close:HANDLE;
hSkinTitle_RollupS:HANDLE;
hSkinTitle_RollupP:HANDLE;
hSkinTitle_MinimizeS:HANDLE;
hSkinTitle_MinimizeP:HANDLE;
hSkinTitle_CloseS:HANDLE;
hSkinTitle_CloseP:HANDLE;
hSkinTitle_Title:HANDLE;
hSkinMain_Back:HANDLE;

hbSkinTitle_Middle:HANDLE;
hbSkinMain_Back:HANDLE;
bCloseSelected:BOOL = false;
bClosePressed:BOOL = false;
bRollupSelected:BOOL = false;
bRollupPressed:BOOL = false;
bMinimizeSelected:BOOL = false;
bMinimizePressed:BOOL = false;
hCursNorm:HANDLE;
hCursMove:HANDLE;
hCursSH:HANDLE;
hCursSV:HANDLE;
hCursSTR:HANDLE;
hCursSTL:HANDLE;
dInitialHeight:DWORD;
WindowMoving:BOOL = false;
MovingStart:POINT;
CursorChange:BOOL = false;
SizeType:DWORD;

{$R rsrc.res}

function StrPas(Str: PChar): string;
begin
Result := Str;
end;

Function LoadSkinPart (lpszSkinsDir:Pchar; lpszPart:Pchar):HANDLE;
var
szFullPath:array [0..MAX_PATH] of char;
begin
lstrcpy(szFullPath, lpszSkinsDir);
lstrcat(szFullPath, lpszPart);
Result:=LoadImage (hInstance, szFullPath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
end;

Procedure LoadSkin(lpszSkinName:Pchar);
var
szFullSkin:array [0..MAX_PATH] of char;
begin
lstrcpy (szFullSkin, szSkinsMain);
lstrcat (szFullSkin, lpszSkinName);

hSkinTitle_Left := LoadSkinPart (szFullSkin, szSk_Title_Left);
hSkinTitle_Right := LoadSkinPart (szFullSkin, szSk_Title_Right);
hSkinTitle_Middle := LoadSkinPart (szFullSkin, szSk_Title_Middle);
hbSkinTitle_Middle := CreatePatternBrush(hSkinTitle_Middle);
hSkinTitle_Rollup := LoadSkinPart (szFullSkin, szSk_Title_Rollup);
hSkinTitle_Minimize := LoadSkinPart (szFullSkin, szSk_Title_Minimize);
hSkinTitle_Close := LoadSkinPart (szFullSkin, szSk_Title_Close);
hSkinTitle_RollupS := LoadSkinPart (szFullSkin, szSk_Title_RollupS);
hSkinTitle_RollupP := LoadSkinPart (szFullSkin, szSk_Title_RollupP);
hSkinTitle_MinimizeS := LoadSkinPart (szFullSkin, szSk_Title_MinimizeS);
hSkinTitle_MinimizeP := LoadSkinPart (szFullSkin, szSk_Title_MinimizeP);
hSkinTitle_CloseS := LoadSkinPart (szFullSkin, szSk_Title_CloseS);
hSkinTitle_CloseP := LoadSkinPart (szFullSkin, szSk_Title_CloseP);
hSkinTitle_Title := LoadSkinPart (szFullSkin, szSk_Title_Title);
hSkinMain_Back := LoadSkinPart (szFullSkin, szSk_Main_Back);
hbSkinMain_Back := CreatePatternBrush(hSkinMain_Back);
end;

Procedure KillSkin;
begin
DeleteObject(hSkinTitle_Left);
DeleteObject(hSkinTitle_Right);
DeleteObject(hSkinTitle_Middle);
DeleteObject(hbSkinTitle_Middle);
DeleteObject(hSkinTitle_Rollup);
DeleteObject(hSkinTitle_Minimize);
DeleteObject(hSkinTitle_Close);
DeleteObject(hSkinTitle_RollupS);
DeleteObject(hSkinTitle_RollupP);
DeleteObject(hSkinTitle_MinimizeS);
DeleteObject(hSkinTitle_MinimizeP);
DeleteObject(hSkinTitle_CloseS);
DeleteObject(hSkinTitle_CloseP);
DeleteObject(hSkinTitle_Title);
DeleteObject(hSkinMain_Back);
DeleteObject(hbSkinMain_Back);
end;

Function PointInRect (p:POINT; r:RECT):boolean;
begin
Result:=PtInRect(r,p);
end;

Procedure LoadSkinNames (hList:DWORD);
var
ffSkins: WIN32_FIND_DATA;
hff:DWORD;
bff:bool;
begin
SendMessage (hList, CB_ADDSTRING, 0, Longint(szSkinsDefault));
hff:= FindFirstFile (szSkinsMainFind, ffSkins);
IF hff = INVALID_HANDLE_VALUE then exit;
bff:= hff<>0;
WHILE bff do
begin
if(ffSkins.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
IF (StrPas(ffSkins.cFileName) <> '.') and (StrPas(ffSkins.cFileName) <> '..') then
if lstrcmpi (szSkinsDefault, ffSkins.cFileName)<>0 then
SendMessage (hList, CB_ADDSTRING, 0, Longint(@ffSkins.cFileName));
bff:=FindNextFile (hff, ffSkins);
end;
SendMessage(hList, CB_SETCURSEL, 0, 0);
SendMessage(hList, CB_SHOWDROPDOWN, 0, 0);
SetWindowPos (hList, HWND_BOTTOM, 0, 0, 120, 90, SWP_NOMOVE);
end;

function DlgProc(hDlg:HWND;uMsg:UINT;wParam:WPARAM;lParam:LPARAM):LongInt;stdcall;
var
r:RECT;
p:POINT;
hdc_db:DWORD;
hdc_bmp:DWORD;
hm_bmp:DWORD;
nSkinNum:DWORD;
szNewSkin:array [0..MAX_PATH] of char;
temp : Longint;
eax: Longword;
begin
Result:=0;
case uMsg of
WM_INITDIALOG:
begin
SetWindowText (hDlg, szApplicationName);
LoadSkin (szSkinsDefault);
hCursNorm := LoadCursor (NULL, IDC_ARROW);
hCursMove := LoadCursor (NULL, IDC_SIZEALL);
hCursSV := LoadCursor (NULL, IDC_SIZENS);
hCursSH := LoadCursor (NULL, IDC_SIZEWE);
hCursSTR := LoadCursor (NULL, IDC_SIZENWSE);
hCursSTL := LoadCursor (NULL, IDC_SIZENESW);
GetClientRect (hDlg, r);
dInitialHeight := r.bottom;
LoadSkinNames(GetDlgItem (hDlg, 3000));
end;
WM_ERASEBKGND:
begin
GetClientRect (hDlg, r);
hdc_db := CreateCompatibleDC (wParam);
hm_bmp := CreateCompatibleBitmap (wParam, r.right, r.bottom);
eax := SelectObject (hdc_db, hm_bmp);
hdc_bmp := CreateCompatibleDC (wParam);
SelectObject (hdc_bmp, hSkinTitle_Left);
BitBlt (hdc_db, 0, 0, 8, 16, hdc_bmp, 0, 0, SRCCOPY);
SelectObject (hdc_bmp, hSkinTitle_Title);
BitBlt (hdc_db, 8, 0, 186, 16, hdc_bmp, 0, 0, SRCCOPY);
r.left := r.right - 4;
SelectObject (hdc_bmp, hSkinTitle_Right);
BitBlt (hdc_db, r.left, 0, 4, 16, hdc_bmp, 0, 0, SRCCOPY);
r.left := r.left - 11;
IF bCloseSelected then
begin
IF bClosePressed then
SelectObject (hdc_bmp, hSkinTitle_CloseP)
ELSE
SelectObject (hdc_bmp, hSkinTitle_CloseS);
end
ELSE
SelectObject (hdc_bmp, hSkinTitle_Close);
BitBlt (hdc_db, r.left, 0, 11, 16, hdc_bmp, 0, 0, SRCCOPY);
r.left := r.left - 11;
IF bRollupSelected then
begin
IF bRollupPressed then
SelectObject (hdc_bmp, hSkinTitle_RollupP)
ELSE
SelectObject (hdc_bmp, hSkinTitle_RollupS);
end
ELSE
SelectObject (hdc_bmp, hSkinTitle_Rollup);
BitBlt (hdc_db, r.left, 0, 11, 16, hdc_bmp, 0, 0, SRCCOPY);

r.left := r.left - 11;
IF bMinimizeSelected then
begin
IF bMinimizePressed then
SelectObject (hdc_bmp, hSkinTitle_MinimizeP)
ELSE
SelectObject (hdc_bmp, hSkinTitle_MinimizeS);
end
ELSE
SelectObject (hdc_bmp, hSkinTitle_Minimize);
BitBlt (hdc_db, r.left, 0, 11, 16, hdc_bmp, 0, 0, SRCCOPY);
IF r.left > 186+8 then
begin
r.right := r.left;
r.left := 186+8;
//push r.bottom
temp := r.bottom;
r.bottom := 16;
FillRect (hdc_db, r, hbSkinTitle_Middle);
r.bottom := temp;
end;
GetClientRect (hDlg, r);
r.top := r.top + 16;
DrawEdge (hdc_db, r, BDR_RAISEDOUTER, BF_RECT);
inc (r.top);
inc (r.left);
dec (r.right);
dec (r.bottom);
DrawEdge (hdc_db, r, BDR_SUNKENINNER, BF_RECT);
inc (r.top);
inc (r.left);
dec (r.right);
dec (r.bottom);
FillRect (hdc_db, r, hbSkinMain_Back);
GetClientRect (hDlg, r);
BitBlt (wParam, 0, 0, r.right, r.bottom, hdc_db, 0, 0, SRCCOPY);
DeleteObject (hdc_bmp);
SelectObject (hdc_db, eax);
DeleteObject (hm_bmp);
DeleteObject (hdc_db);
Result := 1;
end;
WM_MOUSEMOVE:
begin
GetWindowRect (hDlg, r);
GetCursorPos (p);
IF WindowMoving then
begin
r.bottom := r.bottom - r.top;
r.right := r.right - r.left;
IF SizeType=0 then
begin
r.left := r.left + (p.x - MovingStart.x);
r.top := r.top + (p.y - MovingStart.y);
end
ELSE
begin
IF (SizeType and 1)<>0 then
begin
r.top := r.top + (p.y - MovingStart.y);
r.bottom := r.bottom - (p.y - MovingStart.y);
IF (r.bottom < MINIMUMHEIGHT) or (r.bottom > $80000000) then
begin
p.y := p.y - (MINIMUMHEIGHT - r.bottom);
r.top := r.top - (MINIMUMHEIGHT - r.bottom);
SetCursorPos (p.x,p.y);
r.bottom := MINIMUMHEIGHT;
end;
end;
IF (SizeType and 2)<>0 then
begin
r.bottom := r.bottom + (p.y - MovingStart.y);
IF (r.bottom < MINIMUMHEIGHT) or (r.bottom > $80000000) then
begin
p.y := p.y + (MINIMUMHEIGHT - r.bottom);
SetCursorPos (p.x,p.y);
r.bottom := MINIMUMHEIGHT;
end;
end;
IF (SizeType and 4)<>0 then
begin
r.left := r.left + (p.x - MovingStart.x);
r.right := r.right - (p.x - MovingStart.x);
IF (r.right < MINIMUMWIDTH) or (r.right > $80000000) then
begin
p.x := p.x - (MINIMUMWIDTH - r.right);
r.left := r.left - (MINIMUMWIDTH - r.right);
SetCursorPos (p.x,p.y);
r.right := MINIMUMWIDTH;
end;
end;
IF (SizeType and 8)<>0 then
begin
r.right := r.right + (p.x - MovingStart.x);
IF (r.right < MINIMUMWIDTH) or (r.bottom > $80000000) then
begin
p.x := p.x + (MINIMUMWIDTH - r.right);
SetCursorPos (p.x,p.y);
r.right := MINIMUMWIDTH;
end;
end;
end;
MoveWindow (hDlg, r.left, r.top, r.right, r.bottom, TRUE);
MovingStart.x := p.x;
MovingStart.y := p.y;
end
ELSE
begin
r.right := r.right - 4;
r.left := r.right;
r.left := r.left - 11;
r.bottom := r.top;
r.bottom := r.bottom + 16;
IF PointInRect (p, r) and (not bRollupSelected) and (not bMinimizeSelected) then
begin
IF not bCloseSelected then
begin
bCloseSelected := TRUE;
SetCapture (hDlg);
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
Result:=1;
exit;
end
ELSE
begin
IF bCloseSelected then
begin
IF not bClosePressed then
ReleaseCapture;
bCloseSelected := FALSE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
end;
r.right :=r.right - 11;
r.left := r.left - 11;
IF PointInRect (p, r) and (not bCloseSelected) and (not bMinimizeSelected) then
begin
IF not bRollupSelected then
begin
bRollupSelected := TRUE;
SetCapture (hDlg);
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
Result:=1;
exit;
end
ELSE
begin
IF bRollupSelected then
begin
IF not bRollupPressed then
ReleaseCapture;
bRollupSelected := FALSE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
end;
r.right := r.right - 11;
r.left := r.left - 11;
IF PointInRect (p, r) and (not bRollupSelected) and (not bCloseSelected) then
begin
IF not bMinimizeSelected then
begin
bMinimizeSelected := TRUE;
SetCapture (hDlg);
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
Result:=1;
exit;
end
ELSE
begin
IF bMinimizeSelected then
begin
IF not bMinimizePressed then
ReleaseCapture;
bMinimizeSelected := FALSE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
end;
IF bClosePressed or bRollupPressed or bMinimizePressed then
begin
Result:=1;
exit;
end;
GetWindowRect(hDlg, r);
GetCursorPos(p);
dec (r.bottom);
dec (r.right);
r.left := r.left + (SIZEBORDER-1);
r.top := r.top + (SIZEBORDER-1);
r.right := r.right - (SIZEBORDER-1);
r.bottom := r.bottom - (SIZEBORDER-1);

SizeType := 0;
IF (r.top > p.y) and (r.top < $80000000) then
begin
CursorChange := TRUE;
SizeType := SizeType or 1;
end;
IF (r.bottom < p.y) and (r.bottom < $80000000) then
begin
CursorChange := TRUE;
SizeType := SizeType or 2;
end;
IF (r.left > p.x) and (r.left < $80000000) then
begin
CursorChange := TRUE;
SizeType := SizeType or 4;
end;
IF (r.right < p.x) and (r.right < $80000000) then
begin
CursorChange := TRUE;
SizeType := SizeType or 8;
end;
IF CursorChange and (SizeType = 0) then
begin
SizeType := 0;
CursorChange := FALSE;
SetCursor (hCursNorm);
end
ELSE
begin
IF (SizeType = 1) or (SizeType = 2) then
SetCursor (hCursSV)
ELSE IF (SizeType = 4) or (SizeType = 8) then
SetCursor (hCursSH)
ELSE IF (SizeType = 10) or (SizeType = 5) then
SetCursor (hCursSTR)
ELSE IF (SizeType = 9) or (SizeType = 6) then
SetCursor (hCursSTL);
end;
end;
end;
WM_LBUTTONDOWN:
begin
IF bCloseSelected or bRollupSelected or bMinimizeSelected then
begin
IF bCloseSelected then
begin
bClosePressed := TRUE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
IF bRollupSelected then
begin
bRollupPressed := TRUE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
IF bMinimizeSelected then
begin
bMinimizePressed := TRUE;
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
Result:=1;
exit;
end;
SetCapture (hDlg);
GetCursorPos (MovingStart);
IF SizeType=0 then
begin
GetWindowRect (hDlg, r);
IF MovingStart.y - r.top < CAPTIONHEIGHT then
begin
SetCursor (hCursMove);
CursorChange := TRUE;
WindowMoving := TRUE;
end;
end
ELSE IF (SizeType = 1) or (SizeType = 2) then
begin
SetCursor (hCursSV);
CursorChange := TRUE;
WindowMoving := TRUE;
end
ELSE IF (SizeType = 4) or (SizeType = 8) then
begin
SetCursor (hCursSH);
CursorChange := TRUE;
WindowMoving := TRUE;
end
ELSE IF (SizeType = 10) or (SizeType = 5) then
begin
SetCursor (hCursSTR);
CursorChange := TRUE;
WindowMoving := TRUE;
end
ELSE IF (SizeType = 9) or (SizeType = 6) then
begin
SetCursor (hCursSTL);
CursorChange := TRUE;
WindowMoving := TRUE;
end;
end;
WM_LBUTTONUP:
begin
IF bCloseSelected or bRollupSelected or bMinimizeSelected then
begin
IF bCloseSelected and bClosePressed then
SendMessage (hDlg, WM_CLOSE, NULL, NULL);
IF bRollupSelected and bRollupPressed then
begin
GetClientRect (hDlg, r);
IF r.bottom = 16 then
temp := dInitialHeight
ELSE
temp := 16;
GetWindowRect (hDlg, r);
bRollupPressed := FALSE;
r.right := r.right - r.left;
MoveWindow (hDlg, r.left, r.top, r.right, temp, TRUE);
GetClientRect (hDlg, r);
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
end;
IF bMinimizeSelected and bMinimizePressed then
begin
GetClientRect (hDlg, r);
bMinimizePressed := FALSE;
r.bottom := 16;
InvalidateRect (hDlg, @r, TRUE);
ShowWindow (hDlg, SW_MINIMIZE);
end;
bClosePressed := FALSE;
bRollupPressed := FALSE;
bMinimizePressed := FALSE;
Result:=1;
exit;
end;
bClosePressed := FALSE;
bRollupPressed := FALSE;
bMinimizePressed := FALSE;
ReleaseCapture;
WindowMoving := FALSE;
end;
WM_COMMAND:
begin
case HIWORD(wParam) of
CBN_SELCHANGE:
begin
nSkinNum := SendMessage(lParam, CB_GETCURSEL, NULL, NULL);
SendMessage(lParam, CB_GETLBTEXT, nSkinNum, Longint(@szNewSkin));
KillSkin;
LoadSkin(szNewSkin);
GetClientRect(hDlg, r);
InvalidateRect(hDlg, @r, TRUE);
end;
end;
end;
WM_SIZE:
begin
GetClientRect (hDlg, r);
InvalidateRect (hDlg, @r, TRUE);
end;
WM_CLOSE:EndDialog(hDlg, NULL);
WM_DESTROY:PostQuitMessage(0);
end;
end;

begin
DialogBoxParam (hInstance, '#101', NULL, @DlgProc, NULL);
end.

Категория: Статьи по кодингу | Добавил: Jimmy (15.02.2008) | Автор: voyager
Просмотров: 858 | Рейтинг: 0.0/0 |
Всего комментариев: 0
Имя *:
Email *:
Код *:
Форма входа
Поиск
Друзья сайта
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0