Поради з програмування на DELPHI (ч.6)

Обертання зображення


procedure rotateright(bitmap : timage);
var firstc, lastc, c, r : integer;


procedure fixpixels(c,r : integer);
var savepix, savepix2 : tcolor;
i, newc, newr : integer;
begin
savepix := bitmap.canvas.pixels[c,r];
for i := 1 to 4 do begin
newc := bitmap.height-r+1;
newr := c;
savepix2 := bitmap.canvas.pixels[newc,newr];
bitmap.canvas.pixels[newc,newr] := savepix;
savepix := savepix2;
c := newc;
r := newr;
end;
end;

begin
if bitmap.width <> bitmap.height then exit;
bitmap.visible := false;
with bitmap.canvas do begin
firstc := 0;
lastc := bitmap.width;
for r := 0 to bitmap.height div 2 do begin
for c := firstc to lastc do begin
fixpixels(c,r);
end;
inc(firstc);
dec(lastc);
end;
end;
bitmap.visible := true;
end;


Додавання події onmouseleave


unit bs_label;


interface


uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
stdctrls;


type
tbs_label = class(tlabel)
private
{ private declarations }
fonmouseleave: tnotifyevent;
fonmouseenter: tnotifyevent;
procedure cmmouseenter(var message: tmessage); message cm_mouseenter;
procedure cmmouseleave(var message: tmessage); message cm_mouseleave;
protected
{ protected declarations }
public
{ public declarations }
published
{ published declarations }
property onmouseleave: tnotifyevent read fonmouseleave write fonmouseleave;
property onmouseenter: tnotifyevent read fonmouseenter write fonmouseenter;
end;


procedure register;


implementation


procedure register;
begin
registercomponents(“custom”, [tbs_label]);
end;


{ tbs_label }


procedure tbs_label.cmmouseenter(var message: tmessage);
begin
if assigned(fonmouseenter) then fonmouseenter(self);
end;


procedure tbs_label.cmmouseleave(var message: tmessage);
begin
if assigned(fonmouseleave) then fonmouseleave(self);
end;


end.


Завершення всіх працює додатків


Нижче приведений код, який допоможе вам завершити ВСІ завдання без всяких повідомлень про необхідність збереження даних.
Тому, перш ніж запустити цей код, переконайтеся в наявності збережених даних і в тому, що користувач обізнаний про цю операцію.
procedure tform1.buttonkillallclick(sender: tobject);
var
ptask : ptaskentry;
task : bool;
thistask: thandle;
begin
getmem (ptask, sizeof (ttaskentry));
ptask^.dwsize := sizeof (ttaskentry);


task := taskfirst (ptask);
while task do
begin
if ptask^.hinst = hinstance then
thistask := ptask^.htask
else
terminateapp (ptask^.htask, no_uae_box);
task := tasknext (ptask);
end;
terminateapp (thistask, no_uae_box);
end;

Використання анімованих курсорів


const crmycursor = 1;


procedure tform1.formcreate(sender: tobject);
begin
/ / Завантажуємо курсор. Єдиний спосіб для цього
screen.cursors[crmycursor] :=
loadcursorfromfile(“c:mystuffmycursor.ani”);
/ / Використовуємо курсор на формі
cursor := crmycursor;
end;

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*