{***********************************************************
                R&A Library
              R&A Form Designer
       Copyright (C) 192001 Andrei Prygounkov

       description : resource identifers,
                     common global objects,
                     utilities

       author      : Andrei Prygounkov
       e-mail      : a.prygounkov@gmx.de
       www         : http://ralib.hotbox.ru
************************************************************}

{$INCLUDE RA.INC}

unit RAFD;

interface

uses Windows, SysUtils, Forms, Menus, Classes, Controls,
  RARegAuto, RAFDCompat;

type

  ERAFDError = class(Exception)
  public
    ErrCode : integer;
    ErrName : string;
    ErrName2 : string;
    constructor Create(const AErrCode : integer; const AErrName,
      AErrName2 : string);
  end;

  procedure RAFDError(const AErrCode : integer);
  procedure RAFDErrorN(const AErrCode : integer; const AErrName : string);
  procedure RAFDErrorN2(const AErrCode : integer; const AErrName1,
    AErrName2 : string);
  function ResStr(const ID: Integer; const Default: string): string;

  procedure LocaleMenuItem(MenuItem: TMenuItem; const CaptionID, HintID: Integer);


  function GenTempFileName(FileName : string) : string;

  function ResSaveToString(Instance: HINST; const Typ, Name : string;
    var S: string) : boolean;

  function Max(x,y:integer):integer;

  function Min(x,y:integer):integer;

  procedure SwapInt(var Int1, Int2: Integer);

  function Pixels(Control : TControl; APixels : integer) : integer;

  procedure ClearList(List: TList);

  { Cmp compares two strings and returns true if they
    are equal. Case-insensitive.}

  function Cmp(const S1, S2 : string) : boolean;

  function DefStr(const S: string; Default: string): string;

  function FindFormByClass(FormClass : TFormClass) : TForm;

  function KeyPressed(VK : integer) : boolean;

  procedure ODS(const Str: String);

const
  deResBase           = $5400;

  deFileNotFound      = 1;
  deNoFormSelected    = 2;
  deCantSaveFile      = 3;
  deFileChanged       = 4;
  deNotYetImplemented = 5;
  deInternal          = 6;
  deRAI2NotFound      = 7;
  deRAI2FuncNotFound  = 8;
  deLoadExpertFail    = 9;
  deErrorCreatingForm = 10;
  deCantChangeIniStrings = 11;

 { source manipualtion error }
  deCantRenameForm       = 12;
  deCantRenameUnit       = 13;
  deCantRenameMethod     = 14;
  deFormDeclNotFound     = 15;
  deClauseIncorrect      = 16;


  deNoHint = 0;

  deStrBase           = deResBase + $200;

  deOk                = deStrBase + 1;
  deCancel            = deStrBase + 2;
  deHelp              = deStrBase + 3;
  deClose             = deStrBase + 4;
  deIgnore            = deStrBase + 5;
  deIgnoreAll         = deStrBase + 6;


 { Form Designer }
  deBringToFront      = deStrBase + 50;
  deSendToBack        = deStrBase + 51;

 { App Builder - main form }
  deFileMenu                   = deStrBase + 100;
  deEditMenu                   = deStrBase + 101;
  deViewsMenu                  = deStrBase + 102;
  deFileNewItem                = deStrBase + 103;
  deFileNewFormItem            = deStrBase + 104;
  deFileOpenItem               = deStrBase + 105;
  deFileSaveItem               = deStrBase + 106;
  deFileSaveAsItem             = deStrBase + 107;
  deFileSaveAllItem            = deStrBase + 108;
  deFileCloseItem              = deStrBase + 109;
  deFileCloseAllItem           = deStrBase + 110;
  deFileExitItem               = deStrBase + 111;
  deEditDeleteItem             = deStrBase + 112;
  deViewObjInspItem            = deStrBase + 113;
  deViewAlignItem              = deStrBase + 114;
  deViewPaletteItem            = deStrBase + 115;
  deRunMenu                    = deStrBase + 116;
  deRunFormItem                = deStrBase + 117;
  deRunReportPreviewItem       = deStrBase + 118;
  deViewToggleFormUnitItem     = deStrBase + 119;
  deOpenHint                   = deStrBase + 120;
  deSaveAllHint                = deStrBase + 121;
  deViewToggleFormUnitHint     = deStrBase + 122;
  deRunFormHint                = deStrBase + 123;
  deRunReportPreviewHint       = deStrBase + 124;
  deComponentMenu              = deStrBase + 125;
  deViewWindowListItem         = deStrBase + 126;
  deSearchMenu                 = deStrBase + 127;
  deProjectMenu                = deStrBase + 128;
  deToolsMenu                  = deStrBase + 129;
  dePrjViewSourceItem          = deStrBase + 130;
  deToolsOptionsItem           = deStrBase + 131;
  deHelpMenu                   = deStrBase + 132;
  deEditCopyItem               = deStrBase + 133;
  deEditPasteItem              = deStrBase + 134;
  deToolsEditorOptionsItem     = deStrBase + 135;
  deRunUnitItem                = deStrBase + 136;
  deViewPrjMngrItem            = deStrBase + 137;
  deRunProjectItem             = deStrBase + 138;
  deViewUnitItem               = deStrBase + 139;
  deViewFormItem               = deStrBase + 140;
  deRunFormItemHint            = deStrBase + 141;
  deRunReportPreviewItemHint   = deStrBase + 142;
  deRunUnitItemHint            = deStrBase + 143;
  deRunProjectItemHint         = deStrBase + 144;
  deInstallPackagesItem        = deStrBase + 145;

 { Alignment Palette }
  deAlign             = deStrBase + 200;
  deAlign10           = deStrBase + 210;

 { ObjectInspector }
  deObjectInspector   = deStrBase + 220;
  deProperties        = deStrBase + 221;
  deEvents            = deStrBase + 222;

 { String List Editor }
  deStringsEditor     = deStrBase + 230;
  deCodeEditor        = deStrBase + 231;

 { New Items }
  deNewItems          = deStrBase + 240;
  deNew               = deStrBase + 241;

 { Project Manager }
  deProjectManager     = deStrBase + 260;
  dePrjMngrUnit        = deStrBase + 261;
  dePrjMngrForm        = deStrBase + 262;
  dePrjMngrPath        = deStrBase + 263;
  dePrjMngrUpdateItem  = deStrBase + 264;

 { View Dialog }
  deViewDlgUnit        = deStrBase + 290;
  deViewDlgForm        = deStrBase + 291;

 { Installed Packages Dialog }
  dePakListDlgTitle      = deStrBase + 310;
  dePakListDlgAddTitle   = deStrBase + 311;
  dePakListDlgAddFilter  = deStrBase + 312;
  dePakListDlgPackages   = deStrBase + 313;
  dePakListDlgAdd        = deStrBase + 314;
  dePakListDlgRemove     = deStrBase + 315;
  dePakListDlgEdit       = deStrBase + 316;
  dePakListDlgComponents = deStrBase + 317;

 { Read Error Dialog }
  deReadErrorDlgCaption  = deStrBase + 320;
  deReadErrorDlgMessage  = deStrBase + 321;

 { Package Components Dialog }
  dePakComponentsDlgCaption   = deStrBase + 330;
  dePakComponentsDlgInstalled = deStrBase + 331;

 { image resources}
  deImageBase         = 30000;

  deDefaultComponentBitmap = deImageBase + 501;

var
  BaseRegKey: string;
  ActiveModule: HModule;

implementation

{$R rafd.res}
{$R rafd2.res}


procedure RAFDError(const AErrCode : integer);
begin
  raise ERAFDError.Create(AErrCode, '', '');
end;    { RAFDError }

procedure RAFDErrorN(const AErrCode : integer; const AErrName : string);
begin
  raise ERAFDError.Create(AErrCode, AErrName, '');
end;    { RAFDErrorN }

procedure RAFDErrorN2(const AErrCode : integer; const AErrName1,
  AErrName2 : string);
begin
  raise ERAFDError.Create(AErrCode, AErrName1, AErrName2);
end;    { RAFDErrorN2 }

constructor ERAFDError.Create(const AErrCode : integer; const AErrName,
  AErrName2 : string);
begin
  inherited Create('');
  ErrCode := AErrCode;
  ErrName := AErrName;
  ErrName2 := AErrName2;
  // S := LoadStr(ErrCode + ResBase);
  { function LoadStr don't work sometimes :-( }
  Message := Format(ResStr(ErrCode + deResBase, ''), [ErrName, ErrName2]);
end;    { Create }

function ResStr(const ID: Integer; const Default: string): string;
begin
  SetLength(Result, 1024);
  SetLength(Result, LoadString(hInstance, ID, PChar(Result), Length(Result)));
  if Length(Result) = 0 then
    Result := Default;
end;    {  }


procedure LocaleMenuItem(MenuItem: TMenuItem; const CaptionID, HintID: Integer);
begin
  MenuItem.Caption := ResStr(CaptionID, MenuItem.Caption);
  if HintID <> deNoHint then
    MenuItem.Hint := ResStr(HintID, MenuItem.Hint);
end;


function Max(x,y:integer):integer;
begin
  if x > y then Result := x else Result := y;
end;

function Min(x,y:integer):integer;
begin
  if x < y then Result := x else Result := y;
end;

procedure SwapInt(var Int1, Int2: Integer);
var
  Tmp: Integer;
begin
  Tmp := Int1;
  Int1 := Int2;
  Int2 := Tmp;
end;

function Pixels(Control : TControl; APixels : integer) : integer;
var
  Form : TForm;
begin
  Result := APixels;
  if Control is TForm then
    Form := TForm(Control) else
    Form := TForm(GetParentForm(Control));
  if Form.Scaled then
    Result := Result * Form.PixelsPerInch div 96;
end;

function GenTempFileName(FileName : string) : string;
var
  TempDir  : array[0..MAX_PATH] of char;
  TempFile : array[0..MAX_PATH] of char;
  STempDir : TFileName;
  Res : integer;
begin
  TempDir[GetTempPath(260, TempDir)] := #0;
  if FileName <> '' then begin
    if Length(FileName) < 4 then FileName := ExpandFileName(FileName);
    if (Length(FileName) > 4) and (FileName[2] = ':')
        and (StrLen(@TempDir[0]) > 4)
        and (ANSICompareText(TempDir[0], FileName[1]) <> 0)
    then begin
      STempDir := ExtractFilePath(FileName);
      Move(STempDir[1], TempDir, Length(STempDir)+1);
    end;
  end;
  Res := GetTempFileName(
    TempDir, { address of directory name for temporary file}
    '~RA',   { address of filename prefix}
    0,       { number used to create temporary filename}
    TempFile { address of buffer that receives the new filename}
   );
  if Res <> 0 then Result := TempFile else Result := '~R&ATemp.tmp';
  DeleteFile(Result);
end;

function ResSaveToString(Instance: HINST; const Typ, Name : string;
  var S: string) : boolean;
var
  Rhrsrc   : HRSRC;
  Rhglobal : HGLOBAL;
  RAddr    : Pointer;
  RLen     : DWORD;
begin
  Result := false;
  Rhrsrc := FindResource(
    Instance,// resource-module handle
    PChar(Name), // address of resource name
    PChar(Typ) // address of resource type
    );
  if Rhrsrc = 0 then exit;
  Rhglobal := LoadResource(
    Instance, // resource-module handle
    Rhrsrc  // resource handle
  );
  if Rhglobal = 0 then exit;
  RAddr := LockResource(
    Rhglobal // handle to resource to lock
   );
  FreeResource(Rhglobal);
  if RAddr = nil then exit;
  RLen := SizeofResource(
    Instance, // resource-module handle
    Rhrsrc  // resource handle
   );
  if RLen = 0 then exit;
  {А вот теперь можно копировать}
  SetString(S, PChar(RAddr), RLen);
end;

procedure ClearList(List: TList);
var
 i: Integer;
begin
  if not Assigned(List) then Exit;
 for i := 0 to List.Count - 1 do    { Iterate }
  TObject(List[i]).Free;
 List.Clear;
end;    { ClearList }

function Cmp(const S1, S2 : string) : boolean;
begin
  //Result := ANSICompareText(S1, S2) = 0;
  Result := ANSIStrIComp(PChar(S1), PChar(S2)) = 0;
end;

function DefStr(const S: string; Default: string): string;
begin
  if S <> '' then
    Result := S
  else
    Result := Default;
end;

procedure ODS(const Str: String);
begin
  // output debug string
end;

function FindFormByClass(FormClass : TFormClass) : TForm;
var
  i : integer;
begin
  Result := nil;
  for i := 0 to Application.ComponentCount -1 do
    if Application.Components[i].ClassName = FormClass.ClassName then
    begin
      Result := Application.Components[i] as TForm;
      Break;
    end;
end;

function KeyPressed(VK : integer) : boolean;
begin
  Result := GetKeyState(VK) and $8000 = $8000;
end;

initialization
  ActiveModule := hInstance;
end.
