Progressmeter i sit eget vindue

Der er da ikke de store problemer med det. Lav en form, smæk en TProgrssBar på. Lav den StayOnTop. Lav tre properties Min, Max, Progress (eller proceduren Increase(aStep: integer)) og du er kørende:

FormStyle := fsStayOnTop;
Position := poOwnerFormCenter;

TProgressForm = class(TForm);
  ProgressBar: TProgressBar;
private
  procedure SetMin(Value: integer); 
  procedure SetMax(Value: integer);
  procedure SetPosition(Value: integer);
  function SGtMin: integer;
  function GetMax: integer;
  function GetPosition: integer;
public
  property Min: integer read GetMin write SetMin;
  property Max: integer read GetMax write SetMax;
  property Position: integer read GetPosition write SetPosition;
  procedure Increase(const aStep: integer);
end;

implementation

procedure TProgressForm.SetMin(Value: integer);
begin
  ProgressBar.Min := Value;
end;

procedure TProgressForm.SetMax(Value: integer);
begin
  ProgressBar.Max := Value;
end;

procedure TProgressForm.SetPosition(Value: integer);
begin
  if ProgressBar.Position <= Value then
  begin
    ProgressBar.Position := Value;
    Application.ProcessMessages;
  end;

end;

function TProgressForm.GetMin: integer;
begin
  result := ProgressBar.Min;
end;

function TProgressForm.GetMax: integer;
begin
  result := ProgressBar.Max;
end;

function TProgressForm.GetPosition: integer;
begin
  result := ProgressBar.Position;
end;

procedure Increase(const aStep: integer);
var
  i: integer;
begin
  for i := ProgressBar.Position to ProgressBar.Position + aStep do
    SetPosition(i);
end;

Hvis dette ikke virker for dig kan man lave det som en tråd og sende Messages til den - skal gerne prøve lave et eksempel. Bare ikke nu, for jeg skal hjem

Hvis du skulle få en ledig stund på et tidspunkt, så må du da meget gerne brygge et eksempel sammen.
Jeg kender godt det der med at skulle hjem - jeg er ved at lave nyt badeværelse, så lillemor synes også at arbejdet tager for meget af min fritid :-)

Jeg har lidt her som du måske kan bruge. Der er en status-form som du kan få frem vha. ShowStatus, fjerne igen med HideStatus og justere vha. SetPosition.

Kan godt poste det hele her, men det fylder meget at skulle poste testprogram, unit, dfm-filer så hvis du hellere vil have en zip-fil må jeg have en email.

Det vil jeg da meget gerne have lov at se

Du kan bruge hp snabela consol punktum dk som mailadresse.

Glemte at lagre filen et sted hvor jeg kunne sende den fra arbejdedet. Sender i eftermiddag. Den flyvske idé med en tråd er ikke relevant; det var et vildskud. Den tunge behandlingsdel burde trådes, ikke statusvisningensformen.

Eksempelvis har jeg en billedklasse, der nedarver fra TImage, som bruger sin egen tråd til at hente billedet fra tabellen. Når formen åbnes, hentes ID på billederne frem, billedobjekterne oprettes. Samtidig med de fyldes i et TScrollPanel startes hente-trådene. Fra et nørdet synspunkt ser det ret godt ud når billederne popper op. En variant af dette: Når tråden har hentet billedet, sender den besked til næste billede i rækken om at aktivere sin tråd. Det ser lidt pænere ud at billederne dukker op i rækkefølge, det tager bare lidt længere tid.

Nu er du ude i noget der lyder meget 'nørdet' i mine ører :-)

Jeg er kun databaseprogrammør så alle de der fancy ting overlader jeg til dem der er eksperter i det - så kommer jeg ikke galt af sted.

Det jeg er igang med er et program der læser nogle records fra en masse Paradox filer og smider dem op på en MySQL server. (nogle records er måske en underdrivelse - der er >4.000.000 i alt)

Kan du ikke bruge DataPump til det?

Det er i øjeblikket > 500 filer af 11 forskellige typer og hver type kan være forskellig i antal felter så jeg har lavet et program der lister filerne en efter en og overfører dem - jeg bruger MyDAC komponenten som jeg har indkøbt til formålet.
Det er meningen at konverteringen skal køre 'unattended' 1 gang hver weekend så det skal være rimeligt foolproof :-)

