Programalama > DELPHI

procedure TAHMAssociationsDlg.Setup(Associations : String;HelpID:LongInt);
var FxA,FxAssociations : String;
    CellI : Integer;
begin
  Width:=365;
  Height:=255;
  Position:=poScreenCenter;
  Caption:=ahmscassocdlgcap;
  BorderIcons:=[biSystemMenu];
  BorderStyle:=bsDialog;
  Panel:=TPanel.Create(self);
  with Panel do
  begin
    Align:=alBottom;
    bevelOuter:=bvNone;
    Caption:='';
    Height:=36;
    Parent:=self;
    with TButton.Create(self) do
    begin
      modalresult:=mrOk;
      Top:=8;
      Left:=120+(Integer(HelpID=0)*80);
      Parent:=Panel;
      Caption:=ahmscbutok;
    end;
    with TButton.Create(self) do
    begin
      modalresult:=mrCancel;
      Top:=8;
      Left:=200+(Integer(HelpID=0)*80);
      Parent:=Panel;
      Caption:=ahmscbutCancel;
    end;
    if (HelpID<>0) then
    with TButton.Create(self) do
    begin
      modalresult:=mrNone;
      Top:=8;
      Left:=280;
      Parent:=Panel;
      OnClick:=CallHelp;
      Tag:=HelpID;
      Caption:=ahmscbutHelp;
    end;
  end;
  Stringgrid:=TStringGrid.Create(self);
  with StringGrid do
  begin
    Left:=8;
    Width:=338;
    Top:=8;
    Height:=184;
    RowCount:=50;
    FixedCols:=0;
    ColCount:=2;
    DefaultColWidth:=158;
    DefaultRowHeight:=17;
    Options:=[goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,goRangeSelect,goEditing,goTabs,goAlwaysShowEditor];
    Cells[0,0]:=ahmscassocdlgcapname;
    Cells[1,0]:=ahmscassocdlgcapname2;
    FxAssociations:=Associations;
    CellI:=1;
    while pos('|',FxAssociations)>0 do
    begin
      FxA:=Copy(FxAssociations,1,Pos('|',FxAssociations)-1);
      Delete(FxAssociations,1,Pos('|',FxAssociations));
      Cells[0,CellI]:=copy(FxA,1,Pos(':',FxA)-1);
      Cells[1,CellI]:=copy(FxA,Pos(':',FxA)+1,Length(FxA));
      Inc(CellI);
    end;
    Parent:=self;
  end;
end;

procedure TAHMAssociationsDlg.CallHelp(Sender : TObject);
begin
  Application.HelpContext((Sender as TButton).Tag);
end;

Function CreateAssociations(var Associations : String;HelpID:LongInt) : Boolean;
Var I : Integer;
begin
   with TAHMAssociationsDlg.CreateNew(Application) do
   try
     Setup(Associations,HelpID);
     result:=showmodal=mrOk;
     if result then
     begin
       Associations:='';
       for I:=1 to 50 do
       if StringGrid.Cells[0,I]<>'' then
        Associations:=Associations+StringGrid.Cells[0,I]+':'+StringGrid.Cells[1,I]+'|';
     end;
   finally
     free;
   end;
end;

procedure TAHMAssociations.SetExtensions(const Value: String);
begin
  FExtensions:=Value;
end;

function TAHMAppManager.ApplyAssociations: Boolean;
begin
  result:=FAssociations.ApplyAll;
end;


procedure TAHMAppManager.SetFlashInterval(const Value: Integer);
begin
  FFlashInterval := Value;
  FTimer.Interval:=FFlashInterval;
end;


function TAHMAppManager.ShowAssociations: Boolean;
var Msg : String;
    RegVal : String;
    HelpID : LongInt;
