Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 649
Благодарности: 444

Профиль | Отправить PM | Цитировать


Gnom_aka_Lexander,
он и убивается
твой код:
читать дальше »
Код: Выделить весь код
var
  SettingPanel   : TPanel;
  Flag           : boolean;
  Timer          : LongWord;

function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32.dll stdcall';

procedure Timer1;
begin
  if SettingPanel.Top < 0 then SettingPanel.Top := SettingPanel.Top + ScaleY(3);
  if SettingPanel.Top = 0 then KillTimer(WizardForm.Handle, Timer);
end;

procedure Timer2;
begin
  if SettingPanel.Top > -315 then SettingPanel.Top := SettingPanel.Top - ScaleY(3);
  if SettingPanel.Top = -315 then KillTimer(WizardForm.Handle, Timer);
end;


procedure HideShow(Sender: TObject);
begin
  KillTimer(WizardForm.Handle, Timer);
  case Flag of
  True :
    begin
      Timer := SetTimer(WizardForm.Handle, 1, 5 , CallbackAddr('Timer2'));
      TButton(Sender).Caption:='Show';
    end;
  False :
    begin
      Timer := SetTimer(WizardForm.Handle, 1, 5 , CallbackAddr('Timer1'));
      TButton(Sender).Caption:='Hide';
    end;
  end;
  Flag:= not Flag;
end;


procedure InitializeWizard();
 begin
  Flag:= False;

  SettingPanel := TPanel.Create(WizardForm);
  with SettingPanel do
  begin
    Parent := WizardForm;
    SetBounds(ScaleX(0),ScaleY(-315),ScaleX(497),ScaleY(313));
    ParentBackground := False;
  end;

  with TButton.Create(WizardForm) do
  begin
    OnClick:= @HideShow;
    SetBounds(ScaleX(40),ScaleY(327),ScaleX(75),ScaleY(25))
    Caption:='Show';
    Parent:= WizardForm;
  end;
end;


El Sanchez
читать дальше »
Код: Выделить весь код
var
    SettingPanel: TPanel;
    hBtn: TButton;
    //iStartTime: Integer; //debug
    iTimer, iRollInfo: Integer;

function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32.dll stdcall';
//function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall'; //debug


procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD);
var
    iLen, iStep: Integer;
begin
    iLen := iRollInfo and $FFFF;
    iStep := (iRollInfo and $FF0000) shr $10;
    case iRollInfo shr $18 of
        $0: begin
                if SettingPanel.Left >= -iStep then
                begin
                    KillTimer(0, iTimer);
                    hBtn.Enabled := True;
                end;
                SettingPanel.Left := SettingPanel.Left + iStep;
                //WizardForm.Caption := 'time: ' + IntToStr(dwTime-iStartTime) + '; length: ' + IntToStr(SettingPanel.Left); //debug
            end;
        $1: begin
                if SettingPanel.Left <= -iLen + iStep then
                begin
                    KillTimer(0, iTimer);
                    hBtn.Enabled := True;
                end;
                SettingPanel.Left := SettingPanel.Left - iStep;
                //WizardForm.Caption := 'time: ' + IntToStr(dwTime-iStartTime) + '; length: ' + IntToStr(SettingPanel.Left); //debug
            end;
        $2: begin
                if SettingPanel.Top >= -iStep then
                begin
                    KillTimer(0, iTimer);
                    hBtn.Enabled := True;
                end;
                SettingPanel.Top := SettingPanel.Top + iStep;
                //WizardForm.Caption := 'time: ' + IntToStr(dwTime-iStartTime) + '; length: ' + IntToStr(SettingPanel.Top); //debug
            end;
        $3: begin
                if SettingPanel.Top <= -iLen + iStep then
                begin
                    KillTimer(0, iTimer);
                    hBtn.Enabled := True;
                end;
                SettingPanel.Top := SettingPanel.Top - iStep;
                //WizardForm.Caption := 'time: ' + IntToStr(dwTime-iStartTime) + '; length: ' + IntToStr(SettingPanel.Top); //debug
            end;
    end;
end;

procedure RollControl(Ctrl: TControl; dwTime, dwFlag: DWORD);
//  Ctrl    :   control
//  dwTime  :   rolling time, ms
//  dwFlag  :   roll type ($0 - left to right, $1 - right to left, $2 - top to bottom, $3 - bottom to top)
var
    iLen, iStep: Integer;
    iKoeff: Extended;
begin
    iLen := (dwFlag shr $1 xor $1)*Ctrl.Width + (dwFlag shr $1)*Ctrl.Height;
    repeat
        iStep := iStep + 1;
        iKoeff := (iStep * dwTime)/(iLen * 1000/64);
    until iKoeff >= 1;
    //
    if iRollInfo = 0 then iRollInfo := (dwFlag shl $18) or (iStep shl $10) or iLen else iRollInfo := iRollInfo xor $1000000;
    iTimer := SetTimer(0, 0, Trunc(iKoeff)*1000/64, CallbackAddr('TimerProc'));
end;

procedure HideShow(Sender: TObject);
begin
    //iStartTime := GetTickCount; //debug
    RollControl(SettingPanel, 1000, $2);
    TButton(Sender).Enabled := False;
end;

procedure InitializeWizard();
begin
    SettingPanel := TPanel.Create(WizardForm);
    with SettingPanel do
    begin
        Parent := WizardForm;
        SetBounds(ScaleX(0), ScaleY(-315), ScaleX(497), ScaleY(315));
        ParentBackground := False;
    end;

    hBtn := TButton.Create(WizardForm);
    with hBtn do
    begin
        OnClick := @HideShow;
        SetBounds(ScaleX(40), ScaleY(327), ScaleX(75), ScaleY(25));
        Caption := 'Show';
        Parent := WizardForm;
    end;
end;


утечка тем не менее имеет место
к тому же в коде который пилю можно двигать по 1-му пикселю c большой скоростью - явный плюс!
Это сообщение посчитали полезным следующие участники:

Отправлено: 19:57, 09-10-2012 | #1102