Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.10.30;
Скачать: CL | DM;

Вниз

Помогите с созданием окна по рисунку   Найти похожие ветки 

 
lelik2005   (2005-08-27 14:24) [0]

значит есть такой вот сырец, нашел в инете. подскажите пожалста как мне его применить к моей форме, ну к примеру к Form1. Я чегото не пойму совсем как связать этот класс с формой или окном формы.
TStretchHandle = class(TCustomControl)
 private
   procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
   procedure WMGetDLGCode(var message: TMessage); message WM_GETDLGCODE;
 protected
   procedure Paint; override;
   property Canvas;
 public
   procedure CreateParams(var Params: TCreateParams); override;
end;

procedure TStretchHandle.CreateParams(var Params: TCreateParams);
begin
 { set default Params values }
 inherited CreateParams(Params);
 { then add transparency }
 Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TStretchHandle.WMGetDLGCode(var message: TMessage);
begin
 { completely fake erase, don"t call inherited, don"t collect $200 }
 message.Result := DLGC_WANTARROWS;
end;

procedure TStretchHandle.WMEraseBkgnd(var message: TWMEraseBkgnd);
begin
 { completely fake erase, don"t call inherited, don"t collect $200 }
 message.Result := 1;
end;

procedure TStretchHandle.Paint;
begin
 inherited Paint;
 with Canvas do
 begin
   // рисуете что нужно -
   // где не рисовали, там будет "прозрачно"
 end;
end;


 
lelik2005   (2005-08-27 15:25) [1]

ay


 
Antonn ©   (2005-08-27 15:31) [2]

не знаю, что там за сырец, вот пример, но маске режущий форму:

function TSkin_Form.BitmapToRgn(Image: TBitmap): HRGN;
var
 TmpRgn: HRGN;
 x, y: integer;
 ConsecutivePixels: integer;
 CurrentPixel: TColor;
 CreatedRgns: integer;
 CurrentColor: TColor;
begin
 CreatedRgns := 0;
 Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
 inc(CreatedRgns);
 if (Image.Width = 0) or (Image.Height = 0) then  exit;
 for y := 0 to Image.Height - 1 do   begin
   CurrentColor := Image.Canvas.Pixels[0,y];
   ConsecutivePixels := 1;
   for x := 0 to Image.Width - 1 do     begin
     CurrentPixel := Image.Canvas.Pixels[x,y];
     if CurrentColor = CurrentPixel then
       inc(ConsecutivePixels)
     else begin
       if CurrentColor = clWhite then begin
         TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
         CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
         inc(CreatedRgns);
         DeleteObject(TmpRgn);
       end;
       CurrentColor := CurrentPixel;
       ConsecutivePixels := 1;
     end;
   end;
   if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then  begin
     TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
     CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
     inc(CreatedRgns);
     DeleteObject(TmpRgn);
   end;
 end;
end;


использование:
SetWindowRgn(_form.Handle,BitmapToRgn(image1.picture),true);


 
lelik2005   (2005-08-27 15:33) [3]

спасиб ;)


 
lelik2005   (2005-08-27 18:12) [4]

а как теперь мне ее ресайзить по границам? ;(
вот незадача, она ведь bsNone . Есть решение какое-нибудь по ресайзу?


 
Antonn ©   (2005-08-27 18:42) [5]

lelik2005   (27.08.05 18:12) [4]
а как теперь мне ее ресайзить по границам? ;(
вот незадача, она ведь bsNone . Есть решение какое-нибудь по ресайзу?

не-а:) только если самому перерисовать рисунок и снова зарегионить. но это фигня.



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

Текущий архив: 2005.10.30;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.044 c
1-1128626395
Kostafey
2005-10-06 23:19
2005.10.30
Получение и использование адреса метода.


14-1128789968
syte_ser78
2005-10-08 20:46
2005.10.30
Програмирование в Delphi 7 Архангельский


14-1128690438
fran
2005-10-07 17:07
2005.10.30
off top: Есть ли дефрагментатор диска NTFS с кластером 8к?


5-1093549702
Jetus
2004-08-26 23:48
2005.10.30
Выделение дней в календаре


14-1128700447
ArtemESC
2005-10-07 19:54
2005.10.30
Алгоритм возведения числа в произвольную степень