lazarus-ccr/applications/khexeditor/basic.pas

unit Basic;

{$include lazhexeditor.inc}

interface

uses
{$IFDEF FPC}
  LCLType, LCLIntf, LResources,
{$ELSE}
  Windows, Messages,
{$ENDIF}
  Classes, SysUtils, Graphics, StdCtrls, khexeditor, KControls;

type
  TEnvironmentPacked = packed record
    Version: Byte;
    // options
    DropFiles,
    GroupUndo,
    UndoAfterSave: Boolean;
    // appearance
    ShowAddress,
    ShowDigits,
    ShowText,
    ShowHorzLines,
    ShowVertLines,
    ShowSeparators,
    ShowInactiveCaret: Boolean;
    // settings
    AddressMode,
    AddressSize,
    CharSpacing,
    DigitGrouping,
    DisabledDrawStyle,
    LineHeightPercent,
    LineSize,
    UndoLimit: Integer;
    // font
    FontSize: Integer;
    FontStyle: TFontStyles;
  end;

  TEnvironment = record
    P: TEnvironmentPacked;
    AddressPrefix: string;
    FontName: string;
  end;

  PEnvironment = ^TEnvironment;

var
  Environment: TEnvironment;
  Colors: TKColorArray;

  AppName: string;
  IniPath: string;
  IniVersion: Integer;

const
  secSettings = 'Settings';
  secMRUFs = 'MRUFs';
  secColors = 'Custom colors';

procedure DataToString(Buffer: Pointer; Size: Integer; var S: string);
procedure StringToData(const S: string; Buffer: Pointer; Size: Integer);

function Modified2Text(Modified: Boolean): string;
function InsertMode2Text(Mode: Boolean): string;

procedure AddFontsToList(DC: HDC; L: TStrings; Pitch: TFontPitch);
function EditStrToInt(Handle: HWND; Edit: TEdit; AMin, AMax, Default: Integer; var Ok: Boolean): Integer;

procedure InitEnvironment(var Data: TEnvironment);

procedure InitColors(var Colors: TKColorArray);
procedure CopyColors(Src, Dest: TKColorArray);

implementation

uses
  Math, Res, Forms;

type
  PEnumFontData = ^TEnumFontData;
  TEnumFontData = record
    List: TStrings;
    Pitch: TFontPitch;
  end;

procedure DataToString(Buffer: Pointer; Size: Integer; var S: string);
var
  I: Integer;
  T: string;
begin
  SetLength(S, Size * 2);
  for I := 1 to Size do
  begin
    T := Format('%.2x' , [PByteArray(Buffer)^[I - 1]]);
    S[I * 2 - 1] := T[1];
    S[I * 2] := T[2];
  end;
end;

procedure StringToData(const S: string; Buffer: Pointer; Size: Integer);
var
  I, Code: Integer;
  T: string;
begin
  T := '$00';
  for I := 1 to Min(Size, Length(S) div 2) do
  begin
    T[2] := S[I * 2 - 1];
    T[3] := S[I * 2];
    Val(T, PByteArray(Buffer)^[I - 1], Code);
  end;
end;

function EditStrToInt(Handle: HWND; Edit: TEdit; AMin, AMax, Default: Integer; var Ok: Boolean): Integer;
var
  I, Code: Integer;
  S: string;
begin
  Result := Default;
  if Ok then
  begin
    Val(Edit.Text, I, Code);
    if Code > 0 then
      S := sErrIntegerValue
    else if (I < AMin) or (I > AMax) then
      S := Format(sErrIntegerValueOutOfRange, [AMin, AMax])
    else
      S := '';
    if S <> '' then
    begin
      MessageBox(Handle, PChar(S), PChar(sAppName), MB_OK);
      Ok := False;
//      Edit.Text := IntToStr(Default);
      if Edit.CanFocus then
      try
        GetParentForm(Edit).ActiveControl := Edit;
      except
      end;  
    end else
      Result := I;
  end;
end;

function Modified2Text(Modified: Boolean): string;
begin
  if Modified then Result := sModified else Result := '';
end;

function InsertMode2Text(Mode: Boolean): string;
begin
  if Mode then Result := sInsert else Result := sOverWrite;
end;

function EnumFontFamProc(var LFData: TEnumLogFont; var PFData: TNewTextMetric;
  FontType: Integer; Data: PEnumFontData): Integer; stdcall;
begin
  if Data.Pitch = fpFixed then
  begin
    if LFData.elfLogFont.lfPitchAndFamily and 1 = 1 then
      Data.List.Add(LFData.elfLogFont.lfFaceName);
  end else
    Data.List.Add(LFData.elfLogFont.lfFaceName);
  Result := 1;
end;

procedure AddFontsToList(DC: HDC; L: TStrings; Pitch: TFontPitch);
var
  Data: TEnumFontData;
begin
  Data.List := L;
  Data.Pitch := Pitch;
  EnumFontFamilies(DC, nil, @EnumFontFamProc, Integer(@Data));
end;

procedure InitEnvironment(var Data: TEnvironment);
begin
  with Data.P do
  begin
    Version := IniVersion;
    DropFiles := True;
    GroupUndo := True;
    UndoAfterSave := False;
    ShowAddress := True;
    ShowDigits := True;
    ShowText := True;
    ShowHorzLines := False;
    ShowVertLines := False;
    ShowSeparators := True;
    ShowInactiveCaret := True;
    DisabledDrawStyle := Integer(cDisabledDrawStyleDef);
    AddressMode := Integer(cAddressModeDef);
    AddressSize := cAddressSizeDef;
    CharSpacing := cCharSpacingDef;
    LineSize := cLineSizeDef;
    DigitGrouping := cDigitGroupingDef;
    LineHeightPercent := cLineHeightPercentDef;
    UndoLimit := cUndoLimitDef;
    FontSize := cFontSizeDef;
    FontStyle := cFontStyleDef;
  end;
  with Data do
  begin
    AddressPrefix := cAddressPrefixDef;
    FontName := cFontNameDef;
  end;
end;

procedure InitColors(var Colors: TKColorArray);
var
  I: TKHexEditorColorIndex;
begin
  SetLength(Colors, ciHexEditorColorsMax + 1);
  for I := 0 to Length(Colors) - 1 do
    Colors[I] := GetColorSpec(I).Def;
end;

procedure CopyColors(Src, Dest: TKColorArray);
var
  I: TKHexEditorColorIndex;
begin
  for I := 0 to Min(Length(Src), Length(Dest)) - 1 do
    Dest[I] := Src[I];
end;

initialization
  AppName := 'Hex Editor (Demo)';
  IniPath := ExtractFilePath(Application.ExeName) +  'hexeditor.ini';
  IniVersion := 103
end.