Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   FreePascal (https://www.delphipraxis.net/74-freepascal/)
-   -   FreePascal Probleme bei der Code-Übernahme von Delphi ... (https://www.delphipraxis.net/198644-probleme-bei-der-code-uebernahme-von-delphi.html)

mbulm1 21. Nov 2018 11:02

Probleme bei der Code-Übernahme von Delphi ...
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,
ich weiß leider nicht - was ich falsch mache - siehe Bild anbei!
Gibt es bei FreePascal bzw. Lazarus keine Pointer?
Hat jemand eine Idee?
Vielen Dank vorab.
Gruß MB

dummzeuch 21. Nov 2018 11:07

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Ohne zu wissen, wie GetItemByIndex und PWindowItem (? (ist im Bild abgeschnitten)) und der entsprechende Record deklariert sind, kann man dazu wenig sagen.

mbulm1 21. Nov 2018 11:14

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Hier der ganze Quellcode:

Delphi-Quellcode:
unit mb_windowmng;

{$mode objfpc}{$H+}

interface

uses
{  Classes, Forms, SysUtils, Windows, Dialogs, QControls;}
  Classes, Forms, SysUtils, Windows, Dialogs;

type
{ TWinNotifyEvent }
  TWinNotifyEvent = procedure(Sender: TObject; Form: TCustomForm) of object;

{ TWindowItem }
  // I used a packed record to be more flexible for futher improvements
  // which may need to store additional informations.
  PWindowItem = ^TWindowItem;
  TWindowItem = packed record
    Form: Pointer;
  end;

{ TWindowManager }
  TWindowManager = class(TComponent)
  private
    { Private declarations }
    FAutoNotification: Boolean;
    FLastIndex: Integer;
    FWindowList: TList;
    FOnFormAdded: TWinNotifyEvent;
    FOnFormHandled: TNotifyEvent;
    FOnFormRemoved: TWinNotifyEvent;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetFormByIndex(Index: Integer): TCustomForm; virtual;
    function GetWindowItemByIndex(Index: Integer): PWindowItem; virtual;
    function GetWindowItemByForm(const Form1: TCustomForm): PWindowItem; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(const Form: TCustomForm): Boolean; overload;
    function Count: Integer;
    function CreateForm(const Form: TFormClass;
                              Name1: string;
                              Show: Boolean = False): TCustomForm; overload;
    function CreateForm(const Form: TFormClass;
                              Show: Boolean = False): TCustomForm; overload;
    function Exists(const Form: TCustomForm): Boolean;
    function Remove(const Form: TCustomForm): Boolean;
    function Restore(const Index: Integer): Boolean; overload;
    function Restore(const Form: TCustomForm): Boolean; overload;
    property Forms[Index: Integer]: TCustomForm read GetFormByIndex; default;
  published
    { Published declarations }
    property AutoNotification: Boolean read FAutoNotification write FAutoNotification;
    property OnFormAdded: TWinNotifyEvent read FOnFormAdded write FOnFormAdded;
    property OnFormHandled: TNotifyEvent read FOnFormHandled write FOnFormHandled;
    property OnFormRemoved: TWinNotifyEvent read FOnFormRemoved write FOnFormRemoved;
  end;

procedure Register;

implementation

// -----------------------------------------------------------------------------

procedure Register;
begin
  RegisterComponents('Freeware', [TWindowManager]);
end;

// -----------------------------------------------------------------------------

{ TWindowManager }
constructor TWindowManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoNotification := False;
  FLastIndex := -1;
  FWindowList := TList.Create;
end;

destructor TWindowManager.Destroy;
begin
  FWindowList.Free;
  inherited Destroy;
end;

procedure TWindowManager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
//  if (FAutoNotification) and (AComponent <> nil) and (Operation = opRemove)
//      and (AComponent is TCustomForm) and (Exists(TCustomForm(AComponent))) then
  if AComponent <> nil Then
    if (FAutoNotification) and (Operation = opRemove)
      and (AComponent is TCustomForm) and (Exists(TCustomForm(AComponent))) then
      Remove(TCustomForm(AComponent));
  inherited Notification(AComponent, Operation);
end;

function TWindowManager.Add(const Form: TCustomForm): Boolean;
var
  WindowItem: PWindowItem;
begin
  Result := False;
  if not Exists(Form) then
    try
      New(WindowItem);
      WindowItem^.Form := Form;
      FWindowList.Add(WindowItem);
      if FAutoNotification then Form.FreeNotification(Self);
      Result := True;
      if assigned(FOnFormAdded) then FOnFormAdded(Self, Form);
      if assigned(FOnFormHandled) then FOnFormHandled(Self);
    except // wrap up
    end; // try/except
end;

function TWindowManager.Count: Integer;
begin
  Result := FWindowList.Count;
end;

function TWindowManager.CreateForm(const Form: TFormClass;
                                         Name1: string;
                                         Show: Boolean = False): TCustomForm;
begin
  if not Form.InheritsFrom(TCustomForm) then
    raise Exception.Create('Invalid FormClass - must be a descendant of TCustomForm!');
  Result := TCustomForm(Form.Create(Application));
  if Name1 <> '' then Result.Name := Name1;
  Add(Result);
  if Show then Result.Show;
end;

function TWindowManager.CreateForm(const Form: TFormClass;
                                         Show: Boolean = False): TCustomForm;
begin
  Result := CreateForm(Form, '', Show);
end;

function TWindowManager.Exists(const Form: TCustomForm): Boolean;
begin
  Result := GetWindowItemByForm(Form) <> nil;
end;

function TWindowManager.GetFormByIndex(Index: Integer): TCustomForm;
var
  WindowItem: PWindowItem;
begin
  Result := nil;
  WindowItem := GetWindowItemByIndex(Index);
  if WindowItem <> nil then Result := TCustomForm(WindowItem^.Form);
end;

function TWindowManager.GetWindowItemByIndex(Index: Integer): PWindowItem;
begin
  Result := nil;
  if Index < Count then Result := PWindowItem(FWindowList[Index]);
end;

function TWindowManager.GetWindowItemByForm(const Form1: TCustomForm): PWindowItem;
var
  iIndex: Integer;
begin
  Result := nil;
  FLastIndex := -1;
  for iIndex := 0 to FWindowList.Count - 1 do
    if GetWindowItemByIndex(iIndex)^.Form = Form1 then begin
      FLastIndex := iIndex;
      Result := GetWindowItemByIndex(FLastIndex);
      Break;
    end;
end;

function TWindowManager.Remove(const Form: TCustomForm): Boolean;
var
  WindowItem: PWindowItem;
begin
  Result := False;
  WindowItem := GetWindowItemByForm(Form);
  if WindowItem <> nil then
  try
    FWindowList.Delete(FLastIndex);
    Dispose(WindowItem);
    Result := True;
    if assigned(FOnFormRemoved) then FOnFormRemoved(Self, Form);
    if assigned(FOnFormHandled) then FOnFormHandled(Self);
  except // wrap up
  end; // try/except
end;

function TWindowManager.Restore(const Form: TCustomForm): Boolean;
begin
  Result := False;
  if (Form <> nil) and (Exists(Form)) then
    try
      if IsIconic(Form.Handle) then Form.WindowState := wsNormal;
      Form.SetFocus;
      Result := True;
    except // wrap up
  end; // try/except
end;

function TWindowManager.Restore(const Index: Integer): Boolean;
begin
  Result := Restore(GetFormByIndex(Index));
end;

end.

Sherlock 21. Nov 2018 11:43

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Ich würde mal vermuten, daß Pointer und TWindowPointer als nicht Kompatibel gesehen werden. Beides sind zwar Pointer, aber das zweite ist immerhin etwas spezifisch.

OT:
Eines hat Python übrigens Delphi oder Object Pascal deutlich voraus: Man kann über bestimmte Programmierkonstrukte sagen, sie seien nicht "Pythonic". So wie der gezeigt Quellcode nicht Delphisch ist...Nix für ungut, ist vermutlich über Jahr(zehnte) gewachsener Code, den Du so bekommen hast.

Sherlock

DieDolly 21. Nov 2018 11:52

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Warum nicht gleich alles auf eine TList<TForm> umschreiben? Dann ist das Pointerzeug weg und es funktioniert.

mbulm1 21. Nov 2018 11:56

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Zitat:

Zitat von DieDolly (Beitrag 1418600)
Warum nicht gleich alles auf eine TList<TForm> umschreiben? Dann ist das Pointerzeug weg und es funktioniert.

TList<TForm> hört sich gut an - aber ...
Wie geht es genau? GRINS

Wo finde ich Beispiele dazu?

Vielen Dank vorab!

BG MB

gammatester 21. Nov 2018 11:58

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Delphi-Quellcode:
GetWindowItemByIndex(iIndex)^.Form
ist ein Pointer und Form1 ein
Delphi-Quellcode:
TCustomForm
. Warum sollte man das vergleichen können? Funktioniert das denn in Delphi?

mbulm1 21. Nov 2018 12:04

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Zitat:

Zitat von gammatester (Beitrag 1418602)
Delphi-Quellcode:
GetWindowItemByIndex(iIndex)^.Form
ist ein Pointer und Form1 ein
Delphi-Quellcode:
TCustomForm
. Warum sollte man das vergleichen können? Funktioniert das denn in Delphi?

Ja - in Delphi funktioniert das ohne Probleme!

gammatester 21. Nov 2018 12:13

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Funktioniert es mit
Delphi-Quellcode:
{$mode delphi}
? Wenn ja, warum benutzt Du
Delphi-Quellcode:
{$mode objfpc}
?

DieDolly 21. Nov 2018 12:13

AW: Probleme bei der Code-Übernahme von Delphi ...
 
Nur so dahingeschrieben

Delphi-Quellcode:
var FormList: TList<TCustomForm>



FormList := TList<TCustomForm>.Create;



FormList.Add(Result);



for i := 0 to FormList.Count - 1 do
 begin
  if FormList.Items[i] = Form1 then
   begin
    FLastIndex := iIndex;
    Result := FormList.Items[i];
    Break;
   end;
 end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:50 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz