Главная страница
    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.011 c
14-89544
Mystic
2003-10-08 12:42
2003.10.27
Забавный глюк :)


14-89487
lancelot
2003-10-09 00:14
2003.10.27
Маленькие наши радости :)


1-89365
Кен
2003-10-01 04:33
2003.10.27
Как сделать чтобы через определённый промежуток времени


3-89118
eds
2003-10-08 09:59
2003.10.27
Помогите произвести отбор данных по BLOB полю


1-89206
Checist [root]
2003-10-15 13:58
2003.10.27
Сохранение картинки из веб страници





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