Модератор: Модераторы
S_Gur писал(а):насчет языка Pascal не согласен абсолютно
S_Gur писал(а): надеюсь, что еще через несколько обновлений наиболее критичные глюки будут исправлены
iskander писал(а):Глюки в какой-либо фиче обычно следствие её малой востребованности
С этого места поподробнее, пожалуйста
unit U_Main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, ActnList, Menus, Messages;
type
{ TFmMain }
TFmMain = class(TForm)
MainMenu: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem20: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
MenuItem23: TMenuItem;
MenuItem24 : TMenuItem;
MenuItem25 : TMenuItem;
MenuItem26 : TMenuItem;
MenuItem27 : TMenuItem;
N8 : TMenuItem;
N7 : TMenuItem;
N6: TMenuItem;
N5: TMenuItem;
N4: TMenuItem;
N3: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
N2: TMenuItem;
N1: TMenuItem;
MPMenu: TPopupMenu;
MPControl: TPageControl;
Pbar: TProgressBar;
PopEngItem: TMenuItem;
PopRusItem: TMenuItem;
StBar: TStatusBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15 : TToolButton;
ToolButton16 : TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
TrIcon: TTrayIcon;
TrMenu: TPopupMenu;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure StBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
procedure TrIconClick(Sender: TObject);
private
fCurrentLanguage : String;
Procedure SetCurrentLanguage(AValue : String);
Procedure LoadConfig;
Procedure SaveConfig;
Procedure DefLanguage;
Procedure SetLanguage;
Procedure SetEnabledActions;
protected
Procedure WMGETSYSCOMMAND(var Msg : TMessage); message WM_SYSCOMMAND;
public
Property CurrentLanguage : String Read fCurrentLanguage Write SetCurrentLanguage;
Procedure ShowTask(AClassName : String; AAction : TAction);
Procedure CloseTask(AIndex : Integer);
end;
var
FmMain: TFmMain;
implementation
Uses
LanguageResManEh, U_AppIni, U_Dlgs, U_DM, U_FrmPos, U_MConst, U_MLForm, U_MLang, U_PForm, U_TxtLog, Windows;
{$R *.lfm}
{ TFmMain }
Procedure TFmMain.SetEnabledActions;
Begin
With DM Do
Begin
CloseTaskAction.Enabled := MPControl.ActivePageIndex > - 1;
MenuItem26.Enabled := CloseTaskAction.Enabled
End
End;
procedure TFmMain.DefLanguage;
Var
I : Integer;
Begin
DefComponentLanguage(Self);
DefComponentLanguage(MPControl);
DM.DefLanguage;
With TrIcon Do
Begin
BalloonTitle := TFmMain(Owner).Caption;
BalloonHint := TFmMain(Owner).Hint
End;
With Screen Do For I := 0 To FormCount - 1 Do If Forms[I] Is TMLForm Then Forms[I].Perform(WM_CLLANG, 0, 0)
End;
procedure TFmMain.SetLanguage;
Var
I : Integer;
Begin
SetComponentLanguage(Self);
SetComponentLanguage(MPControl);
DM.SetLanguage;
With TrIcon Do
Begin
BalloonTitle := TFmMain(Owner).Caption;
BalloonHint := TFmMain(Owner).Hint
End;
With Screen Do For I := 0 To FormCount - 1 Do If Forms[I] Is TMLForm Then Forms[I].Perform(WM_CHLANG, 0, 0)
End;
Procedure TFmMain.LoadConfig;
Var
S : String;
Begin
If Not LoadIniFile Then
Begin
ErrMsg('Error When Accessing System Settings');
SaveToLog('Error When Accessing System Settings');
Exit
End;
S := MD5Str(Name);
With IniFile Do
Begin
SaveOnExit := ReadBool(S, MD5Str('SaveOnExit'), False);
If SaveOnExit Then
Begin
CurrentLanguage := ReadString(S, MD5Str('CurrentLanguage'), 'LNG_ENG');
NormalCalc := ReadBool(S, MD5Str('NormalCalc'), False);
MinimizeToTray := ReadBool(S, MD5Str('MinimizeToTray'), False);
FieldsMultiLang := ReadBool(S, MD5Str('FieldsMultiLang'), False);
SaveFormPosition := ReadBool(S, MD5Str('SaveFormPosition'), False);
With DM.DBase Do
Begin
Server := CryptString(ReadString(S, MD5Str('DBaseServer'), ''), True);
Database := CryptString(ReadString(S, MD5Str('DBaseDatabase'), ''), True);
Username := CryptString(ReadString(S, MD5Str('DBaseUsername'), ''), True);
Password := CryptString(ReadString(S, MD5Str('DBasePassword'), ''), True);
Port := ReadInteger(S, MD5Str('DBasePort'), 3306)
End
End
Else CurrentLanguage := 'LNG_ENG'
End;
LoadPosition(Self)
End;
Procedure TFmMain.SaveConfig;
Var
S : String;
Begin
If Not LoadIniFile(True) Then
Begin
ErrMsg('Error When Accessing System Settings');
SaveToLog('Error When Accessing System Settings');
Exit
End;
SavePosition(Self);
S := MD5Str(Name);
With INIFile Do
Begin
WriteBool(S, MD5Str('SaveOnExit'), SaveOnExit);
If SaveOnExit Then
Begin
WriteString(S, MD5Str('CurrentLanguage'), CurrentLanguage);
WriteBool(S, MD5Str('NormalCalc'), NormalCalc);
WriteBool(S, MD5Str('MinimizeToTray'), MinimizeToTray);
WriteBool(S, MD5Str('FieldsMultiLang'), FieldsMultiLang);
WriteBool(S, MD5Str('SaveFormPosition'), SaveFormPosition);
With DM.DBase Do
Begin
WriteString(S, MD5Str('DBaseServer'), CryptString(Server));
WriteString(S, MD5Str('DBaseDatabase'), CryptString(Database));
WriteString(S, MD5Str('DBaseUsername'), CryptString(Username));
WriteString(S, MD5Str('DBasePassword'), CryptString(Password));
WriteInteger(S, MD5Str('DBasePort'), Port)
End
End;
SaveIniFile
End
End;
Procedure TFmMain.SetCurrentLanguage(AValue : String);
Begin
If fCurrentLanguage = AValue Then Exit;
fCurrentLanguage := AValue;
DefLanguage;
If LoadLang(AValue) Then SetLanguage;
With DM Do
Begin
EngAction.Checked := AValue = 'LNG_ENG';
RusAction.Checked := AValue = 'LNG_RUS'
End;
{With LanguageResourceManagerEh Do If AValue = 'LNG_ENG' Then ActiveLanguageAbbr := 'ENU'
Else ActiveLanguageAbbr := 'RUS'}
End;
Procedure TFmMain.WMGETSYSCOMMAND(var Msg :TMessage);
Begin
If MinimizeToTray And (Msg.wParam = SC_CLOSE) Or (Msg.wParam = SC_MINIMIZE) Then
Begin
Hide;
With TrIcon Do
Begin
Visible := True;
ShowBalloonHint
End
End
Else Inherited
End;
procedure TFmMain.FormActivate(Sender: TObject);
begin
If Not FirstRun Then Exit;
FirstRun := False;
LoadConfig;
With DM.DBase Do
Repeat
Try
Connect
Except
With Application Do
Begin
ProcessMessages;
ErrMsg(GetLanguageValue('NotDBConnMsg'));
With TFormClass(GetClass('TFmDBSettings')).Create(Self) Do If ShowModal = mrCancel Then
Begin
Terminate;
Exit
End
End
End
Until Connected;
SetEnabledActions
end;
procedure TFmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
Var
I : Integer;
begin
With MPControl Do If PageCount > 0 Then For I := PageCount - 1 DownTo 0 Do CloseTask(I);
With DM.DBase Do If Connected Then Disconnect;
SaveConfig;
DM.Free;
FreeMultiLang;
CloseAction := caFree
end;
procedure TFmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
CanClose := Not TrIcon.Visible And (ConfirmMsg(GetLanguageValue('QuitConfMsg')) = mrYes)
end;
procedure TFmMain.FormCreate(Sender: TObject);
begin
DM := TDM.Create(Self);
With FormatSettings Do
Begin
DecimalSeparator := '.';
ShortDateFormat := 'dd.mm.yyyy'
End;
With TrIcon Do
Begin
Icon := Application.Icon;
BalloonTitle := FmMain.Caption;
BalloonHint := FmMain.Hint;
Hint := FmMain.Hint
End;
With LanguageResourceManagerEh Do
Begin
ResourcePlacement := lrpEmbeddedEh;
LoadListOfAvailableLanguages('TEhLibLanguageConsts')
End;
CreateMultiLang;
FirstRun := True
end;
procedure TFmMain.StBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
begin
If Panel = StatusBar.Panels[ProgressPanelNumber] Then
Begin
PBar.Left := Rect.Left - 1;
PBar.Top := StatusBar.Top + 3;
PBar.Width := Rect.Width - 1;
PBar.Height := Rect.Height
End
end;
procedure TFmMain.TrIconClick(Sender: TObject);
begin
TrIcon.ShowBalloonHint
end;
Procedure TFmMain.ShowTask(AClassName : String; AAction : TAction);
Var
I : Integer;
Frm : TFmPanel;
Ts : TTabSheet;
Begin
With MPControl Do
Begin
If PageCount > 0 Then For I := 0 To PageCount - 1 Do If (Pages[I].Controls[0].ClassName = AClassName) Then
Begin
ActivePage := Pages[I];
Exit
End;
Frm := TFormPanelClass(GetClass(AClassName)).Create(Self);
TS := TTabSheet.Create(MPControl);
With TS Do
Begin
Caption := AAction.Caption;
Hint := AAction.Hint;
ImageIndex := AAction.ImageIndex;
PageControl := MPControl
End;
With Frm Do
Begin
Parent := TS;
IsPanel := True;
Align := alClient;
BorderStyle := bsNone;
Show
End;
ActivePage := Ts;
If PageCount > 1 Then
Begin
ActivePageIndex := ActivePageIndex - 1;
ActivePageIndex := ActivePageIndex + 1
End
End;
SetEnabledActions
End;
Procedure TFmMain.CloseTask(AIndex : Integer);
Var
I : Integer;
Begin
With MPControl Do
Begin
I := ActivePage.PageIndex;
With ActivePage Do
Begin
(Controls[0] As TFmPanel).Close;
Free
End;
If (PageCount > 0) And (ActivePage.PageIndex = 0) And (I > 0) Then ActivePage := Pages[I - 1];
End;
SetEnabledActions
End;
end.
unit U_Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.ComCtrls, System.Win.TaskbarCore, Vcl.Taskbar, Vcl.ToolWin, Vcl.ActnList;
type
TFmMain = class(TForm)
StBar: TStatusBar;
PBar: TProgressBar;
TskBar: TTaskbar;
MenuBar: TToolBar;
ToolButton1: TToolButton;
ToolBar: TToolBar;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
MPControl: TPageControl;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
ToolButton19: TToolButton;
DataBtn: TToolButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure StBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
procedure MPControlChange(Sender: TObject);
private
{ Private declarations }
fCurrentLanguage : String;
Procedure SetCurrentLanguage(AValue : String);
Procedure DefLanguage;
Procedure SetLanguage;
Procedure LoadConfig;
Procedure SaveConfig;
Procedure SetEnabledActions;
protected
{ Protected declarations }
Procedure WMGETSYSCOMMAND(var Msg :TMessage); message WM_SYSCOMMAND;
public
{ Public declarations }
Property CurrentLanguage : String Read fCurrentLanguage Write SetCurrentLanguage;
Procedure ShowTask(AClassName : String; AAction : TAction);
Procedure CloseTask(AIndex : Integer);
end;
var
FmMain: TFmMain;
implementation
Uses
LanguageResManEh, U_AppIni, U_DBSett, U_Dlgs, U_BForm, U_FrmPos, U_MConst, U_MDM, U_MLang, U_MLForm, U_PForm;
{$R *.dfm}
{$R EhLibLangConsts.RUS.dfm}
{$R EhLibLangConsts.ENU.dfm}
Procedure TFmMain.SetEnabledActions;
Begin
With MDM Do
Begin
CloseTaskAction.Enabled := MPControl.ActivePageIndex > - 1
End
End;
Procedure TFmMain.SetCurrentLanguage(AValue : String);
Begin
If fCurrentLanguage = AValue Then Exit;
fCurrentLanguage := AValue;
DefLanguage;
If LoadLang(AValue) Then SetLanguage;
With MDM Do
Begin
EngAction.Checked := AValue = 'LNG_ENG';
RusAction.Checked := AValue = 'LNG_RUS'
End;
With LanguageResourceManagerEh Do If AValue = 'LNG_ENG' Then ActiveLanguageAbbr := 'ENU'
Else ActiveLanguageAbbr := 'RUS'
End;
Procedure TFmMain.DefLanguage;
Var
I : Integer;
Begin
DefComponentLanguage(Self);
DefComponentLanguage(MPControl);
DefComponentLanguage(MDM);
With MDM.TrIcon Do
Begin
BalloonTitle := FmMain.Caption;
BalloonHint := FmMain.Hint
End;
With Screen Do For I := 0 To FormCount - 1 Do If Forms[I] Is TFmMultiLang Then Forms[I].Perform(WM_CLLANG, 0, 0)
End;
Procedure TFmMain.SetLanguage;
Var
I : Integer;
Begin
SetComponentLanguage(Self);
SetComponentLanguage(MPControl);
SetComponentLanguage(MDM);
With MDM.TrIcon Do
Begin
BalloonTitle := FmMain.Caption;
BalloonHint := FmMain.Hint
End;
With Screen Do For I := 0 To FormCount - 1 Do If Forms[I] Is TFmMultiLang Then Forms[I].Perform(WM_CHLANG, 0, 0);
End;
Procedure TFmMain.LoadConfig;
Var
S : String;
Begin
If Not LoadIniFile Then
Begin
ErrMsg('Error When Accessing System Settings');
Exit
End;
S := MD5(Name);
With IniFile Do
Begin
SaveOnExit := ReadBool(S, MD5('SaveOnExit'), False);
If SaveOnExit Then
Begin
CurrentLanguage := ReadString(S, MD5('CurrentLanguage'), 'LNG_ENG');
MinimizeToTray := ReadBool(S, MD5('MinimizeToTray'), False);
FieldsMultiLang := ReadBool(S, MD5('FieldsMultiLang'), False);
StartOfTheWeek := ReadInteger(S, MD5('StartOfTheWeek'), 1);
SaveFormPosition := ReadBool(S, MD5('SaveFormPosition'), False);
SaveGridParams := ReadBool(S, MD5('SaveGridParams'), False);
SPFilter := ReadBool(S, MD5('SPFilter'), False);
SPInputSearch := ReadBool(S, MD5('SPInputSearch'), False);
With MDM.DBase Do
Begin
Server := CryptString(ReadString(S, MD5('DBaseServer'), ''), True);
Database := CryptString(ReadString(S, MD5('DBaseDatabase'), ''), True);
Username := CryptString(ReadString(S, MD5('DBaseUsername'), ''), True);
Password := CryptString(ReadString(S, MD5('DBasePassword'), ''), True);
Port := ReadInteger(S, MD5('DBasePort'), 3306)
End
End
Else CurrentLanguage := 'LNG_RUS'
End;
LoadPosition(Self)
End;
procedure TFmMain.MPControlChange(Sender: TObject);
begin
With DataBtn Do
Begin
Enabled := MPControl.PageCount > 0;
If Enabled Then DropDownMenu := (MPControl.Pages[MPControl.ActivePageIndex].Controls[0] As TFmFormBrowse).PDataMenu
Else DropDownMenu := Nil
End
end;
Procedure TFmMain.SaveConfig;
Var
S : String;
Begin
If Not LoadIniFile(True) Then
Begin
ErrMsg('Error When Accessing System Settings');
Exit
End;
SavePosition(Self);
S := MD5(Name);
With INIFile Do
Begin
WriteBool(S, MD5('SaveOnExit'), SaveOnExit);
If SaveOnExit Then
Begin
WriteString(S, MD5('CurrentLanguage'), CurrentLanguage);
WriteBool(S, MD5('MinimizeToTray'), MinimizeToTray);
WriteBool(S, MD5('FieldsMultiLang'), FieldsMultiLang);
WriteInteger(S, MD5('StartOfTheWeek'), StartOfTheWeek);
WriteBool(S, MD5('SaveFormPosition'), SaveFormPosition);
WriteBool(S, MD5('SaveGridParams'), SaveGridParams);
WriteBool(S, MD5('SPFilter'), SPFilter);
WriteBool(S, MD5('SPInputSearch'), SPInputSearch);
With MDM.DBase Do
Begin
WriteString(S, MD5('DBaseServer'), CryptString(Server));
WriteString(S, MD5('DBaseDatabase'), CryptString(Database));
WriteString(S, MD5('DBaseUsername'), CryptString(Username));
WriteString(S, MD5('DBasePassword'), CryptString(Password));
WriteInteger(S, MD5('DBasePort'), Port)
End
End;
SaveIniFile
End
End;
procedure TFmMain.StBarDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
If Panel = StBar.Panels[ProgressPanelNumber] Then
Begin
PBar.Left := Rect.Left;
PBar.Top := Rect.Top;
PBar.Width := Rect.Width - 2;
PBar.Height := Rect.Height
End
end;
Procedure TFmMain.WMGETSYSCOMMAND(var Msg :TMessage);
Begin
If MinimizeToTray And (Msg.wParam = SC_CLOSE) Or (Msg.wParam = SC_MINIMIZE) Then
Begin
Hide;
With MDM.TrIcon Do
Begin
Visible := True;
ShowBalloonHint
End
End
Else Inherited
End;
procedure TFmMain.FormActivate(Sender: TObject);
begin
If Not FirstRun Then Exit;
FirstRun := False;
LoadConfig;
With MDM.DBase Do
Repeat
Try
Connect
Except
With Application Do
Begin
ProcessMessages;
ErrMsg(GetLanguageValue('NotDBConnMsg'));
With TFmDBSettings.Create(Self) Do If ShowModal = mrCancel Then
Begin
Terminate;
Exit
End
End
End
Until Connected;
SetEnabledActions
end;
procedure TFmMain.FormClose(Sender: TObject; var Action: TCloseAction);
Var
I : Integer;
begin
With MPControl Do If PageCount > 0 Then For I := PageCount - 1 DownTo 0 Do CloseTask(I);
With MDM.DBase Do If Connected Then Disconnect;
SaveConfig;
FreeMultiLang;
MDM.Free
end;
procedure TFmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := Not MDM.TrIcon.Visible And (ConfirmMsg(GetLanguageValue('QuitConfMsg')) = mrYes)
end;
procedure TFmMain.FormCreate(Sender: TObject);
begin
With FormatSettings Do
Begin
DecimalSeparator := '.';
ShortDateFormat := 'dd.mm.yyyy'
End;
MDM := TMDM.Create(Self);
With MDM.TrIcon Do
Begin
Icon := Application.Icon;
BalloonTitle := FmMain.Caption;
BalloonHint := FmMain.Hint;
Hint := BalloonHint
End;
CreateMultiLang;
VersionNumber := '1.0';
MinimizeToTray := False;
SaveFormPosition := False;
SaveToReg := False;
SaveOnExit := False;
PBar.Parent := StBar;
HintPanelNumber := 0;
ProgressPanelNumber := 1;
TimerPanelNumber := 2;
ProgressPanelWidth := 100;
StartOfTheWeek := 0;
SetLanguage;
FirstRun := True;
With LanguageResourceManagerEh Do
Begin
ResourcePlacement := lrpEmbeddedEh;
LoadListOfAvailableLanguages('TEhLibLanguageConsts')
End;
SetEnabledActions
end;
Procedure TFmMain.ShowTask(AClassName : String; AAction : TAction);
Var
I : Integer;
Ts : TTabSheet;
Begin
With MPControl Do
Begin
If PageCount > 0 Then For I := 0 To PageCount - 1 Do If (Pages[I].Controls[0].ClassName = AClassName) Then
Begin
ActivePage := Pages[I];
Exit
End;
TS := TTabSheet.Create(MPControl);
With TS Do
Begin
Caption := AAction.Caption;
Hint := AAction.Hint;
ImageIndex := AAction.ImageIndex;
PageControl := MPControl
End;
With TFormPanelClass(GetClass(AClassName)).Create(Self) Do
Begin
Parent := TS;
PanelMode := True;
Show
End;
ActivePage := Ts
End;
MPControlChange(Nil);
SetEnabledActions
// With TFormPanelClass(GetClass(AClassName)).Create(Self) Do ShowModal
End;
Procedure TFmMain.CloseTask(AIndex : Integer);
Begin
With MPControl Do
Begin
With Pages[AIndex] Do
Begin
(Controls[0] As TFmFormPanel).Close;
Free
End;
If AIndex > 0 Then ActivePageIndex := AIndex - 1
End;
MPControlChange(Nil);
SetEnabledActions
End;
end.
S_Gur писал(а):даже не знаю, для чего его вообще использовать...
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 9