Visning af form med form.show virker ikke korrekt

Man kunne vel løse problemet med en timer..?
- vis form med beskeden "vent venligst.."
- start timer der så start funktionene
- når funktionen afslutter, deaktiveres timeren, og vent-formen skjules

det har jeg forsøgt at gøre, men er det helt ærligt den mest optimale løsning..?

syns det virker lidt tosset at bruge en timer til den slags..?

Jeg er ikke helt sikker på at jeg forstår problemet 100%, men er det ikke blot et spøgsmål om at Update'e din form.

men du lukker den jo straks ! (fordi show og close ikke udføres før din knap exiter)
mon du ville bruge showmodal?

nej ok, din funktion kører jo derud af så det er rigitg alligevel.
Det er så som pellelil skriver en update der mangler.
Her er en unit jeg har lavet tidliger der virker fint, eksempel nederst.

unit wait;

interface

uses                                             
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

  function dlg(msg,setup: string): integer;
  procedure info(msg: string);
  function testBreak: boolean;
  procedure resetBreak;
  procedure cursorWait;
  procedure cursorNormal;
  procedure delay(s: real);
  procedure msg(m: string; b: boolean; p: integer);
  procedure subMsg(m: string);
  procedure text(t: string);
  procedure finish;
  procedure update;

var
    breakSignal:            boolean;

type
    TfrmWait = class(TForm)
        lbMsg: TLabel;
        Bevel1: TBevel;
        butAnnuler: TButton;
        pbProgress: TProgressBar;
        lblSubMsg: TLabel;
        procedure butAnnulerClick(Sender: TObject);
    private
    public
        breakFlag:        boolean;
        progressFlag:    boolean;
    end;

var
    frmWait:        TfrmWait;
    frmWaitFlag:    boolean; //true hvis wait-frm på skærm

implementation
uses main;
{$R *.dfm}

function dlg(msg,setup: string): integer;
var
    mt:    TmsgDlgType;
    mb:    TmsgDlgButtons;
begin
    mt:=mtWarning; mb:=[mbOk];
    if pos('error',setup)<>0 then mt:=mtError;
    if pos('info',setup)<>0 then mt:=mtInformation;
    if pos('question',setup)<>0 then begin
        mt:=mtConfirmation;
        mb:=[mbYes,mbNo];
    end;
    if pos('cancel',setup)<>0 then mb:=mb+[mbCancel];
    result:=messageDlg(msg,mt,mb,0);
end; //dlg


procedure info(msg: string);
begin
    dlg(msg,'info');
end; //info


function testBreak: boolean;
begin
    application.ProcessMessages;
    testBreak:=Wait.breakSignal;
end;


procedure resetBreak;
begin
    wait.breakSignal:=false;
end;


procedure delay(s: real);
//vent sec
var
    dt:    TdateTime;
begin
    dt:=now+s/(24*3600);
    while now < dt do application.ProcessMessages;
end; //delay


procedure cursorWait;
begin
    screen.Cursor:=crHourGlass;
end;


procedure cursorNormal;
begin
    screen.Cursor:=crDefault;
end;


procedure msg(m: string; b: boolean; p: integer);
begin
    if not frmWaitFlag then begin
        Application.CreateForm(TfrmWait, frmWait);
        application.ProcessMessages;
    end;
    cursorWait;
    frmWait.lblSubMsg.Visible:=false;
    breakSignal:=false;
    frmWait.position:=poScreenCenter;
    frmWait.breakFlag:=b;
    frmWait.butAnnuler.Visible:=b;
    if p <> 0 then begin
        frmWait.pbProgress.Visible:=true;
        frmWait.pbProgress.Min:=0;
        frmWait.pbProgress.Max:=p;
        frmWait.pbProgress.Step:=1;
        frmWait.lbMsg.Top:=8;
    end else begin
        frmWait.pbProgress.Visible:=false;
        frmWait.lbMsg.Top:=16;
    end;
    frmWait.lbMsg.Caption:=m;

    if not frmWaitFlag then frmWait.show;
    frmWaitFlag:=true;
    application.ProcessMessages;
end; //msg


procedure text(t: string);
begin
    frmWait.lbMsg.Caption:=t;
    update;
end;


procedure subMsg(m: string);
begin
    if frmWaitFlag then begin
        frmWait.lblSubMsg.Caption:=m;
        frmWait.lblSubMsg.Visible:=true;
        update;
    end;
end;


procedure update;
begin
    if frmWaitFlag then begin
        frmWait.pbProgress.StepIt;
        frmWait.refresh;
        application.ProcessMessages;
    end;
end;


procedure finish;
begin
    if frmWaitFlag then begin
        frmWaitFlag:=false;
        frmWait.Free;
        cursorNormal;
        application.ProcessMessages;
    end;
end;


procedure TfrmWait.butAnnulerClick(Sender: TObject);
begin
    breakSignal:=true;
    application.ProcessMessages;
end;

end.

//////////////////////////////

procedure beregn;
begin
  ....
  if testBreak then begin  //man behøves ikke det her men KAN
    if dlg('Vil du stoppe?','question')=mrYes then begin
      ...frigiv etc.
      exit;
    end;
    resetBreak; //vi har behandlet trykket, accepter et evt nyt
  end;
  .....
end; //beregn

procedure butClick;
begin
  wait.msg('Beregner.',true,0); //annuller ON, progress OFF
  beregn; //laver beregning der tager laaang tid og kan breakes
  wait.finish; //lukker af
end;

Prøv selv at lave med progress bar på, subMsg samtidigt er ikke muligt.
Man skal lave en wait.update; i sit loop.

--nop

jeg har defineret min wait form so følger:
formet som et rektangel højede 86, brede 331, uden border or med en bevel omkring.
lbMsg er med stor skrift og cirka på midten til venstre.
lbSubMsg forneden i alm skrift.
pbProgress samme sted som lbSubMsg breden ca 4/5 dele af breden
da: butAnnuller skal stå i forlængelse af pregressbaren/subMsg, altså i nederste højre hjørne.

Hele dfm filen

object frmWait: TfrmWait
  Left = 439
  Top = 306
  BorderIcons = []
  BorderStyle = bsNone
  BorderWidth = 1
  Caption = 'Nordic KOB Manager - vent venligst'
  ClientHeight = 57
  ClientWidth = 321
  Color = clSilver
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 0
    Top = 0
    Width = 321
    Height = 57
    Style = bsRaised
  end
  object lbMsg: TLabel
    Left = 8
    Top = 8
    Width = 4
    Height = 18
    Font.Charset = ANSI_CHARSET
    Font.Color = clWhite
    Font.Height = -15
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object lblSubMsg: TLabel
    Left = 16
    Top = 38
    Width = 49
    Height = 13
    Caption = 'lblSubMsg'
  end
  object butAnnuler: TButton
    Left = 256
    Top = 32
    Width = 57
    Height = 17
    Cursor = crAppStart
    Cancel = True
    Caption = '&Annuller'
    TabOrder = 0
    OnClick = butAnnulerClick
  end
  object pbProgress: TProgressBar
    Left = 8
    Top = 32
    Width = 241
    Height = 17
    Min = 0
    Max = 100
    Smooth = True
    TabOrder = 1
  end
end

Jeg vil gætte på at din function står og kører i en form for løkke, således at systemet "blokeres". Hvis du indfører
  application.ProcessMessages;
I din løkke, får applikationen mulighed for at opdatere din form

Jeg hopper ud af dette spm..
Hvis I har en besked til mig, skriv en henvisning her: http://www.eksperten.dk/spm/501654