⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hsrvra~2.~pa

📁 TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,
💻 ~PA
字号:
unit HSrvrAli;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, xqbase, xquery, HalcnQry, Grids, Dialogs, ComCtrls,
  Menus;

{$R halcres.res}

type
  THalcSrvrAliases = class(TForm)
    Panel1: TPanel;
    BtnDelete: TButton;
    BtnBrowse: TButton;
    DrawGrid1: TDrawGrid;
    OpenDialog1: TOpenDialog;
    Panel2: TPanel;
    ListBox1: TListBox;
    BtnAddIF: TButton;
    BtnDeleteIF: TButton;
    OpenDialog2: TOpenDialog;
    MainMenu1: TMainMenu;
    Server1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    VisitTxQueryhomepage1: TMenuItem;
    SendmailtoTxQuery1: TMenuItem;
    N2: TMenuItem;
    About1: TMenuItem;
    StatusBar1: TStatusBar;
    N1: TMenuItem;
    Configuration1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure DrawGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure BtnBrowseClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure DrawGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure BtnAddIFClick(Sender: TObject);
    procedure BtnDeleteIFClick(Sender: TObject);
    procedure DrawGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure VisitTxQueryhomepage1Click(Sender: TObject);
    procedure SendmailtoTxQuery1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Exit1Click(Sender: TObject);
    procedure Configuration1Click(Sender: TObject);
  private
    { Private declarations }
    FDataList : TDataList;
    FBitmap  : TBitmap;
    FLastRow : Integer;
    procedure DisplayHint(Sender: TObject);
  public
    { Public declarations }
  end;

var
  HalcSrvrAliases: THalcSrvrAliases;

implementation

{$R *.DFM}

uses
   HSrvrCfg, HSrvrAb, DemoReg, xqmiscel;

procedure THalcSrvrAliases.FormDestroy(Sender: TObject);
begin
   FBitmap.Free;
end;

procedure THalcSrvrAliases.DrawGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
   //BtnBrowse.Enabled := (ACol = 2) or ((ARow > FDataList.Count) and (ACol = 2));
   if (ARow <= FDataList.Count) and (FLastRow <> ARow) then
   begin
      ListBox1.Items.Assign(FDataList[ARow - 1].IndexFiles);
      FLastRow := ARow;
   end;
   ListBox1.Enabled     := ARow <= FDataList.Count;
   BtnAddIF.Enabled     := ListBox1.Enabled;
   BtnDeleteIF.Enabled  := ListBox1.Enabled;
   DrawGrid1.Invalidate;
end;

procedure THalcSrvrAliases.DrawGrid1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  Text   : String;
  Justif : Word;
  X, Y   : Integer;
begin
   if (csDestroying in ComponentState) then Exit;
   with DrawGrid1.Canvas do
   begin
      if (ARow = 0) and (ACol > 0) then
      begin
         { draw the titles }
         case ACol of
            1 : Text := 'Alias';
            2 : Text := 'Path and file name';
         end;
         Font.Style  := [fsBold];
         Justif      := DT_LEFT;
         DrawText(Handle, PChar(Text), -1, Rect, Justif or DT_SINGLELINE or DT_VCENTER);
      end else if (ARow > 0) and (ACol = 0) then
      begin
        if ARow = DrawGrid1.Row then
        begin
           { draw the arrow }
           X := Rect.Left + ( (Rect.Right - Rect.Left) - FBitmap.Width ) div 2;
           Y := Rect.Top  + ( (Rect.Bottom - Rect.Top) - FBitmap.Height ) div 2;
           Draw(X, Y, FBitmap);
        end else
           FillRect(Rect);
      end else
      begin
         { draw the alias information }
         if ARow > FDataList.Count then Exit;
         case ACol of
            1 : Text := FDataList[ARow - 1].Alias;
            2 : Text := FDataList[ARow - 1].FileName;
         end;
         Font.Style  := [];
         Justif      := DT_LEFT;
         DrawText(Handle, PChar(Text), -1, Rect, Justif or DT_SINGLELINE or DT_VCENTER);
      end;

   end;
end;

procedure THalcSrvrAliases.DrawGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
  if ARow > FDataList.Count then Exit;
  case ACol of
   1 : Value := FDataList[ARow - 1].Alias;
   2 : Value := FDataList[ARow - 1].FileName;
  end;
end;

procedure THalcSrvrAliases.DrawGrid1SetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
var
   IndexFiles : TStringList;
begin
  if ARow <= FDataList.Count then
  begin
     case ACol of
      1 : FDataList[ARow - 1].Alias    := Value;
      2 : FDataList[ARow - 1].FileName := Value;
     end;
  end else
  begin
     if Length(Value) = 0 then Exit;
     IndexFiles := TStringList.Create;
     try
        case ACol of
         1 : FDataList.Add('', Value, IndexFiles);
         2 : FDataList.Add(Value, '', IndexFiles);
        end;
        DrawGrid1.RowCount := FDataList.Count + 2;
        DrawGrid1.Invalidate;
     finally
        IndexFiles.Free;
     end;
  end;
end;

procedure THalcSrvrAliases.BtnBrowseClick(Sender: TObject);
begin
   if not OpenDialog2.Execute then Exit;
   DrawGrid1.OnSetEditText(DrawGrid1, 2, DrawGrid1.Row, OpenDialog2.FileName);
   DrawGrid1.OnSetEditText(DrawGrid1, 1, DrawGrid1.Row, ChangeFileExt(ExtractFileName(OpenDialog2.FileName),''));
   DrawGrid1.Invalidate;
end;

procedure THalcSrvrAliases.BtnDeleteClick(Sender: TObject);
var
   CanSelect: Boolean;
begin
   if DrawGrid1.Row > FDataList.Count then Exit;
   if MessageDlg('Are you sure you want to delete this Alias ?', mtConfirmation,
      [mbYes, mbNo], 0) <> mrYes then Exit;
   FDataList.Delete( DrawGrid1.Row - 1 );
   DrawGrid1.RowCount := FDataList.Count + 2;
   DrawGrid1.OnSelectCell(DrawGrid1, DrawGrid1.Col, DrawGrid1.Row, CanSelect);
   DrawGrid1.Invalidate;
end;

procedure THalcSrvrAliases.DrawGrid1KeyPress(Sender: TObject;
  var Key: Char);
begin
   if Key = #13 then
   begin
      if DrawGrid1.Col = 1 then
         DrawGrid1.Col := 2
      else if DrawGrid1.Row < DrawGrid1.RowCount then
         DrawGrid1.Row := DrawGrid1.Row + 1;
      Key := #0;
   end;
end;

procedure THalcSrvrAliases.BtnAddIFClick(Sender: TObject);
begin
   if not OpenDialog1.Execute then Exit;
   ListBox1.Items.Add(OpenDialog1.FileName);
   FDataList[DrawGrid1.Row - 1].IndexFiles.Add(OpenDialog1.FileName);
end;

procedure THalcSrvrAliases.BtnDeleteIFClick(Sender: TObject);
begin
   if ListBox1.ItemIndex < 0 then Exit;
   FDataList[DrawGrid1.Row - 1].IndexFiles.Delete(ListBox1.ItemIndex);
   ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

procedure THalcSrvrAliases.DrawGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key = VK_DELETE then
   begin
      BtnDelete.OnClick(BtnDelete);
   end;
end;

procedure THalcSrvrAliases.FormCreate(Sender: TObject);
var
   WDir: String;
   tm    : TTEXTMETRIC;
   Wu, Hu: Integer;
begin
   SetLength(WDir, 144);
   if GetWindowsDirectory(PChar(WDir), 144) <> 0 then
      SetLength(WDir, StrLen(PChar(WDir)))
   else
      Exit;

   FDataList := TDataList.Create;
   { read the configuration file and create all the datasets referenced there }
   FDataList.LoadFromFile( AddSlash(WDir) + 'HalcOLEDB.Ini' );

   { read the arrow bitmap }
   FBitmap := TBitmap.Create;
   FBitmap.Handle := Loadbitmap(HInstance, 'RIGHTARRW');
   FBitmap.Transparent := True;

   { configure the draw grid }
   GetTextMetrics(DrawGrid1.Canvas.Handle, tm);
   Wu := tm.tmAveCharWidth;
   Hu := IMax(tm.tmHeight + tm.tmInternalLeading, FBitmap.Height);

   DrawGrid1.DefaultRowHeight := Round(Hu * 1.5);
   { configure column 0 }
   DrawGrid1.ColWidths[0] := FBitmap.Width + 6;
   { configure column 1 }
   DrawGrid1.ColWidths[1] := Wu * 30;
   { configure column 2 }
   DrawGrid1.ColWidths[2] :=
      DrawGrid1.ClientWidth - DrawGrid1.ColWidths[0] - DrawGrid1.ColWidths[1];
   DrawGrid1.RowCount := FDataList.Count + 2;

   Application.OnHint := DisplayHint;
end;

procedure THalcSrvrAliases.DisplayHint(Sender: TObject);
begin
   StatusBar1.Simpletext := GetLongHint(Application.Hint);
end;

procedure THalcSrvrAliases.About1Click(Sender: TObject);
begin
   with TAboutBox.Create(Application) do
   begin
      try
         ShowModal;
      finally
         Free;
      end;
   end;
end;

procedure THalcSrvrAliases.VisitTxQueryhomepage1Click(Sender: TObject);
begin
   HomePage;
end;

procedure THalcSrvrAliases.SendmailtoTxQuery1Click(Sender: TObject);
begin
   WriteToUs3;
end;

procedure THalcSrvrAliases.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
   I : Integer;
begin
   try
      FDataList.OpenDataSets;
      { check that no alias empty }
      for I := 0 to FDataList.Count - 1 do
         if Length(TrimRight(FDataList[I].Alias)) = 0 then
            raise ExQueryError.Create('Alias cannot be empty !');
      FDataList.CloseDataSets;
   except
      CanClose := False;
      raise;
   end;
   FDataList.SaveToFile(FDataList.ConfigFileName);
end;

procedure THalcSrvrAliases.Exit1Click(Sender: TObject);
begin
   Close;
end;

procedure THalcSrvrAliases.Configuration1Click(Sender: TObject);
begin
  with TfrmHalCfg.Create(Application) do
  begin
     try
        Enter(self.FDataList);
     finally
        Free;
     end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -