Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Плавный переход одного цвета в другой
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Плавный переход одного цвета в другой
Две процедуры, служащие для отображения прямоугольников с поавным переходом
цветов. Первая процедура рисует вертикальный переход, вторая - горизонтальный.
Параметры процедур:
Canvas - задаёт графический контекст объекта для рисования
Left, Top, Width, Height - границы закрашиваемого прямоугольника
NonGradientArea - ширина области, закрашиваемой цветом Color1 (cм. ниже).
При положительном значении этого параметра, область располагается сверху или
справа, при отрицательном - снизу или слева.
FrameColor - цвет рамки прямоугольника
Color1 - начальный цвет заливки
Color2 - конечный цвет заливки
Зависимости: Windows, SysUtils, Classes, Graphics
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 11 июня 2003 г.
***************************************************** }
function GetColor(Color: Integer): Integer; register
;
asm
cmp eax, 0
jge @@10
and
eax, 000000FFH
push eax
call GetSysColor
@@10:
end
;
procedure
VDrawGradientRect(Canvas: TCanvas; Left, Top, Width, Height: Integer;
NonGradientArea: Integer; FrameColor, Color1, Color2: TColor);
var
Mid: Integer;
Color: TColor;
C1: array
[0..3] of
Byte absolute
Color1;
C2: array
[0..3] of
Byte absolute
Color2;
C: array
[0..3] of
Byte absolute
Color;
i, j, X1, Y1, X2, Y2, Y0, L, X11, X21: Integer;
begin
X1 := Left;
Y1 := Top;
X2 := Left + Width;
Y2 := Top + Height;
Color1 := GetColor(Color1);
Color2 := GetColor(Color2);
with
Canvas do
begin
if
NonGradientArea < 0 then
begin
Mid := Y2 + NonGradientArea;
Y0 := Y1 + 1;
L := Mid - Y0;
X11 := X1 + 1;
X21 := X2 - 1;
for
i := Y1 + 1 to
Mid do
begin
for
j := 0 to
3 do
C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - Y0), L);
Pen.Color := Color;
MoveTo(X11, i);
LineTo(X21, i);
end
;
Pen.Style := psClear;
Brush.Color := Canvas.Pen.Color;
Rectangle(X1 + 1, Mid, X2, Y2);
end
else
begin
Mid := NonGradientArea;
Pen.Style := psSolid;
Y0 := Y2 - 2;
L := Mid - Y0;
X11 := X1 + 1;
X21 := X2 - 1;
for
i := Y2 - 2 downto
Mid do
begin
for
j := 0 to
3 do
C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - Y0), L);
Pen.Color := Color;
MoveTo(X11, i);
LineTo(X21, i);
end
;
Pen.Style := psClear;
Brush.Color := Canvas.Pen.Color;
Rectangle(X1 + 1, Y1 + 1, X2, Mid + 1);
end
;
Pen.Color := FrameColor;
Pen.Style := psSolid;
MoveTo(X1, Y1);
LineTo(X2 - 1, Y1);
LineTo(X2 - 1, Y2 - 1);
LineTo(X1, Y2 - 1);
LineTo(X1, Y1);
end
;
end
;
procedure
HDrawGradientRect(Canvas: TCanvas; Left, Top, Width, Height: Integer;
NonGradientArea: Integer; FrameColor, Color1, Color2: TColor);
var
Mid: Integer;
Color: TColor;
C1: array
[0..3] of
Byte absolute
Color1;
C2: array
[0..3] of
Byte absolute
Color2;
C: array
[0..3] of
Byte absolute
Color;
i, j, X1, Y1, X2, Y2, X0, L, Y11, Y21: Integer;
begin
X1 := Left;
Y1 := Top;
X2 := Left + Width;
Y2 := Top + Height;
Color1 := GetColor(Color1);
Color2 := GetColor(Color2);
with
Canvas do
begin
if
NonGradientArea < 0 then
begin
Mid := X2 + NonGradientArea;
X0 := X1 + 1;
L := Mid - X0;
Y11 := Y1 + 1;
Y21 := Y2 - 1;
Pen.Style := psSolid;
for
i := X0 to
Mid do
begin
for
j := 0 to
3 do
C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - X0), L);
Pen.Color := Color;
MoveTo(i, Y11);
LineTo(i, Y21);
end
;
Pen.Style := psClear;
Brush.Color := Canvas.Pen.Color;
Rectangle(Mid, Y11, X2, Y2);
end
else
begin
Mid := NonGradientArea;
X0 := X2 - 2;
L := Mid - X0;
Y11 := Y1 + 1;
Y21 := Y2 - 1;
Pen.Style := psSolid;
for
i := X0 downto
Mid do
begin
for
j := 0 to
3 do
C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - X0), L);
Pen.Color := Color;
MoveTo(i, Y11);
LineTo(i, Y21);
end
;
Pen.Style := psClear;
Brush.Color := Canvas.Pen.Color;
Rectangle(X1 + 1, Y1 + 1, Mid + 1, Y2);
end
;
Pen.Color := FrameColor;
Pen.Style := psSolid;
MoveTo(X1, Y1);
LineTo(X2 - 1, Y1);
LineTo(X2 - 1, Y2 - 1);
LineTo(X1, Y2 - 1);
LineTo(X1, Y1);
end
;
end
;
Пример использования:
procedureTForm1.FormPaint(Sender: TObject); begin
VDrawGradientRect(Canvas, 0, 0, ClientWidth, ClientHeight, 0, clBtnFace, clHighlight); end
;