VPF::TCanvas - Форум программистов

ivan219

Дата 4.2.2007, 22:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Вот нарисовал кнопочку но код получился какой то громоздкий может можно как-то его упростить smile

Код


procedure TMyForm.Button1Click(Sender: TObject);
var
   X,Y,C,I: Integer;
begin
 C:=243;
 I:=10;
 for Y:=111 to 131 do
  begin
   for X:= 101 to 171 do
    Canvas.Pixels[X,Y]:=RGB(C-I,C-I,C);
   if (Y>110)and(Y<117)then Inc(C,2);
   if (Y>=115)and(Y<=121)then Dec(I);
   if (Y>121)and(Y<129)then Inc(I);
   if (Y>119)and(Y<132)then Dec(C,4);
  end;
 Canvas.Pen.Color:=$00CFCFCF;
 Canvas.Brush.Color:=clWhite;
 Canvas.Brush.Style:=bsClear;
 Canvas.RoundRect(100,110,173,133,5,5);
 Canvas.TextOut(118,115,'Button1');
end;

--------------------

Мой первый сайт и моя первая программа!!!!!

ivan219

Дата 4.2.2007, 22:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Если заместо этого

Код


   for X:= 101 to 171 do
    Canvas.Pixels[X,Y]:=RGB(C-I,C-I,C);

использовать

Код


     Canvas.Pen.Color:=RGB(C-I,C-I,C);
     Canvas.MoveTo(11,Y);
     Canvas.LineTo(82,Y);

то получается быстрее раз в 10 smile

А лучше вот так

Код


const
    Col: Array[11..31] of TColor=(16248301,16379887,16511473,16643059,16774902,
                                  16775159,16775416,16775673,16578551,16381429,
                                  16183793,15986157,15788521,15590885,15393249,
                                  15195613,14998234,14800855,14603476,14406097,
                                  14208718);
.
.
.
procedure TMyForm.Button1Click(Sender: TObject);
var
   Y: Integer;
begin
 for Y:=11 to 31 do
  begin
   Canvas.Pen.Color:=Col[Y];
   Canvas.MoveTo(11,Y);
   Canvas.LineTo(82,Y);
  end;
 Canvas.Pen.Color:=$00CFCFCF;
 Canvas.Brush.Style:=bsClear;
 Canvas.RoundRect(10,10,83,33,5,5);
 Canvas.TextOut(28,15,'Button1');
end;

Это сообщение отредактировал(а) ivan219 - 5.2.2007, 09:35

--------------------

Мой первый сайт и моя первая программа!!!!!

bems

Дата 5.2.2007, 01:11 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

SetPixel

--------------------

Обижено школьников: 8

ivan219

Дата 5.2.2007, 09:29 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Нет

Код


SetPixel

повремени получается также как и

Код


 Canvas.Pixels

--------------------

Мой первый сайт и моя первая программа!!!!!

CatATonik

Дата 5.2.2007, 10:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 95
Регистрация: 12.1.2007
Где: Москва

Репутация: 6
Всего: 8

Вот, недостаток не работает под Win 95, все это есть в Windows.pas но там не правильно определен тип COLOR16 smile

Код


type
  TGradientMode = (gmHorz, gmVert);

  procedure Gradient(Canvas: TCanvas; const R: TRect; Color1, Color2: TColor; Mode: TGradientMode);

implementation

type
  COLOR16 = Word;

  PTriVertex = ^TTriVertex;
  _TRIVERTEX = packed record
    x: Integer;
    y: Integer;
    Red: COLOR16;
    Green: COLOR16;
    Blue: COLOR16;
    Alpha: COLOR16;
  end;
  TTriVertex = _TRIVERTEX;
  TRIVERTEX = _TRIVERTEX;

function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG; Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; external msimg32 name 'GradientFill';

procedure Gradient(Canvas: TCanvas; const R: TRect; Color1, Color2: TColor; Mode: TGradientMode);
const
  uMode: array[TGradientMode] of Integer = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
  vert: array[0..1] of TTriVertex;
  gRect: GRADIENT_RECT;
begin
  vert[0].x      := R.Left;
  vert[0].y      := R.Top;
  with TRGBQuad(ColorToRGB(Color1)) do
  begin
    vert[0].Red    := rgbBlue shl 8;
    vert[0].Green  := rgbGreen shl 8;
    vert[0].Blue   := rgbRed shl 8;
  end;
  vert[0].Alpha  := 0;

  vert[1].x      := R.Right;
  vert[1].y      := R.Bottom;
  with TRGBQuad(ColorToRGB(Color2)) do
  begin
    vert[1].Red    := rgbBlue shl 8;
    vert[1].Green  := rgbGreen shl 8;
    vert[1].Blue   := rgbRed shl 8;
  end;
  vert[1].Alpha  := 0;

  gRect.UpperLeft  := 0;
  gRect.LowerRight := 1;
  GradientFill(Canvas.Handle, @vert, 2, @gRect, 1, uMode[Mode]);
end;

Это сообщение отредактировал(а) CatATonik - 5.2.2007, 10:19

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »