Главная страница
    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.056 c
2-1128697503
ArtemESC
2005-10-07 19:05
2005.10.30
Цифра Extended


14-1128491702
vidiv
2005-10-05 09:55
2005.10.30
Что лучше поставить на ноут?


10-1106212117
bmax
2005-01-20 12:08
2005.10.30
TWebBrowser в качестве Com-клиента


1-1128876024
oleg_SYS
2005-10-09 20:40
2005.10.30
Помогите создать COM-объект


1-1128708589
Aleksik
2005-10-07 22:09
2005.10.30
выгрузить массив в Excel





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский