Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

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

Наверх





Память: 0.46 MB
Время: 0.043 c
11-1109765207
Boguslaw Brandys
2005-03-02 15:06
2005.10.30
Form.StatusCtl


14-1128828112
тихий вовочка
2005-10-09 07:21
2005.10.30
Google Earth, наши военные базы и статуя Свободы


14-1128683529
y-soft
2005-10-07 15:12
2005.10.30
Очередное присуждение шНобелевской премии


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


1-1128415708
JohnKorsh
2005-10-04 12:48
2005.10.30
Вопрос по package.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский