📄 hsrvra~2.~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 + -