Forum Delphi.cz

FreePascal (FPC) a Lazarus => Obecné => Téma založeno: SagTo 22-01-2015, 10:15:15

Název: Předání ParamStr(1) z app do app
Přispěvatel: SagTo 22-01-2015, 10:15:15

Zdravím a pozdravuji,

už nevím jak to napsat. Mám problém v sekci předání hodnoty paramstr v single instance. Napsal jsem to různými způsoby a ani jeden to prostě nepředal. Celý program má zatím jeden formulář a používám navíc RichMemo. Poradíte mi prosím. Celý program mám pak vytvořený pro volné šíření kódu, takže klidně pak kopírujte co můžete. Jde o ST5 formát, který je komprimovanou verzí RTF knihovnou zstream.

Děkuji za pomoc.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  Menus, StdCtrls, ExtCtrls, Spin, ColorBox, RichMemo, Windows, Messages,
  IniFiles, ZStream;

const
  AM_HOTOVO = WM_USER + 101;

type

  { TForm1 }

  TForm1 = class(TForm)
    ColorBox1: TColorBox;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    OpenDialog1: TOpenDialog;
    PageControl1: TPageControl;
    Panel1: TPanel;
    SaveDialog1: TSaveDialog;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    procedure ComboBox1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MenuItem5Click(Sender: TObject);
    procedure MenuItem7Click(Sender: TObject);
    procedure MenuItem8Click(Sender: TObject);
    procedure Otevrit(Adresa:String);
    procedure Ulozit(Adresa:String);
    procedure zjistit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure MenuItem4Click(Sender: TObject);
    procedure SaveDialog1TypeChange(Sender: TObject);
    procedure SpinEdit2Change(Sender: TObject);
  private
    { private declarations }
    procedure MyCopyDataMsg(var Msg: TMessage); message AM_HOTOVO;
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  okna: Integer;
  FMutex:THandle;
  cpStruct: COPYDATASTRUCT;
  Ini:TIniFile;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.MyCopyDataMsg(var Msg: TMessage);
var cdds : TcopyDataStruct;
 begin
  ShowMessage('No tak');
  if msg.Msg = AM_HOTOVO then
   begin
    cdds := PcopyDataStruct(Msg.LParam)^;
    ShowMessage(Pchar(cdds.lpData));
   end;
 end;

procedure TForm1.zjistit(Sender: TObject);
var a,b:String;
    fp:TFontParams;
    m:TParaMetric;
 begin
  a:=Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Name;
  b:=a[9..Length(a)];

  TRichMemo(FindComponent('RichMemo'+b)).GetTextAttributes(TRichMemo(FindComponent('RichMemo'+b)).SelStart, fp);
  TRichMemo(FindComponent('RichMemo'+b)).GetParaMetric(TRichMemo(FindComponent('RichMemo'+b)).SelStart,m);
  Form1.ComboBox1.Text:=fp.Name;
  Form1.SpinEdit1.Value:=fp.Size;
  Form1.ColorBox1.Selected:=fp.Color;

  Form1.SpinEdit2.Value:=m.FirstLine;
  Form1.SpinEdit3.Value:=m.HeadIndent;
  Form1.SpinEdit4.Value:=m.TailIndent;
 end;