Lige nu strugler jeg med at finde en eller anden måde at få udført nogle ting under initialisering. Jeg skal have checket om forbindelsen til Paradoxfilerne er OK og om forbindelsen til MySQL er OK. Al min kode ligger i hovedformularen og der kan jeg ikke finde ud af at køre noget kode inden formen vises. Men som jeg vist har nævnt så er Delphi ikke mit hovedsprog :-)

const
  Language = 'Delphi';

if PDoxCount > 500 then
begin
  DataPump := false
  Gnarrl(true);
end
else begin
  if Option_1 then
  begin
    DataPumpAll;
    CopyPDOX_In_MySQL_To_NewMySQL_Database;
  end
  else if Option_2 then
    for i = 0 to PdoxTableCount - 1 do
      LotOfBesvær := ExplicitTableCopy(PDoxTables[i]) = LotOfWork;
end;

end.

Øøøøøh ?

Eksempel modtaget fra HRC bør medføre et svar fra samme da det umiddelbart dækker mit behov.

Smider lige unitten her så andre kan se den (lavet i D2007):

DFM-filen:
----------

object frmStatus: TfrmStatus
  Left = 0
  Top = 0
  Caption = 'Status'
  ClientHeight = 41
  ClientWidth = 467
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  OnClose = FormClose
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object pbStatus: TProgressBar
    Left = 0
    Top = 0
    Width = 467
    Height = 41
    Align = alClient
    Smooth = True
    TabOrder = 0
    ExplicitHeight = 81
  end
end

PAS-filen:
----------

unit FStatus;

interface

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

type
  TfrmStatus = class(TForm)
    pbStatus: TProgressBar;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    function GetValue(const Index: Integer): integer;
    procedure SetValue(const Index, Value: integer);
  public
    constructor Create(aOwner: TComponent; const aMinValue, aMaxValue: integer; const aPosition: integer =  0); reintroduce;
    property Position: integer index 0 read GetValue write SetValue;
    property MinValue: integer index 1 read GetValue write SetValue;
    property MaxValue: integer index 2 read GetValue write SetValue;
    procedure Step(const aSteps: integer);
  end;

procedure ShowStatus(aOwner: TComponent; const aMinValue, aMaxValue, aPosition: integer);
procedure HideStatus;
procedure SetPosition(const aValue: integer);

implementation

{$R *.dfm}

var
  frmStatus: TfrmStatus;

procedure ShowStatus(aOwner: TComponent; const aMinValue, aMaxValue, aPosition: integer);
begin
  if assigned(frmStatus) then
  begin
    frmStatus.MinValue := aMinValue;
    frmStatus.MaxValue := aMaxValue;
    frmStatus.Position := aPosition;
  end
  else
    frmStatus := TfrmStatus.Create(aOwner, aMinValue, aMaxValue, aPosition);

  frmStatus.Show;
end;

procedure HideStatus;
begin
  if assigned(frmStatus) then
    frmStatus.Close;
end;

procedure SetPosition(const aValue: integer);
begin
  if assigned(frmStatus) then
  begin
    frmStatus.Position := aValue;
    Application.ProcessMessages;
  end;
end;

constructor TfrmStatus.Create(aOwner: TComponent; const aMinValue, aMaxValue, aPosition: integer);
begin
  inherited Create(aOwner);
  SetValue(1,aMinValue);
  SetValue(2,aMaxValue);
  SetValue(0,aPosition);
end;

procedure TfrmStatus.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmStatus.FormDestroy(Sender: TObject);
begin
  frmStatus := nil;
end;

function TfrmStatus.GetValue(const Index: Integer): integer;
begin
  case Index of
    0: result := pbStatus.Position;
    1: result := pbStatus.Min;
    2: result := pbStatus.Max;
  end;
end;

procedure TfrmStatus.SetValue(const Index, Value: integer);
begin
  case Index of
    0: pbStatus.Position := Value;
    1: pbStatus.Min := Value;
    2: pbStatus.Max := Value;
  end;
end;

procedure TfrmStatus.Step(const aSteps: integer);
begin
  pbStatus.StepBy(aSteps);
end;

end.

I bunden mangler linjerne:

initialization
  frmStatus := nil;