Форум: "KOL";
Текущий архив: 2011.07.24;
Скачать: [xml.tar.bz2];

Вниз

Нестандартная форма (Форма окна по bmp)   Найти похожие ветки 

← →
p.s. ©   (2008-12-28 14:50) [0]

Добрый день!
Уважаемые, подскажите пожалуйста, как сделать нестандартную форму приложения написанного с использованием KOL. Пример приветствуется.

---

← →
Compiler ©   (2009-01-03 00:13) [1]

//
// purpose:
//  author: KOL version © 2005, Thaddy de Koning
// Remarks: Based on below, but HEAVILY changed
//
{
The FormShaper is a free VCL component
Written by Duan Xihua, Shanghai, PRC
Tel: 086-021-65117550, 086-13651677058
Email: tibetty@263.net
}

unit KolFormShaper;

interface

uses
 Windows, Messages, Kol,Objects;

type

 PFormShaper = ^TFormShaper;
 TFormShaper = object(Tobj)
 private
   fOwner:PControl;
   FBkgndBitmap: PBitmap;
   FOwnerHandle: HWND;
   FOldClientWidth: Integer;
   FOldClientHeight: Integer;
   FHookInstance: Pointer;
   FOldWindowProc: Pointer;
   FOldWindowRgn: HRGN;
   procedure HookWindowProc(var Message: TMessage);
   procedure SetBkgndBitmap(bitmap: PBitmap);
 public
   destructor Destroy; virtual;
   procedure BkgndBitmapChange(Sender: Pobj);
   property BkgndBitmap: PBitmap read FBkgndBitmap write SetBkgndBitmap;
 end;

 function NewFormShaper(AOwner: PControl;Filename:string):PFormShaper;

implementation

procedure TFormShaper.HookWindowProc(var Message: TMessage);
var
 Canvas: PCanvas;
begin
 try
   with Message do
   begin
     if FBkgndBitmap.Empty then
       Result := CallWindowProc(FOldWindowProc, FOwnerHandle, Msg, WParam, LParam)
     else
       case Msg of
       WM_ERASEBKGND:
       begin
           FBkgndBitmap.Draw(Wparam,0,0);
           Result := LRESULT(True);
         end;
         WM_LBUTTONDOWN:
         begin
           ReleaseCapture;
           SendMessage(FOwnerHandle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
           Result := LRESULT(False);
         end;
       else
         Result := CallWindowProc(FOldWindowProc, FOwnerHandle, Msg, WParam, LParam);
       end;
     end;
   except
     ; // :-) Go figure!!!, TDK//Application.HandleException(Self);
   end;
 end;

 function CreateRgnFromBitmap(rgnBitmap: PBitmap): HRGN;
 var
   transColor: TColor;
   i, j: Integer;
   width, height: Integer;
   left, right: Integer;
   rectRgn: HRGN;
 begin
   Result := 0;
   width := rgnBitmap.Width;
   height := rgnBitmap.Height;
   transColor := rgnBitmap.Canvas.Pixels[width - 1, height - 1];
   for i := 0 to height - 1 do
   begin
     left := -1;
     for j := 0 to width - 1 do
     begin
       if left < 0 then
       begin
         if rgnBitmap.Canvas.Pixels[j, i] <> transColor then
           left := j;
       end
       else
         if rgnBitmap.Canvas.Pixels[j, i] = transColor then
         begin
           right := j;
           rectRgn := CreateRectRgn(left, i, right, i + 1);
           if Result = 0 then
             Result := rectRgn
           else
           begin
             CombineRgn(Result, Result, rectRgn, RGN_OR);
             DeleteObject(rectRgn);
           end;
           left := -1;
         end;
     end;
     if left >= 0 then
     begin
       rectRgn := CreateRectRgn(left, i, width, i + 1);
       if Result = 0 then
         Result := rectRgn
       else
       begin
         CombineRgn(Result, Result, rectRgn, RGN_OR);
         DeleteObject(rectRgn);
       end;
     end;
   end;
 end;

 procedure TFormShaper.BkgndBitmapChange(Sender: Pobj);
 var
   form: PControl;
   windowRgn: HRGN;
 begin
     form := fOwner;
     if FBkgndBitmap.Empty then
     begin
       form.ClientWidth := FOldClientWidth;
       form.ClientHeight := FOldClientHeight;
       SetWindowRgn(FOwnerHandle, FOldWindowRgn, True);
     end
     else
     begin
       form.ClientWidth := FBkgndBitmap.Width;
       form.ClientHeight := FBkgndBitmap.Height;
       windowRgn := CreateRgnFromBitmap(FBkgndBitmap);
       SetWindowRgn(FOwnerHandle, windowRgn, True);
     end;
 end;

 procedure TFormShaper.SetBkgndBitmap(bitmap: PBitmap);
 begin
   FBkgndBitmap.Assign(bitmap);
   BkgndBitmapChange(@Self)
 end;

 function NewFormShaper(AOwner: PControl;Filename:String):PFormShaper;
 var
   form: Pcontrol;
 begin
   New(Result,Create);
   with Result^ do
   begin
     FOwner:=AOwner;
     FBkgndBitmap := NewBitmap(0,0);

     FHookInstance := MakeObjectInstance(HookWindowProc);
     form := AOwner;
     FOldClientWidth := form.ClientWidth;
     FOldClientHeight := form.ClientHeight;
     FOwnerHandle := form.Handle;
     FOldWindowProc := Pointer(GetWindowLong(FOwnerHandle, GWL_WNDPROC));
     SetWindowLong(FOwnerHandle, GWL_WNDPROC, LongInt(FHookInstance));
     GetWindowRgn(FOwnerHandle, FOldWindowRgn);
     If (FileExists(Filename)) and (Lowercase(ExtractFileExt(Filename)) = ".bmp") then
     begin
       FbkgndBitmap.LoadFromFile(Filename);
       BkgndBitmapChange(fOwner);
     end;
 end;
end;

destructor TFormShaper.Destroy;
var
 form: Pcontrol;
begin
   SetWindowLong(FOwnerHandle, GWL_WNDPROC, LongInt(FOldWindowProc));
   form := fOwner;
   form.ClientWidth := FOldClientWidth;
   form.ClientHeight := FOldClientHeight;
   SetWindowRgn(FOwnerHandle, FOldWindowRgn, True);
   FreeObjectInstance(FHookInstance);
   FBkgndBitmap.Free;
   inherited Destroy;
end;

end.

Использовать:
Shape:=NewFormShaper(Form,"kol.bmp");

С Новым Годом!!!

---

← →
ява   (2009-03-01 00:40) [2]

p.s. ©   (28.12.08 14:50)
Добрый день!
Уважаемые, подскажите пожалуйста, как сделать нестандартную форму приложения написанного с использованием KOL. Пример приветствуется.

---

← →
имя   (2009-03-01 02:21) [3]

Удалено модератором

---

Страницы: 1 вся ветка

Форум: "KOL";
Текущий архив: 2011.07.24;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.003 c