procedure TForm1.Otevrit(Adresa:String);
var richmemo:TRichMemo;
    S:TFileStream;
    ms1:TMemoryStream;
    msc:TDeCompressionStream;
    count:Integer;
    a:String;
    Buffer: array[0..4095] of Char;
    m:TParaMetric;
 begin
  okna:=okna+1;
  Form1.PageControl1.AddTabSheet.Name:='TabSheet'+IntToStr(okna);

  if Adresa='' then
   Form1.PageControl1.Page[Form1.PageControl1.PageCount-1].Caption:='Nový '+IntToStr(okna)
  else
   Form1.PageControl1.Page[Form1.PageControl1.PageCount-1].Caption:=Adresa;

  richmemo:=TRichMemo.Create(Self);
  richmemo.Name:='RichMemo'+IntToStr(okna);
  richmemo.Lines.Clear;
  richmemo.OnClick:=@zjistit;
  richmemo.Align:=alClient;
  richmemo.ScrollBars:=ssBoth;
  richmemo.WordWrap:=True;
  richmemo.WantTabs:=True;
  richmemo.Color:=clWhite;

  TControl(richmemo).Parent:=Form1.PageControl1.Pages[Form1.PageControl1.PageCount-1];
  Form1.PageControl1.Pages[Form1.PageControl1.PageCount-1].PageControl.ActivePageIndex:=Form1.PageControl1.PageCount-1;

  Form1.ComboBox1Change(Self);

  if Adresa<>'' then
   begin
    if UpperCase(ExtractFileExt(Adresa))='.RTF' then
     begin
      S:=TFileStream.Create(Utf8ToAnsi(Adresa), fmOpenRead);
      richmemo.LoadRichText(S);
      S.Free;
     end
    else if UpperCase(ExtractFileExt(Adresa))='.ST5' then
     begin
      ms1:=TMemoryStream.Create;
      ms1.LoadFromFile(Utf8ToAnsi(Adresa));
      ms1.Position:=0;
      msc:=TDeCompressionStream.create(ms1);
      try
       while True do
        begin
         count:=msc.Read(Buffer,4096);
         if count<>0 then
          a:=a+Buffer
         else
         Break;
        end;
      finally
       msc.Free;
      end;
      richmemo.Rtf:=a;
      ms1.Free;
     end
    else //nacteni zbytku
     richmemo.Lines.LoadFromFile(Utf8ToAnsi(Adresa));
   end;
 end;

procedure TForm1.Ulozit(Adresa:String);
var ms1,ms2:TMemoryStream;
    msc:Tcompressionstream;
    a,b:String;
 begin
  a:=Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Name;
  b:=a[9..Length(a)];
  if UpperCase(ExtractFileExt(Adresa))='.RTF' then
   begin
    ms1:=TMemoryStream.Create;
    TRichMemo(FindComponent('RichMemo'+b)).SaveRichText(ms1);
    ms1.SaveToFile(AnsiToUtf8(Adresa));
    ms1.Free;
   end
  else if UpperCase(ExtractFileExt(Adresa))='.ST5' then
   begin
    ms1:=TMemoryStream.Create;
    ms2:=TMemoryStream.Create;
    TRichMemo(FindComponent('RichMemo'+b)).SaveRichText(ms2);
    ms2.Position:=0;
    msc:=Tcompressionstream.create(clMax,ms1);
    msc.CopyFrom(ms2,ms2.Size);
    msc.Free;
    ms1.SaveToFile(AnsiToUtf8(Adresa));
    ms1.Free;
    ms2.Free;
   end
  else
   TRichMemo(FindComponent('RichMemo'+b)).Lines.SaveToFile(Adresa);
 end;

procedure TForm1.MenuItem5Click(Sender: TObject);
var a,b:String;
 begin
  if Form1.PageControl1.PageCount>0 then
   begin
    a:=Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Name;
    b:=a[9..Length(a)];
    TRichMemo(FindComponent('RichMemo'+b)).Destroy;
    Form1.PageControl1.Page[Form1.PageControl1.ActivePageIndex].Destroy;
   end;
 end;

procedure TForm1.FormDestroy(Sender: TObject);
 begin
  ini.WriteInteger('NASTAVENI','Width',Form1.Width);
  ini.WriteInteger('NASTAVENI','Height',Form1.Height);
  ini.WriteInteger('NASTAVENI','Top',Form1.Top);
  ini.WriteInteger('NASTAVENI','Left',Form1.Left);
  ini.WriteString('NASTAVENI','Font',Form1.ComboBox1.Text);
  ini.WriteInteger('NASTAVENI','Size',Form1.SpinEdit1.Value);
  ini.WriteString('NASTAVENI','Color',ColorToString(Form1.ColorBox1.Selected));
  ini.WriteInteger('NASTAVENI','StartIdent',Form1.SpinEdit2.Value);
  ini.WriteInteger('NASTAVENI','OffIdent',Form1.SpinEdit3.Value);
  ini.WriteInteger('NASTAVENI','WidthIdent',Form1.SpinEdit4.Value);
  ini.Destroy;
 end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var a,b:String;
    fp:TFontParams;
 begin
  if Form1.PageControl1.PageCount>0 then
   begin
    a:=Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Name;
    b:=a[9..Length(a)];
    TRichMemo(FindComponent('RichMemo'+b)).GetTextAttributes(TRichMemo(FindComponent('RichMemo'+b)).SelStart, fp);
    fp.Color:=Form1.ColorBox1.Selected;
    fp.Size:=Form1.SpinEdit1.Value;
    fp.Name:=Form1.ComboBox1.Text;
    TRichMemo(FindComponent('RichMemo'+b)).SetTextAttributes(TRichMemo(FindComponent('RichMemo'+b)).SelStart, TRichMemo(FindComponent('RichMemo'+b)).SelLength, fp);
   end;
 end;

procedure TForm1.MenuItem7Click(Sender: TObject);
 begin
  if Form1.PageControl1.PageCount>0 then
   if Form1.SaveDialog1.Execute then
    begin
     Form1.Ulozit(Form1.SaveDialog1.FileName);
     Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Destroy;
     Form1.Otevrit(Form1.SaveDialog1.FileName);
    end;
 end;

procedure TForm1.MenuItem8Click(Sender: TObject);
 begin
  if Form1.OpenDialog1.Execute then
   begin
    Form1.Otevrit(Form1.OpenDialog1.FileName);
   end;
 end;

procedure TForm1.MenuItem2Click(Sender: TObject);
 begin
  Form1.Close;
 end;

procedure TForm1.FormCreate(Sender: TObject);
 begin
  okna:=0;
  Form1.SaveDialog1.DefaultExt:='.st5';
  Form1.ComboBox1.Items.Text:=Screen.Fonts.Text;

  ini:=TIniFile.Create(ExtractFileDir(Application.ExeName)+'\nastaveni.ini');
  Form1.Width:=ini.ReadInteger('NASTAVENI','Width',350);
  Form1.Height:=ini.ReadInteger('NASTAVENI','Height',300);
  Form1.Top:=ini.ReadInteger('NASTAVENI','Top',0);
  Form1.Left:=ini.ReadInteger('NASTAVENI','Left',0);
  Form1.ComboBox1.Text:=ini.ReadString('NASTAVENI','Font','Arial');
  Form1.SpinEdit1.Value:=ini.ReadInteger('NASTAVENI','Size',12);
  Form1.ColorBox1.Selected:=StringToColor(ini.ReadString('NASTAVENI','Color','clBlack'));
  Form1.SpinEdit2.Value:=ini.ReadInteger('NASTAVENI','StartIdent',12);
  Form1.SpinEdit3.Value:=ini.ReadInteger('NASTAVENI','OffIdent',12);
  Form1.SpinEdit4.Value:=ini.ReadInteger('NASTAVENI','WidthIdent',12);

  if Paramcount=1 then
   Form1.Otevrit(AnsiToUtf8(ParamStr(1)));
 end;

procedure TForm1.MenuItem4Click(Sender: TObject);
 begin
  Form1.Otevrit('');
 end;

procedure TForm1.SaveDialog1TypeChange(Sender: TObject);
 begin
  if Form1.SaveDialog1.FilterIndex=1 then
   Form1.SaveDialog1.DefaultExt:='.st5'
  else if Form1.SaveDialog1.FilterIndex=2 then
   Form1.SaveDialog1.DefaultExt:='.rtf'
  else if Form1.SaveDialog1.FilterIndex=3 then
   Form1.SaveDialog1.DefaultExt:='.txt';
 end;

