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

Вниз

Медленная работа алгоритма.   Найти похожие ветки 

 
SerB   (2003-02-11 04:43) [0]

Я понимаю, что ниже помещенный примерчик - прикол, но...
Почему-то в KOL_МCK (также как и в KOL без MCK ) очень медленно работает приведенный ниже код... Картинка обрабатывается до 5 минут иногда... В тоже время аналогичный код в IDE - отрабатывает "мгновенно"...


{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit MuNRF2u;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Classes,
Controls, mckCtrls, mckObjs {$ENDIF},KOLMath;
{$ELSE}
{$I uses.inc}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
mirror;
{$ENDIF}

type
{$IFDEF KOL_MCK}
{$I MCKfakeClasses.inc}
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form: PControl;
{$ELSE not_KOL_MCK}
TForm1 = class(TForm)
{$ENDIF KOL_MCK}
KOLProject1: TKOLProject;
KOLForm1: TKOLForm;
osd: TKOLOpenSaveDialog;
procedure KOLForm1FormCreate(Sender: PObj);
procedure KOLForm1Paint(Sender: PControl; DC: HDC);
procedure KOLForm1MouseUp(Sender: PControl;
var Mouse: TMouseEventData);
procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure KOLForm1MouseDblClk(Sender: PControl;
var Mouse: TMouseEventData);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
image1:PBitmap; // это картинка по которой создается форма окна
{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}

{$IFDEF KOL_MCK}
{$I Uni2_1.inc}
{$ENDIF}

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
var
regn: integer;// регион окна
begin
while osd.Filename = "" do osd.execute; //
image1:=NewDibBitmap(0,0,pf32bit); // загружаем рисунок для формы
image1.LoadFromFile(osd.filename); //
regn := CreateRectRgn( 0,0,image1.Width, image1.Height);
SetWindowRgn( Form.Handle, regn, TRUE );
//InvalidateRect(Form.Handle, nil, true);
end;

procedure TForm1.KOLForm1Paint(Sender: PControl; DC: HDC);
begin
image1.Draw(dc,0,0);
end;

procedure TForm1.KOLForm1MouseUp(Sender: PControl; //перерисовываем форму при
var Mouse: TMouseEventData); //выбирая нового цвета
var //по клику мышки на рисунке
regn, tmpRegn : integer;// регион окна и временный регион
x,y : integer; // координаты пикселя
nullClr : TColor; // «прозрачный цвет»
begin
if (Mouse.Button = mbRight) then begin
nullClr := image1.Pixels[mouse.X,mouse.Y];
msgOk(Int2Hex(nullClr,2));
regn := CreateRectRgn( 0,0,image1.Width, image1.Height);
for x := image1.Width downto 0 do
for y := 0 to image1.Height do
if image1.Pixels[ x,y] = nullClr then
begin
tmpRegn := CreateRectRgn( x , y , x+1, y+1);
CombineRgn( regn, regn, tmpRegn, RGN_diff);
DeleteObject( tmpRegn );
( Form.Handle, regn, TRUE )
Я понимаю, что ниже помещенный примерчик - прикол, но...
Почему-то в KOL_МCK (также как и в KOL без MCK ) очень медленно работает приведенный ниже код... Картинка обрабатывается до 5 минут иногда... В тоже время аналогичный код в IDE - отрабатывает "мгновенно"...


{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit MuNRF2u;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Classes,
Controls, mckCtrls, mckObjs {$ENDIF},KOLMath;
{$ELSE}
{$I uses.inc}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
mirror;
{$ENDIF}

type
{$IFDEF KOL_MCK}
{$I MCKfakeClasses.inc}
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form: PControl;
{$ELSE not_KOL_MCK}
TForm1 = class(TForm)
{$ENDIF KOL_MCK}
KOLProject1: TKOLProject;
KOLForm1: TKOLForm;
osd: TKOLOpenSaveDialog;
procedure KOLForm1FormCreate(Sender: PObj);
procedure KOLForm1Paint(Sender: PControl; DC: HDC);
procedure KOLForm1MouseUp(Sender: PControl;
var Mouse: TMouseEventData);
procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure KOLForm1MouseDblClk(Sender: PControl;
var Mouse: TMouseEventData);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
image1:PBitmap; // это картинка по которой создается форма окна
{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}

{$IFDEF KOL_MCK}
{$I Uni2_1.inc}
{$ENDIF}

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
var
regn: integer;// регион окна
begin
while osd.Filename = "" do osd.execute; //
image1:=NewDibBitmap(0,0,pf32bit); // загружаем рисунок для формы
image1.LoadFromFile(osd.filename); //
regn := CreateRectRgn( 0,0,image1.Width, image1.Height);
SetWindowRgn( Form.Handle, regn, TRUE );
//InvalidateRect(Form.Handle, nil, true);
end;

procedure TForm1.KOLForm1Paint(Sender: PControl; DC: HDC);
begin
image1.Draw(dc,0,0);
end;

procedure TForm1.KOLForm1MouseUp(Sender: PControl; //перерисовываем форму при
var Mouse: TMouseEventData); //выбирая нового цвета
var //по клику мышки на рисунке
regn, tmpRegn : integer;// регион окна и временный регион
x,y : integer; // координаты пикселя
nullClr : TColor; // «прозрачный цвет»
begin
if (Mouse.Button = mbRight) then begin
nullClr := image1.Pixels[mouse.X,mouse.Y];
msgOk(Int2Hex(nullClr,2));
regn := CreateRectRgn( 0,0,image1.Width, image1.Height);
for x := image1.Width downto 0 do
for y := 0 to image1.Height do
if image1.Pixels[ x,y] = nullClr then
begin
tmpRegn := CreateRectRgn( x , y , x+1, y+1);
CombineRgn( regn, regn, tmpRegn, RGN_diff);
DeleteObject( tmpRegn );
end;
SetWindowRgn( Form.Handle, regn, TRUE );
// InvalidateRect(Form.Handle, nil, true);
end;
end;



procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
form.DroppedDown:= true;
end;

procedure TForm1.KOLForm1MouseDblClk(Sender: PControl;
var Mouse: TMouseEventData);
begin
form.close;
end;

end.






 
Кладов   (2003-02-11 07:07) [1]

Pixels медленно и в VCL. Используйте ScanLine.


 
SerB   (2003-02-11 12:56) [2]

Спасибо



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

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

Наверх




Память: 0.47 MB
Время: 0.013 c
1-89348
slavok
2003-10-16 00:09
2003.10.27
!!!!! ChekBox и TreeView !!!!!


6-89447
SergeyS
2003-09-02 16:32
2003.10.27
Почтовый сервер


14-89467
Е-Моё имя
2003-10-07 10:17
2003.10.27
сказ про то, как модератор был предан анафеме


6-89427
TButton
2003-08-30 20:15
2003.10.27
Asynchronous socket error 10054


1-89244
Mansur
2003-10-17 04:57
2003.10.27
Ошибка Access Violation ...





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