Опытный
Профиль
Группа: Участник
Сообщений: 275
Регистрация: 17.6.2006
Репутация: нет
Всего: 1
|
Очень красивые получаются формы,у меня есть шаблон-картинка,выглядит как форма в висте,эффектно смотриться  Но есть свои проблемы. Например если засунуть это дело в dll с формой, то при создании их будет две и в деспетчере задач :( что не очень радует. Но с контролами все будет супер!!! никаких морганий и т.п. Прежде всего тебе надо научить delphi "понимать" png. Ищи в нете компонент pngimage. Потом найди HSLUtils,хотя.. держи | Код |
{$X+}
Unit HSLUtils;
Interface
Uses SysUtils, Windows, Graphics, Math;
Const
MaxHSL: integer = 240;
Type
TRGB = Record R, G, B: Byte; End;
LRec = Record Lo, Hi: Word; End;
WRec = Record Lo, Hi: Byte; End;
Procedure RGBtoHSLRange(RGB: TColor; Var H, S, L: integer);
Function HSLRangeToRGB(H, S, L: integer): TColor;
Function GetRGB(Col: Longint): TRGB;
Function SetRGB(R, G, B: Byte): Longint;
{----------------------------------------------------------------}
{ }Implementation{ }
{----------------------------------------------------------------}
{----------------------------------------------------------------}
Function GetRGB(Col: Longint): TRGB;
Begin
Result.R := 0;
Result.G := 0;
Result.B := 0;
Try
Result.B := WRec(LRec(Col).Hi).Lo;
Result.G := WRec(LRec(Col).Lo).Hi;
Result.R := WRec(LRec(Col).Lo).Lo;
Except
End;
End;
{----------------------------------------------------------------}
Function SetRGB(R, G, B: Byte): Longint;
Begin
Result := 0;
Try
Result := (B * $10000) + (G * $100) + R;
Except
End;
End;
{----------------------------------------------------------------}
Function HSLtoRGB(H, S, L: double): TColor;
Var
M1, M2, V: double;
R, G, B: byte;
Function HueToColourValue(Hue: double): byte;
Begin
Result := 0;
Try
If (Hue < 0) Then
Hue := Hue + 1
Else If (Hue > 1) Then
Hue := Hue - 1;
If (6 * Hue < 1) Then
V := M1 + (M2 - M1) * Hue * 6
Else If (2 * Hue < 1) Then
V := M2
Else If (3 * Hue < 2) Then
V := M1 + (M2 - M1) * (2 / 3 - Hue) * 6
Else
V := M1;
Result := round(255 * V);
Except
End;
End;
Begin
Result := 0;
Try
If (S = 0) Then
Begin
R := byte(Round(255 * L));
G := R;
B := R;
End
Else
Begin
If (L <= 0.5) Then
M2 := L * (1 + S)
Else
M2 := L + S - L * S;
M1 := 2 * L - M2;
R := HueToColourValue(H + 1 / 3);
G := HueToColourValue(H);
B := HueToColourValue(H - 1 / 3);
End;
Result := SetRGB(R, G, B);
Except
End;
End;
{----------------------------------------------------------------}
Procedure RGBtoHSL(Col: TColor; Var H, S, L: double);
Var
R, G, B, D, Cmax, Cmin: double;
rgb: TRGB;
Begin
rgb := GetRGB(Col);
R := rgb.R / 255;
G := rgb.G / 255;
B := rgb.B / 255;
Cmax := Max(R, Max(G, B));
Cmin := Min(R, Min(G, B));
L := (Cmax + Cmin) / 2;
If (Cmax = Cmin) Then
Begin
H := 0;
S := 0;
End
Else
Begin
D := Cmax - Cmin;
If (L < 0.5) Then
S := D / (Cmax + Cmin)
Else
S := D / (2 - Cmax - Cmin);
If (R = Cmax) Then
H := (G - B) / D
Else If (G = Cmax) Then
H := 2 + (B - R) / D
Else
H := 4 + (R - G) / D;
H := H / 6;
If (H < 0) Then
H := H + 1;
End;
End;
{----------------------------------------------------------------}
Function HSLRangeToRGB(H, S, L: integer): TColor;
Begin
Result := 0;
Try
Result := HSLToRGB(H / MaxHSL, S / MaxHSL, L / MaxHSL);
Except
End;
End;
{----------------------------------------------------------------}
Procedure RGBtoHSLRange(RGB: TColor; Var H, S, L: integer);
Var
Hd, Sd, Ld: double;
Begin
RGBtoHSL(RGB, Hd, Sd, Ld);
H := round(Hd * MaxHSL);
S := round(Sd * MaxHSL);
L := round(Ld * MaxHSL);
End;
{----------------------------------------------------------------}
End.
|
А вот это самый лакомый кусочек пользуйтесь. Кстати, если кто доработает пишите сюда. | Код |
{----------------------------------------------------------------}
{ }
{ }IMPLEMENTATION{ }
{ }
{----------------------------------------------------------------}
{$R *.DFM}
Var PNGForm: TForm;
BmpForm: TBitmap;
//Делаем все чтобы красиво было....=)
Procedure FusionForm(Var FusBitmap: TBitmap);
Var TmpBitmap: TBitmap;
pd, pa: pByteArray;
tcol: TRGB;
i, j: Integer;
Begin
TmpBitmap := TBitmap.Create;
TmpBitmap.Width := Form1.Width;
TmpBitmap.Height := Form1.Height;
TmpBitmap.PixelFormat := pf24bit;
TmpBitmap.Canvas.CopyRect(TmpBitmap.Canvas.ClipRect, Form1.Canvas, Form1.Canvas.ClipRect);
FusBitmap := Nil;
FusBitmap := TBitmap.Create;
FusBitmap.Assign(BmpForm);
FusBitmap.PixelFormat := pf32bit;
tcol := GetRGB(Form1.TransparentColorValue);
For j := 0 To BmpForm.Height - 1 Do Begin
pd := FusBitmap.ScanLine[j];
pa := TmpBitmap.ScanLine[j];
For i := 0 To FusBitmap.Width - 1 Do Begin
If (pa[i * 3 + 2] <> tcol.R) Or
(pa[i * 3 + 1] <> tcol.G) Or
(pa[i * 3 + 0] <> tcol.B) Then Begin
pd[i * 4 + 0] := pa[i * 3 + 0];
pd[i * 4 + 1] := pa[i * 3 + 1];
pd[i * 4 + 2] := pa[i * 3 + 2];
pd[i * 4 + 3] := $FF;
End;
End;
End;
TmpBitmap := Nil;
End;
Function UpdateLayeredWindow(hwnd: HWND; hdcDst: HDC; pptDst: PPoint;
psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: TColor;
pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall; external 'user32.dll';
Procedure UpDateForm(Form: TForm; Bmp: TBitmap; Opacite: Byte = $FF);
Const WS_EX_LAYERED = $80000;
Var Size: PSIZE;
TopLeft, BmpTopLeft: TPoint;
Blend: TBlendFunction;
Begin
With Form Do Begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
New(Size);
Size.cx := Width;
Size.cy := Height;
TopLeft := BoundsRect.TopLeft;
BmpTopLeft := Point(0, 0);
With Blend Do Begin
BlendOp := 0;
BlendFlags := 0;
SourceConstantAlpha := Opacite;
AlphaFormat := 1;
End;
Bmp.PixelFormat := pf32bit;
UpdateLayeredWindow(Handle, GetDC(0), @TopLeft, Size,
Bmp.Canvas.handle, @BmpTopLeft, 0, @Blend, 2);
End;
End;
Procedure FadeOutForm(Delay: Integer = 800);
Const Division = 40;
Var x: Integer;
opacite: Byte;
FusBitmap: TBitmap;
Begin
Form1.BringToFront;
FusionForm(FusBitmap);
UpDateForm(PNGForm, Fusbitmap);
Form1.Hide;
For x := 1 To Division Do Begin
opacite := Abs($FF - Round(Max(Min($FF / Division * x, $FF), 0)));
UpDateForm(PNGForm, Fusbitmap, opacite);
Sleep(Delay Div Division);
End;
UpDateForm(PNGForm, BmpForm, 0);
End;
Procedure FadeInForm(Delay: Integer = 800);
Const Division = 20;
Var x: Integer;
opacite: Byte;
FusBitmap: TBitmap;
Begin
Form1.AlphaBlend := True;
Form1.AlphaBlendValue := 0;
PNGForm.Show;
Form1.Show;
Application.ProcessMessages;
FusionForm(FusBitmap);
UpDateForm(PNGForm, Fusbitmap, 0);
Form1.Hide;
Form1.AlphaBlend := False;
Application.ProcessMessages;
For x := 1 To Division Do Begin
opacite := Round(Max(Min($FF / Division * x, $FF), 0));
UpDateForm(PNGForm, Fusbitmap, opacite);
Sleep(Delay Div Division);
End;
Form1.Show;
UpDateForm(PNGForm, BmpForm);
End;
Function MyLoadPNG(fn: String; Var FinalBitmap: TBitmap): Boolean;
Var PNG: TPNGObject;
AlphaBitmap: TBitmap;
pd, pa: pByteArray;
i, j, a: Integer;
Begin
Result := False;
FinalBitmap := Nil;
FinalBitmap := TBitmap.Create;
If (FileExists(fn) = False) Then Begin
ShowMessage('Image ' + ExtractFilename(fn) + ' introuvable.');
Exit;
End;
PNG := TPNGObject.Create;
Try PNG.LoadFromFile(fn);
Except
ShowMessage('Erreur format PNG (' + ExtractFilename(fn) + ')');
PNG := Nil;
Exit;
End;
AlphaBitmap := TBitmap.Create;
AlphaBitmap.Height := PNG.Height;
AlphaBitmap.Width := PNG.Width;
AlphaBitmap.PixelFormat := pf24bit;
FinalBitmap.Assign(PNG);
FinalBitmap.PixelFormat := pf32bit;
If (Png.Transparent) Then Begin
For i := 0 To PNG.Height - 1 Do
For j := 0 To PNG.Width - 1 Do
If (PNG.AlphaScanline[i][j] >= 240) Then
AlphaBitmap.Canvas.Pixels[j, i] := $FFFFFF Else
AlphaBitmap.Canvas.Pixels[j, i] := HSLRangeToRGB(0, 0, PNG.AlphaScanline[i][j]);
End Else Begin
AlphaBitmap.Canvas.Brush.Style := bsSolid;
AlphaBitmap.Canvas.Brush.Color := $FFFFFF;
AlphaBitmap.Canvas.FillRect(AlphaBitmap.Canvas.ClipRect);
End;
For j := 0 To PNG.Height - 1 Do Begin
pd := FinalBitmap.ScanLine[j];
pa := AlphaBitmap.ScanLine[j];
For i := 0 To PNG.Width - 1 Do Begin
a := pa[i * 3];
If (a < 240) Then Begin
pd[i * 4 + 0] := Round(Max(Min(pd[i * 4 + 0] * a / $FF, $FF), 0));
pd[i * 4 + 1] := Round(Max(Min(pd[i * 4 + 1] * a / $FF, $FF), 0));
pd[i * 4 + 2] := Round(Max(Min(pd[i * 4 + 2] * a / $FF, $FF), 0));
End;
pd[i * 4 + 3] := a;
End;
End;
AlphaBitmap := Nil;
PNG := Nil;
Result := True;
End;
Procedure MyDrawPNG(X, Y: Integer; AlphaBitmap, FinalBitmap: TBitmap);
Var pd, pa: pByteArray;
i, ix, j, a, b, ad: Integer;
Begin
If (Assigned(AlphaBitmap) = False) Then Exit;
If (Assigned(FinalBitmap) = False) Then Exit;
FinalBitmap.PixelFormat := pf32bit;
For j := 0 To AlphaBitmap.Height - 1 Do
If (j + Y <= FinalBitmap.Height - 1) And (j + Y >= 0) Then Begin
pd := FinalBitmap.ScanLine[j + Y];
pa := AlphaBitmap.ScanLine[j];
For i := 0 To AlphaBitmap.Width - 1 Do Begin
a := pa[i * 4 + 3];
b := Abs($FF - a);
ix := Max(Min(i + X, FinalBitmap.Width - 1), 0);
ad := pd[ix * 4 + 3];
If (a >= 240) Then Begin
pd[ix * 4 + 0] := pa[i * 4 + 0];
pd[ix * 4 + 1] := pa[i * 4 + 1];
pd[ix * 4 + 2] := pa[i * 4 + 2];
pd[ix * 4 + 3] := $FF;
End Else If (a >= 0) Then Begin
If (ad < 240) Then
b := Round(Max(Min(a + (ad * b) / $FF, $FF), 0));;
pd[ix * 4 + 0] := Round(Max(Min(
pa[i * 4 + 0] + b * pd[ix * 4 + 0] / $FF, $FF), 0));
pd[ix * 4 + 1] := Round(Max(Min(
pa[i * 4 + 1] + b * pd[ix * 4 + 1] / $FF, $FF), 0));
pd[ix * 4 + 2] := Round(Max(Min(
pa[i * 4 + 2] + b * pd[ix * 4 + 2] / $FF, $FF), 0));
If (ad < 240) Then pd[ix * 4 + 3] := b;
End;
End;
End;
End;
Procedure TForm1.FormCreate(Sender: TObject);
Var bmp: TBitmap;
Begin
DoubleBuffered := True;
Color := clFuchsia;
TransparentColorValue := Color;
BorderStyle := bsNone;
// Это фоновая картинка
If (MyLoadPNG('form.png', BmpForm)) Then Begin
Width := BmpForm.Width;
Height := BmpForm.Height;
End;
// Создаешь форму
PNGForm := TForm.Create(self);
With PNGForm Do Begin
Parent := Form1.Parent;
Name := 'PNGForm';
Caption := Form1.Caption;
FormStyle := Form1.FormStyle;
BorderStyle := Form1.BorderStyle;
BorderIcons := [];
Position := Form1.Position;
Left := Form1.Left;
Top := Form1.Top;
Width := Form1.Width;
Height := Form1.Height;
OnMouseDown := FormMouseDown;
DoubleBuffered := True;
Visible := False;
End;
{ // Здесь можешь поверх формы еще одну png нарисовать
MyLoadPNG('6c.png', bmp);
MyDrawPNG(0, 28, bmp, BmpForm);
bmp := Nil; }
// Показываешь все свою мега красивую форму
UpDateForm(PNGForm, BmpForm, 0);
FadeInForm;
End;
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
BmpForm := Nil;
End;
{----------------------------------------------------------------}
{ Надо же нам уметь ее передвигать :) }
{----------------------------------------------------------------}
Procedure TForm1.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var FusBitmap: TBitmap;
Begin
Form1.BringToFront;
If (Button <> mbLeft) Then Exit;
FusionForm(FusBitmap);
UpDateForm(PNGForm, FusBitmap);
Form1.Hide;
PNGForm.Show;
FusBitmap := Nil;
Screen.Cursor := crSizeAll;
X := PNGForm.Left - PNGForm.ScreenToClient(Mouse.CursorPos).X;
Y := PNGForm.Top - PNGForm.ScreenToClient(Mouse.CursorPos).Y;
Repeat
PNGForm.Left := X + ScreenToClient(Mouse.CursorPos).X;
PNGForm.Top := Y + ScreenToClient(Mouse.CursorPos).Y;
Application.ProcessMessages;
Sleep(10);
Until ((GetAsyncKeyState(VK_LBUTTON) And $8000) = 0);
Form1.Left := PNGForm.Left;
Form1.Top := PNGForm.Top;
Screen.Cursor := crDefault;
Form1.Show;
UpDateForm(PNGForm, BmpForm);
End;
{----------------------------------------------------------------}
{ удаляем }
{----------------------------------------------------------------}
Procedure TForm1.Button1Click(Sender: TObject);
Begin
FadeOutForm;
Application.Terminate;
End;
{----------------------------------------------------------------}
End.
|
|
Как создать окно по PNG картинке (с альфа каналом), Как сделать в Delphi или в C++? 
Дата 9.2.2008, 11:56 (
Загрузка ...