procedure TForm1.SpinEdit2Change(Sender: TObject);
var m: TParaMetric;
    a,b:String;
 begin
  if Form1.PageControl1.PageCount>0 then
   begin
    a:=Form1.PageControl1.Pages[Form1.PageControl1.PageIndex].Name;
    b:=a[9..Length(a)];
    TRichMemo(FindComponent('RichMemo'+b)).GetParaMetric(TRichMemo(FindComponent('RichMemo'+b)).SelStart, m);
    m.FirstLine:=Form1.SpinEdit2.Value;
    m.HeadIndent:=Form1.SpinEdit3.Value;
    m.TailIndent:=Form1.SpinEdit4.Value;
    TRichMemo(FindComponent('RichMemo'+b)).SetParaMetric(TRichMemo(FindComponent('RichMemo'+b)).SelStart, TRichMemo(FindComponent('RichMemo'+b)).SelLength, m);
   end;
 end;

procedure SendString(const s: string);
var h:HWND;
 begin
  cpStruct.dwData := 0;
  cpStruct.cbData := length(ParamStr(1)) + 1;
  cpStruct.lpData := pchar(ParamStr(1));
  h := FindWindow(nil,'ST5edit');
  if h > 0 then
   begin
    if SendMessage(h, AM_HOTOVO, 0, LParam(@cpStruct))=1 then
     ShowMessage('Odeslano')
    else
     ShowMessage('Neodeslano');
   end;
 end;

begin

FMutex:=CreateMutex(nil, true, 'ST5editor');
 if GetLastError() = ERROR_ALREADY_EXISTS then
  begin
   Application.Initialize;//showmessage
   if (FMutex<>0) then
    begin
     if Paramcount=1 then
      begin
       SendString(ParamStr(1));
      end;
     CloseHandle(FMutex);
     Exit;
    end;
  end
 else
  begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
   ReleaseMutex(FMutex);
   CloseHandle(FMutex);
  end;

end.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: pf1957 22-01-2015, 12:03:14

Citace: SagTo  22-01-2015, 10:15:15

už nevím jak to napsat. Mám problém v sekci předání hodnoty paramstr v single instance.

Ja mam problemu... A co ti presne nefunguje?

1. Pokud pouzijes JclAppInst, tak tam mas hlidani vice instanci aplikace a predavani parametru vyreseno.
2. Pro posilani dat mezi procesy jsme vzdy pouzivali WM_COPYDATA

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: SagTo 22-01-2015, 12:07:07

Nefunguje mi tam odeslání WM_COPYDATA mezi aplikacemi. Dokonce jsem zkusil uložit finwindow při spuštění první apky do ini a v druhe to nacist z ini a poslat to na dané číslo a stejně to neodeslal.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: pf1957 22-01-2015, 12:23:00

Citace: SagTo  22-01-2015, 12:07:07

Nefunguje mi tam odeslání WM_COPYDATA mezi aplikacemi. Dokonce jsem zkusil uložit finwindow při spuštění první apky do ini a v druhe to nacist z ini a poslat to na dané číslo a stejně to neodeslal.

Jsem si nevsim, ze bys nekde odesilal a prijimal WM_COPYDATA

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: SagTo 22-01-2015, 12:32:54

procedure MyCopyDataMsg(var Msg: TMessage);

pokud vím tak se to předává sem. Tuhle část jsem neprogramoval dlouho, ale mělo by to právě být dobře. Pak to jen přepíši na načtení souboru.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: pf1957 22-01-2015, 14:29:36

Citace: SagTo  22-01-2015, 12:32:54

procedure MyCopyDataMsg(var Msg: TMessage);

pokud vím tak se to předává sem. Tuhle část jsem neprogramoval dlouho, ale mělo by to právě být dobře. Pak to jen přepíši na načtení souboru.

No ale to nema nic spolecneho s WM_COPYDATA, to je jen tvoje dynamicka metoda pro obsluhu prijmu user defined message. Pokud si to pamatuju, tak standardne jsou marshalovany jen systemove zpravy. Co takhle hodit do googlu SendMessage, WM_COPYDATA, Windows IPC via messages apod.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: sagto 23-01-2015, 13:40:34

Je to dost let co jsem programoval a navíc tuhle část. Staré zdrojové kódy, kde jsem měl tyto věci již nemám a hlavně přecházím z delphi na lazarus což je navíc další šok. A posílání sendmessage se single instance jsem z google objevil útržky či tento kód. Proč u singlu nefungoval showmessage jsem zjistil náhodou, když jsem po přemýšlení dál navíc řádek Application.Initialize;. Ale ten zbytek je zatím pro mě záhadou. Vím, že lazarus je pro programování trošičku složitější a proto jsem přešel, protože nejsem klikový programátor, ale některé věci jsem se neučil a nesetkal jsem se s tím v delphi. Proto se ptám jako začátečník

 Teď jsem zkoušel nainstalovat JEDI nejnovější verzi při zjištění, že o tom všichni mluví a pochvalují si to, a jsem z toho zmaten. Nejde mi vytvořit balíček protože furt ciklí na místa kde přitom jsem do balíčku přidal a LPK balíčky jsou nekompatibilní s lazarusem 1.2.6.

Stejně jako nechápu, proč mi do RichMemo nechce načís soubory (v názvu diakritika [zkoušel jsem měnit i utf8<-->ansi a nic]) a to samé v ukládání. A to nejen richmemo ale i tmemorystream a podobně. Což je divné protože když jsem pracoval s SynEdit tak to nedělalo. A hafo informaci o prostředí lazarus jsem nezjistil. Stejně jako procházení ordinálních hodnot a zjistil jsem, že když to člověk hodí do ANSI tak hodně diakritických znaků má ord stejnou, což nechápu proč. Ale když tohle překonám a naprogramuji ST5, tak spíše budu tu už radit nežli se ptát.

Tohle s předchozí otázkou jsou všechny otázky totiž co mám. Děkuji za pochopení.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: Radek Červinka 23-01-2015, 14:50:21

No já používám

Kód: [Vybrat]

      if (JclAppInstances.InstanceCount > 1) then
      begin
        JclAppInstances.SendData(TfrmMain.ClassName, nejaka konstanta, @rInputParam, SizeOf(rInputParam), Application.Handle);
        JclAppInstances.SwitchTo(0);
        JclAppInstances.KillInstance;
      end;

kde rInputParam je nejaky Record napr.
  PXMLData = ^TXMLData;
  TXMLData = packed Record
    iCatalog:integer;
    iID:integer;
    iID2, iID3:integer;
    iList:integer;
    iAction:Integer;
  end;


a pak tam kde to chci prijimat

Kód: [Vybrat]

    procedure WMCopyData(var M: TMessage); message WM_CopyData;
....

procedure TfrmMain.WMCopyData(var M: TMessage);
begin
  if PCopyDataStruct(M.lParam)^.dwData = nejaka konstanta then
  begin
    Application.Restore;
    Application.BringToFront;
    with PXMLData(PCopyDataStruct(M.lParam)^.lpData)^ do
    begin
      if Assigned(Screen.ActiveForm) and (fsModal in Screen.ActiveForm.FormState) then
      begin
        ShowModalError(iCatalog);
        Exit;
      end;


Je to x let co jsem to psal, neni to uplne hezke, ale  nikdo si nestezoval :-) - ale nejakou ideu ti to snad da. Data jsou dostupna pres to with PXMLData...

Zkusil bych si prvni predava record bez retezcu a pak se uvidi.

S Lazarusem ti nepomuzu, nemam na to nervy, myslim ze Lazarus nebo FPC ma vlastni verzi JCL.
Ale moc nechapu věty: hlavně přecházím z delphi na lazarus což je navíc další šok a lazarus je pro programování trošičku složitější a proto jsem přešel.

Název: Re:Předání ParamStr(1) z app do app
Přispěvatel: sagto 23-01-2015, 15:12:50

Mám radši když to je složitější. Víc mě to baví. A na JVC pro lazarus najdu s jsappinstances kde? :-) zatim jsem ho totiž nenašel.