Главная страница
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.045 c
4-1125042482
ganda
2005-08-26 11:48
2005.10.30
Подключится к интернету зная только имя соединения


9-1118826181
Долгов Артем
2005-06-15 13:03
2005.10.30
Diablo heroes to Image


2-1128502645
Гость22
2005-10-05 12:57
2005.10.30
Как сделать, чтоб при вводе в Edit е, после 5-го и 10-го...


5-1105478751
hawkins
2005-01-12 00:25
2005.10.30
каком режиме компонент: в design-time или в run-time


2-1128627955
Молодой
2005-10-06 23:45
2005.10.30
MS Access&D7...... Ошибка - несовместимость типов...