Recent

Author Topic: Project compatible on other platforms?  (Read 4671 times)

yorako1

  • Guest
Project compatible on other platforms?
« on: January 15, 2012, 11:05:18 pm »
Hi there,

I'm new to Lazarus... Not really because I use Delphi, yet.

I tried a small project: A FileRenamer... Nothing new, I know; but anyway: is this really compatible to all platforms?
I come from Windows. (luckily or not, it depends ;)

Here's my first Lazarus/FreePascal Dummy-Project...
Windows project:
http://yorako1.bplaced.net/lazarus/Renamer_exe.zip

Source code:
http://yorako1.bplaced.net/lazarus/Renamer_SourceCode.zip

What is important to know to carefully design projects making it available to all platforms?

BTW: Lazarus is really great! It's a "wow" worth it! ;)

Would my first project suit to other platforms if I'd compile it there on it?

Thanks,

yorako1

//EDIT (source code posted, if you don't wanna download)
Code: [Select]
unit MainRenamer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls;

type

  { TWaitCursor }

  TWaitCursor = class(TInterfacedObject, IUnknown)
  private
    FCursor: TCursor;
    constructor Create(ACursor: TCursor);
  public
    destructor Destroy; override;
    class function SetCursor(ACursor: TCursor = crHourglass): IUnknown;
  end;

type
  TCBRenameProc = function(AInFileName, AExt: String): Boolean of object; stdcall;
  TCBStatusProc = procedure(const APos, AMax: Integer) of object; stdcall;

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    Bevel1: TBevel;
    Bevel2: TBevel;
    btnCancel: TButton;
    edExt: TEdit;
    edNewName: TEdit;
    edInsertString: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    lblSample: TLabel;
    ProgressBar1: TProgressBar;
    rbChangeExt: TRadioButton;
    rbChangeName: TRadioButton;
    rbInsertBeforeExt: TRadioButton;
    procedure ApplicationProperties1DropFiles(Sender: TObject;
      const FileNames: array of String);
    procedure btnCancelClick(Sender: TObject);
    procedure edInsertStringChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rbChangeExtChange(Sender: TObject);
  private
    FCancel: Boolean;
    function GetUniqueFileName(s, sBase: string): String;
    function DoRename(AInFileName, AExt: String): Boolean; stdcall;
    function DoRenameNew(AInFileName, ANewFileName: String): Boolean; stdcall;
    function DoRenameInsertString(AInFileName, s: String): Boolean; stdcall;

    procedure NotifyState(const APos, AMax: Integer); stdcall;
    procedure DoRenameFiles(FileNames: array of String; ACallback: TCBRenameProc; AText: String); stdcall;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

const
  strVersion = 'v1.01';
  strSample = 'z.B. "MeineDatei%s.txt"';


implementation

{ TWaitCursor }

constructor TWaitCursor.Create(ACursor: TCursor);
begin
  inherited Create;
  FCursor := Screen.Cursor;
  Screen.Cursor := ACursor;
end;

destructor TWaitCursor.Destroy;
begin
  Screen.cursor := FCursor;
  inherited Destroy;
end;

class function TWaitCursor.SetCursor(ACursor: TCursor): IUnknown;
begin
  Result := TWaitCursor.Create(ACursor);
end;

{$R *.lfm}

{ TForm1 }

procedure TForm1.ApplicationProperties1DropFiles(Sender: TObject;
  const FileNames: array of String);
var
  ACursor: IUnknown;
begin
  ProgressBar1.Position:=0;
  ProgressBar1.Visible:=true;
  try
    if rbChangeExt.Checked then
    begin
      if trim(edExt.Text)='' then
      begin
        ShowMessage('Keine Endung angegeben!');
        Exit;
      end;
    end
    else
    if rbChangeName.Checked then
    begin
      if trim(edNewName.Text)='' then
      begin
        ShowMessage('Keinen Dateinamen angegeben!');
        Exit;
      end;
    end
    else
    if rbInsertBeforeExt.Checked then
    begin
      if trim(edInsertString.Text)='' then
      begin
        ShowMessage('Keinen Einfüge-String angegeben!');
        Exit;
      end;
    end;

    if MessageDlg('Wirklich alle Dateien umbenennen?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
    begin
      ACursor := TWaitCursor.SetCursor;
      Application.ProcessMessages;
      FCancel:=False;
      btnCancel.Visible:=True;
      try
        if rbChangeExt.Checked then
        begin
          DoRenameFiles(FileNames,@DoRename,edExt.Text);
        end
        else
        if rbChangeName.Checked then
        begin
          DoRenameFiles(FileNames,@DoRenameNew,edNewName.Text);
        end
        else
        if rbInsertBeforeExt.Checked then
        begin
          DoRenameFiles(FileNames,@DoRenameInsertString,edInsertString.Text);
        end;
      finally
        FCancel:=False;
        btnCancel.Visible:=False;
      end;
    end;
  finally
    ProgressBar1.Position:=0;
    ProgressBar1.Visible:=False;
  end;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  btnCancel.Visible:=False;
  FCancel := True;
end;

procedure TForm1.edInsertStringChange(Sender: TObject);
begin
  lblSample.Caption:=Format(strSample,[edInsertString.Text]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FCancel := False;
  Caption := Application.Title + ' ' + strVersion;
  edInsertStringChange(nil);
end;

procedure TForm1.rbChangeExtChange(Sender: TObject);
begin
  if (Sender is TRadioButton) then
  begin
    with (Sender as TRadioButton) do
    begin
      case Tag of
        0:  // by Extension
          begin
            Label2.Enabled:=True;
            Label3.Enabled:=True;
            edExt.Enabled:=True;
            Label5.Enabled:=False;
            edNewName.Enabled:=False;
            Label6.Enabled:=false;
            Label7.Enabled:=False;
            edInsertString.Enabled:=False;
            lblSample.Enabled:=False;
            edExt.SetFocus;
          end;
        1:  // by Name
          begin
            Label2.Enabled:=False;
            Label3.Enabled:=False;
            edExt.Enabled:=False;
            Label5.Enabled:=True;
            edNewName.Enabled:=True;
            Label6.Enabled:=True;
            Label7.Enabled:=False;
            edInsertString.Enabled:=False;
            lblSample.Enabled:=False;
            edNewName.SetFocus;
          end;
        2:  // by InsertString
          begin
            Label2.Enabled:=False;
            Label3.Enabled:=False;
            edExt.Enabled:=False;
            Label5.Enabled:=False;
            edNewName.Enabled:=False;
            Label6.Enabled:=False;
            Label7.Enabled:=True;
            edInsertString.Enabled:=True;
            lblSample.Enabled:=True;
            edInsertString.SetFocus;
          end;
      end;
    end;
  end;
end;

function TForm1.GetUniqueFileName(s, sBase: string): String;
var
  i: integer;
  s1: string;
  sExt: String;
begin
  Result := '';
  i := 0;
  sExt := ExtractFileExt(sBase);
  s1 := IncludeTrailingPathDelimiter(ExtractFilePath(s))+ ExtractFileNameWithoutExt(sBase) + IntToStr(i) + sExt;
  while FileExistsUTF8(s1) do
  begin
    inc(i);
    s1 := IncludeTrailingPathDelimiter(ExtractFilePath(s))+ ExtractFileNameWithoutExt(sBase) + IntToStr(i) + sExt;
  end;
  Result := s1;
end;

function TForm1.DoRename(AInFileName, AExt: String): Boolean; stdcall;
begin
  result := False;
  if not FileExistsUTF8(AInFileName) then
    Exit;
  try
    Result := RenameFileUTF8(AInFileName,ChangeFileExt(AInFileName,AExt));
  except
    Result := False;
  end;
end;

function TForm1.DoRenameNew(AInFileName, ANewFileName: String): Boolean; stdcall;
begin
  result := False;
  if not FileExistsUTF8(AInFileName) then
    Exit;
  try
    Result := RenameFileUTF8(AInFileName,GetUniqueFileName(AInFileName,ANewFileName));
  except
    Result := False;
  end;
end;

function TForm1.DoRenameInsertString(AInFileName, s: String): Boolean; stdcall;
var
  s1,sExt: String;
begin
  result := False;
  if not FileExistsUTF8(AInFileName) then
    Exit;
  s1 := ExtractFileNameWithoutExt(AInFileName);
  sExt := ExtractFileExt(AInFileName);
  try
    Result := RenameFileUTF8(AInFileName,s1+s+sExt);
  except
    Result := False;
  end;
end;

procedure TForm1.NotifyState(const APos, AMax: Integer); stdcall;
begin
  ProgressBar1.Position:=APos;
  ProgressBar1.Max:=AMax;
  Repaint;
end;

procedure TForm1.DoRenameFiles(FileNames: array of String;
  ACallback: TCBRenameProc; AText: String); stdcall;
var
  i: integer;
  AProc: TCBStatusProc;
begin
  if assigned(ACallback) then
  begin
    AProc := @NotifyState;
    for i := low(FileNames) to high(FileNames) do
    begin
      Application.ProcessMessages;
      if FCancel then
      begin
        ShowMessage('Vorgang abgebrochen!');
        Exit;
      end;
      if not ACallback(FileNames[i],AText) then
      begin
        ShowMessage('Fehler!');
        Exit;
      end;
      if ProgressBar1.Visible then
      begin
        AProc(i,high(FileNames));
      end;
    end;
    ShowMessage('Fertig!');
  end;
end;

end.

« Last Edit: January 15, 2012, 11:16:08 pm by yorako1 »

Leledumbo

  • Hero Member
  • *****
  • Posts: 8785
  • Programming + Glam Metal + Tae Kwon Do = Me
Re: Project compatible on other platforms?
« Reply #1 on: January 15, 2012, 11:32:45 pm »
Quote
What is important to know to carefully design projects making it available to all platforms?
Here you go.

yorako1

  • Guest
Re: Project compatible on other platforms?
« Reply #2 on: January 15, 2012, 11:42:14 pm »
Thank you!  :)

This means I was quite next to it and "forget"/take care of shell or sth...

I took a look at lcl units... really cool...

 

TinyPortal © 2005-2018