begin
  HelpID:=0;
  result:=False;
  RegVal:=Copy(ExtractFileName(Application.ExeName),1,Pos('.',ExtractFileName(Application.ExeName))-1)+ahmscdocument;
  with TRegistry.Create do
  try
    RootKey:=HKEY_CLASSES_ROOT;
    OpenKey(RegVal,True);
    if not(csdesigning in Componentstate) then
    begin
      try
        Msg:=ReadString(ahmscAssociations);
      except
        Msg:=Associations.Extensions;
      end;
      Msg:=Associations.GetAll(Msg);
      HelpID:=Associations.Help;
    end else Msg:=Associations.Extensions;
    Associations.DeleteAll(Msg);
    if CreateAssociations(Msg,HelpId) then
    begin
      Associations.Extensions:=Msg;
      if not(csdesigning in Componentstate) then WriteString(ahmscAssociations,Msg);
      result:=True;
      ApplyAssociations;
    end;
    CloseKey;
  finally
    free;
  end;
end;

procedure TAHMAppManager.SetMainForm(const Value: Boolean);
begin
  FMainForm := Value;
  if not(csDesigning in Componentstate) then Application.ShowMainForm:=Value;
end;

procedure TAHMAppManager.SetParamStore(const Value: TAHMStoreData);
begin
  FParamStore := Value;
  if Value <> nil then Value.FreeNotification(self);
end;

Procedure TAHMAppManager.UpdateService(const Value : Boolean);
begin
  if not(csdesigning in Componentstate) then
  if Value then
  begin
    if RegisterServiceProcess(GetCurrentProcessID, 1)<>0 then
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(ahmscservicekey, False);
      WriteString(Application.Title,Application.Exename);
      CloseKey;
    finally
      Free;
    end;
  end
  else
  begin
    if RegisterServiceProcess(GetCurrentProcessID, 0)<>0 then
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(ahmscservicekey, False);
      DeleteValue(Application.Title);
      CloseKey;
    finally
      Free;
    end;
  end;
end;


procedure TAHMAppManager.SetAsService95(const Value: Boolean);
begin
  FAsService95 := Value;
  UpdateService(Value);
end;

procedure TAHMAssociations.AssociationsMacro(Sender: TObject; Msg: TStrings);
var
  i : Integer;
  FParameter,FCommand : AnsiString;
function parseverb(commanddde : ansistring; var pos : integer; var verb : ansistring) : boolean;
const
  caracteresinterdits = ['(',')',' ',#9,#0];
begin
  result := false;
  if (commanddde[pos] in caracteresinterdits) then exit;
  verb := verb+commanddde[pos];
  inc(pos);
  while ((commanddde[pos] in caracteresinterdits) = false) do
  begin
    verb := verb+commanddde[pos];
    inc(pos);
  end;
  result := true;
end;

function parsearg(commanddde : ansistring; var pos : integer; var arg : ansistring) : boolean;
const caracteresinterdits = ['"',#0];
begin
  result := True;
  if (commanddde[pos] <> '"') then exit;
  inc(pos);
  while ((commanddde[pos] in caracteresinterdits) = false) do
  begin
    arg := arg+commanddde[pos];
    inc(pos);
  end;
  if (commanddde[pos] = '"') then inc(pos) else result := False;
end;


function ParseAHMDDEConv(commanddde : ansistring; var verb : ansistring; var arg : ansistring) : boolean;
var i : integer;
begin
  result := false;
  i := 1;
  if (commanddde[i]<>'[') then exit;
  inc(i);
  if (parseverb(commanddde,i,verb) = False) then exit;
  if (commanddde[i] <> '(') then exit;
  inc(i);
  if (parsearg(commanddde,i,arg) = False) then exit;
  if (commanddde[i] <> ')') then exit;
  inc(i);
  if (commanddde[i] <> ']') then exit;
  result := True;
end;
begin
  for i := 0 to Msg.count-1 do
  begin
    if ParseAHMDDEConv(Msg[i],FCommand,FParameter) then
     if lowercase(FCommand)<>'open' then
     begin
       if assigned(FOwner.FOnDDEMacro) then FOwner.FOnDDEMacro(self,FCommand,FParameter);
     end else
     begin
       if assigned(FOwner.FOnFileOpen) then FOwner.FOnFileOpen(self,FParameter);
     end;
  end;
end;

procedure TAHMAssociations.SetDDEUniqueName(const Value: String);
begin
  FDDEUniqueName := Value;
  if not(csDesigning in FOwner.Componentstate) then FDDEServerConf.Name:=Value;
end;


end.