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

Вниз

Графика на WinAPI   Найти похожие ветки 

← →
lds   (2003-04-24 13:45) [0]

Как сделать, чтобы форма заполнялась разноцветными точками, интересует быстрота алгоритма, если делать два цикла, то Это очень медленно да и система подвешивается. Помогите!

← →
MBo   (2003-04-24 13:56) [1]

как точку ставишь? Если SetPixel - то это медленно, но система не подвешивается.

← →
NAlexey   (2003-04-24 14:22) [2]

Если это чем поможет, то это текст примера из книги библия разработчика чтоли, ну вообщем посмотри...

//////////////////////////////////////
// Purpose:
// Project: Thsorts.dpr
// Copyright (c) 1998 by Charlie Calvert
//
unit main;

{
Dreaded Sorts
copyright (c) 1996 by David Intersimone

This example program shows how to set a
thread"s priority. Don"t use Canvas property
in program like this! Not unless you also
use the TThread object and its Synchronize
procedure!
}

interface

uses
SysUtils, WinTypes, WinProcs,
Messages, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons;

const
aMax = 300;

type
TForm1 = class(TForm)
Edit1: TEdit;
Label2: TLabel;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
BitBtn1: TBitBtn;
BubbleTrackBar: TTrackBar;
QuickTrackBar: TTrackBar;
procedure Button1Click(Sender: TObject);
private
T1 : THandle;
T2 : THandle;
end;

var
Form1: TForm1;
a,b : array[0..aMax-1] of integer;
numItems : integer;

implementation

uses
secform, thform;

{$R *.DFM}

procedure BubbleSort(var ia:array of integer; items: integer);
var
i,j,t : integer;
DC: HDC;
begin
DC := GetDC(Form2.Handle);
for i := items downto 0 do
begin
for j := 0 to items-1 do
if ia[j] < ia[j+1] then
begin
t := ia[j];
SetPixel(DC, ia[j+1]+5, j+1+5, clBlue);
SetPixel(DC, ia[j]+5, j+5, clBlue);
ia[j] := ia[j+1];
ia[j+1] := t;
Setpixel(DC, ia[j+1]+5,j+1+5, clYellow);
Setpixel(DC, ia[j]+5,j+5, clYellow);
end;
end;
ReleaseDC(Form2.Handle, DC);
end;

procedure QuickSort(var ia:array of integer; iLo,iHi : integer);
var
Lo,Hi,Mid,T : integer;
DC: HDC;
begin
Lo := iLo;
Hi := iHi;
mid := ia[(Lo+hi) div 2];
repeat
DC := GetDC(Form3.Handle);
while ia[Lo] < mid do Inc(Lo);
while ia[Hi] > mid do Dec(Hi);
if Lo <= Hi then
begin
T := ia[Lo];
SetPixel(DC, ia[Lo]+5,Lo+5, clBlue);
SetPixel(DC, ia[Hi]+5,Hi+5, clBlue);
ia[Lo] := ia[Hi];
ia[Hi] := T;
SetPixel(DC, ia[Lo]+5,Lo+5, clLime);
SetPixel(DC, ia[Hi]+5,Hi+5, clLime);
inc(Lo);
dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(ia,iLo,Hi);
if Lo < iHi then QuickSort(ia,Lo,iHi);
ReleaseDC(Form3.Handle, DC);
end;

function BubbleThread(parms:pointer) : LongInt; far;
begin
BubbleSort(a,numItems-1);
end;

function QuickThread(parms:pointer) : LongInt; far;
begin
QuickSort(b,0,numItems-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
ThreadID : dWord;
begin
numItems := strToInt(Edit1.Text);
if numItems <= aMax then
begin
form2.free;
form2 := TForm2.Create(self);
form2.top := 140;
form2.left := 2;
form2.clientheight := numItems+10;
form2.clientwidth := numItems+10;
form2.color := clBlue;
form2.caption := "Bubble Sort";
form2.show;

form3.free;
form3 := TForm3.Create(self);
form3.top := 140;
form3.left := 320;
form3.clientheight := numItems+10;
form3.clientwidth := numItems+10;
form3.color := clBlue;
form3.caption := "Quick Sort";
form3.show;

Randomize;
for i := 0 to numItems-1 do
begin
a[i] := random(numItems);
b[i] := a[i];
form2.canvas.pixels[a[i]+5,i+5] := clYellow;
form3.canvas.pixels[b[i]+5,i+5] := clLime;
end;
T1 := createThread(nil,0,@BubbleThread,nil,0,threadID);
setThreadPriority(T1, BubbleTrackBar.Position);
T2 := createThread(nil,0,@QuickThread,nil,0,threadID);
( T2, QuickTrackBar.Position) Если это чем поможет, то это текст примера из книги библия разработчика чтоли, ну вообщем посмотри...

//////////////////////////////////////
// Purpose:
// Project: Thsorts.dpr
// Copyright (c) 1998 by Charlie Calvert
//
unit main;

{
Dreaded Sorts
copyright (c) 1996 by David Intersimone

This example program shows how to set a
thread"s priority. Don"t use Canvas property
in program like this! Not unless you also
use the TThread object and its Synchronize
procedure!
}

interface

uses
SysUtils, WinTypes, WinProcs,
Messages, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons;

const
aMax = 300;

type
TForm1 = class(TForm)
Edit1: TEdit;
Label2: TLabel;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
BitBtn1: TBitBtn;
BubbleTrackBar: TTrackBar;
QuickTrackBar: TTrackBar;
procedure Button1Click(Sender: TObject);
private
T1 : THandle;
T2 : THandle;
end;

var
Form1: TForm1;
a,b : array[0..aMax-1] of integer;
numItems : integer;

implementation

uses
secform, thform;

{$R *.DFM}

procedure BubbleSort(var ia:array of integer; items: integer);
var
i,j,t : integer;
DC: HDC;
begin
DC := GetDC(Form2.Handle);
for i := items downto 0 do
begin
for j := 0 to items-1 do
if ia[j] < ia[j+1] then
begin
t := ia[j];
SetPixel(DC, ia[j+1]+5, j+1+5, clBlue);
SetPixel(DC, ia[j]+5, j+5, clBlue);
ia[j] := ia[j+1];
ia[j+1] := t;
Setpixel(DC, ia[j+1]+5,j+1+5, clYellow);
Setpixel(DC, ia[j]+5,j+5, clYellow);
end;
end;
ReleaseDC(Form2.Handle, DC);
end;

procedure QuickSort(var ia:array of integer; iLo,iHi : integer);
var
Lo,Hi,Mid,T : integer;
DC: HDC;
begin
Lo := iLo;
Hi := iHi;
mid := ia[(Lo+hi) div 2];
repeat
DC := GetDC(Form3.Handle);
while ia[Lo] < mid do Inc(Lo);
while ia[Hi] > mid do Dec(Hi);
if Lo <= Hi then
begin
T := ia[Lo];
SetPixel(DC, ia[Lo]+5,Lo+5, clBlue);
SetPixel(DC, ia[Hi]+5,Hi+5, clBlue);
ia[Lo] := ia[Hi];
ia[Hi] := T;
SetPixel(DC, ia[Lo]+5,Lo+5, clLime);
SetPixel(DC, ia[Hi]+5,Hi+5, clLime);
inc(Lo);
dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(ia,iLo,Hi);
if Lo < iHi then QuickSort(ia,Lo,iHi);
ReleaseDC(Form3.Handle, DC);
end;

function BubbleThread(parms:pointer) : LongInt; far;
begin
BubbleSort(a,numItems-1);
end;

function QuickThread(parms:pointer) : LongInt; far;
begin
QuickSort(b,0,numItems-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
ThreadID : dWord;
begin
numItems := strToInt(Edit1.Text);
if numItems <= aMax then
begin
form2.free;
form2 := TForm2.Create(self);
form2.top := 140;
form2.left := 2;
form2.clientheight := numItems+10;
form2.clientwidth := numItems+10;
form2.color := clBlue;
form2.caption := "Bubble Sort";
form2.show;

form3.free;
form3 := TForm3.Create(self);
form3.top := 140;
form3.left := 320;
form3.clientheight := numItems+10;
form3.clientwidth := numItems+10;
form3.color := clBlue;
form3.caption := "Quick Sort";
form3.show;

Randomize;
for i := 0 to numItems-1 do
begin
a[i] := random(numItems);
b[i] := a[i];
form2.canvas.pixels[a[i]+5,i+5] := clYellow;
form3.canvas.pixels[b[i]+5,i+5] := clLime;
end;
T1 := createThread(nil,0,@BubbleThread,nil,0,threadID);
setThreadPriority(T1, BubbleTrackBar.Position);
T2 := createThread(nil,0,@QuickThread,nil,0,threadID);
setThreadPriority(T2, QuickTrackBar.Position);
end
else
Form1.Caption := "Too Large!";
end;

end.

← →
lds   (2003-04-24 20:05) [3]

To MBo: а как еще можно рисовать точку?

← →
MBo   (2003-04-24 20:40) [4]

Другого прямого метода поставить точку на контексте в Windows нет. Можно работать с DIB или DIBSection с непосредственным доступом к граф. данным, затем отрисовать его целиком (весь прямоугольник)
Какая стоит задача?

← →
Style   (2003-04-24 21:17) [5]

А можно вот так :)

procedure SetClr(x,y:integer; clr: COLORREF; Stream: TMemoryStream);
const
Head = 50;
//54
begin
y := 500 - y;

Stream.Seek(Head + (y*500*4) + (x*4),soFromBeginning);
Stream.Write(Clr,4);
Stream.Seek(0,soFromBeginning);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
b: TBitmap;
strm: TMemoryStream;
i: integer;
z,c: integer;

begin
b := TBitmap.Create;
try
strm := TMemoryStream.Create;
try
b.Width := 500;
b.Height := 500;
b.Canvas.CopyRect(RECT(0,0,500,500),Canvas,RECT(0,0,500,500));
b.SaveToStream(strm);


for z := 0 to 500 do
begin
for i := 0 to 500 do
begin
c := RGB(z,i,i+z); //=== BGR ===
SetClr(i,z,c,strm);
end;
end;

b.LoadFromStream(strm);

( RECT(0,0,500,500) А можно вот так :)

procedure SetClr(x,y:integer; clr: COLORREF; Stream: TMemoryStream);
const
Head = 50;
//54
begin
y := 500 - y;

Stream.Seek(Head + (y*500*4) + (x*4),soFromBeginning);
Stream.Write(Clr,4);
Stream.Seek(0,soFromBeginning);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
b: TBitmap;
strm: TMemoryStream;
i: integer;
z,c: integer;

begin
b := TBitmap.Create;
try
strm := TMemoryStream.Create;
try
b.Width := 500;
b.Height := 500;
b.Canvas.CopyRect(RECT(0,0,500,500),Canvas,RECT(0,0,500,500));
b.SaveToStream(strm);


for z := 0 to 500 do
begin
for i := 0 to 500 do
begin
c := RGB(z,i,i+z); //=== BGR ===
SetClr(i,z,c,strm);
end;
end;

b.LoadFromStream(strm);

Canvas.CopyRect(RECT(0,0,500,500),b.Canvas,RECT(0,0,500,500));
finally
strm.Free;
end;
finally
b.Free
end;
end;


← →
lds   (2003-04-25 12:53) [6]

To MBo: Быстрый вывод графики (разного размера) и поменьше ресурсов занимало

← →
MBo   (2003-04-25 13:02) [7]

ну здесь посмотри идеи
http://delphigfx.mastak.ru/2d.htm

← →
Style   (2003-04-25 13:21) [8]

TDXDib и больше тебе ничего не надо!

← →
NetBreaker666   (2003-04-26 19:50) [9]

А заполнить какой-нибудь BitMap рандомными значениями, а затем BitBlt(...) не пробовали ?

← →
lds   (2003-04-26 22:18) [10]

To MBo: круто, то что надо. Спасибки большое!
To NetBreaker666 ©: Это и есть медленно. Работать с динамической памятью в разы быстрее

← →
Style   (2003-04-28 22:30) [11]

lds>>
В моем примере MemoryStream - и есть динамическая память.. Так что если никуда не рыть можно написать тоже самое.

Только я забыл добавить одну строчку..

strm := TMemoryStream.Create;
try
b.Width := 500;
b.Height := 500;
-->>вот эту ///// b.PixelFormat := 32Bit // точно не помню чтото в этом роде.
В общем 4 байта на точку..на один цвет


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

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

Наверх




Память: 0.49 MB
Время: 0.009 c
9-81527
Антон
2003-02-18 04:51
2003.08.25
Помогите кто может

1-81643
Erik
2003-08-12 12:11
2003.08.25
Как пробежать по XML и считать атрибуты?

7-81970
Фагот
2003-06-09 19:59
2003.08.25
CD-ROM

1-81711
Lina
2003-08-11 09:47
2003.08.25
RichEdit

1-81764
Berezne
2003-08-14 12:02
2003.08.25
Глюки при печати




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